Refactor, try to limit dependencies

src/Dodge/Creature/Impulse.hs

@@ -1,91 +1,98 @@
 {-# LANGUAGE TupleSections #-}
-module Dodge.Creature.Impulse
-    ( impulsiveAIBefore
-    , followThenClearImpulses
-    ) where
-import Dodge.Data
-import Dodge.FloatFunction
-import Dodge.RandImpulse
-import Dodge.CreatureEffect
-import Dodge.Creature.Vocalization
-import Dodge.Creature.Impulse.Movement
-import Dodge.Creature.Impulse.UseItem
-import Dodge.SoundLogic
-import Geometry
-import LensHelp
 
-import qualified IntMapHelp as IM
-import System.Random
+module Dodge.Creature.Impulse (
+    impulsiveAIBefore,
+    followThenClearImpulses,
+) where
+
 import Control.Monad.State
 import Data.Bifunctor
---import Data.Maybe
---
-impulsiveAIBeforeAfter 
-    :: (World -> Creature -> Creature)
-    -> (World -> Creature -> Creature)
-    -> Creature -> World -> World
+import Dodge.Creature.Impulse.Movement
+import Dodge.Creature.Impulse.UseItem
+import Dodge.Creature.Vocalization
+import Dodge.CreatureEffect
+import Dodge.Data.World
+import Dodge.FloatFunction
+import Dodge.RandImpulse
+import Dodge.SoundLogic
+import Geometry
+import qualified IntMapHelp as IM
+import LensHelp
+import System.Random
+
+impulsiveAIBeforeAfter ::
+    (World -> Creature -> Creature) ->
+    (World -> Creature -> Creature) ->
+    Creature ->
+    World ->
+    World
 impulsiveAIBeforeAfter startup endup cr w = w' & cWorld . creatures . ix (_crID cr) .~ endup w' cr'
   where
     w' = g w
-    (g,cr') = impulsiveAI startup cr w
+    (g, cr') = impulsiveAI startup cr w
 
-impulsiveAIBefore :: (World -> Creature -> Creature)
-    -> Creature -> World -> World
+impulsiveAIBefore ::
+    (World -> Creature -> Creature) ->
+    Creature ->
+    World ->
+    World
 impulsiveAIBefore f cr w = g w & cWorld . creatures . ix (_crID cr) .~ cr'
   where
-    (g,cr') = impulsiveAI f cr w
+    (g, cr') = impulsiveAI f cr w
 
-impulsiveAI 
-    :: (World -> Creature -> Creature) -- | internal creature update
-    -> Creature
-    -> World
-    -> (World -> World , Creature)
+impulsiveAI ::
+    (World -> Creature -> Creature) ->
+    Creature ->
+    World ->
+    (World -> World, Creature)
 impulsiveAI f cr w = followImpulses w $ f w cr
 
-
 followThenClearImpulses :: Creature -> World -> World
 followThenClearImpulses = impulsiveAIBeforeAfter (const id) (const $ crActionPlan . apImpulse .~ [])
 
 followImpulses :: World -> Creature -> (World -> World, Creature)
 followImpulses w cr = foldr f (id, cr) (_apImpulse $ _crActionPlan cr)
   where
-    f imp (theupdate,cr') = first (. theupdate) $ followImpulse cr' w imp
+    f imp (theupdate, cr') = first (. theupdate) $ followImpulse cr' w imp
 
-followImpulse :: Creature -> World -> Impulse -> (World -> World , Creature)
+followImpulse :: Creature -> World -> Impulse -> (World -> World, Creature)
 followImpulse cr w imp = case imp of
-    ImpulseNothing -> (id,cr)
-    RandomImpulse rimp -> 
-        let (newimp,newgen) = runState (doRandImpulse rimp) (_randGen w)
-        in first ((randGen .~ newgen) .) $ followImpulse cr w newimp
-    Bark sid        -> (soundStart (CrMouth cid) cpos sid Nothing, resetCrVocCoolDown cr)
-    Move p          -> crup $ crMvBy p cr
-    MoveForward x   -> crup $ crMvForward x cr
-    Turn a          -> crup $ creatureTurn a cr
-    TurnToward p a  -> crup $ creatureTurnToward p a cr
-    TurnTo p        -> crup $ creatureTurnTo p cr
-    ChangePosture post  -> crup $ cr & crStance . posture .~ post
-    UseItem         -> (useItem cr, cr)
-    SwitchToItem i  -> crup $ cr & crInvSel .~ InvSel i NoInvSelAction
-    Melee cid'      -> (hitCr cid'
-        , crMvBy (10 *.* normalizeV (posFromID cid' -.- cpos)) $ cr & crMeleeCooldown .~ 20)
-    RandomTurn a    -> (randGen .~ snd (rr a), creatureTurn (fst $ rr a) cr)
-    MakeSound sid   -> ( soundStart (CrSound (_crID cr)) (_crPos cr) sid Nothing , cr )
-    DropItem        -> undefined
-    ChangeStrategy strat    -> crup $ cr & crActionPlan . apStrategy .~ strat
-    AddGoal gl      -> crup $ cr & crActionPlan . apGoal .:~ gl 
-    ArbitraryImpulseFunction f  -> crup $ doWdCrCr f w cr
-    ArbitraryImpulse f  -> followImpulse cr w (doCrWdImp f cr w) 
+    ImpulseNothing -> (id, cr)
+    RandomImpulse rimp ->
+        let (newimp, newgen) = runState (doRandImpulse rimp) (_randGen w)
+         in first ((randGen .~ newgen) .) $ followImpulse cr w newimp
+    Bark sid -> (soundStart (CrMouth cid) cpos sid Nothing, resetCrVocCoolDown cr)
+    Move p -> crup $ crMvBy p cr
+    MoveForward x -> crup $ crMvForward x cr
+    Turn a -> crup $ creatureTurn a cr
+    TurnToward p a -> crup $ creatureTurnToward p a cr
+    TurnTo p -> crup $ creatureTurnTo p cr
+    ChangePosture post -> crup $ cr & crStance . posture .~ post
+    UseItem -> (useItem cr, cr)
+    SwitchToItem i -> crup $ cr & crInvSel .~ InvSel i NoInvSelAction
+    Melee cid' ->
+        ( hitCr cid'
+        , crMvBy (10 *.* normalizeV (posFromID cid' -.- cpos)) $ cr & crMeleeCooldown .~ 20
+        )
+    RandomTurn a -> (randGen .~ snd (rr a), creatureTurn (fst $ rr a) cr)
+    MakeSound sid -> (soundStart (CrSound (_crID cr)) (_crPos cr) sid Nothing, cr)
+    DropItem -> undefined
+    ChangeStrategy strat -> crup $ cr & crActionPlan . apStrategy .~ strat
+    AddGoal gl -> crup $ cr & crActionPlan . apGoal .:~ gl
+    ArbitraryImpulseFunction f -> crup $ doWdCrCr f w cr
+    ArbitraryImpulse f -> followImpulse cr w (doCrWdImp f cr w)
     ArbitraryImpulseEffect f -> (doCrWdWd f cr, cr)
-    ImpulseUseTargetCID f   -> case cr ^? crIntention . targetCr . _Just of
+    ImpulseUseTargetCID f -> case cr ^? crIntention . targetCr . _Just of
         Just tcr -> followImpulse cr w (doIntImp f $ _crID tcr)
-        _        -> crup cr
+        _ -> crup cr
     ImpulseUseTarget f -> case cr ^? crIntention . targetCr . _Just of
         Just tcr -> followImpulse cr w (doCrImp f tcr)
-        _        -> crup cr
+        _ -> crup cr
     ImpulseUseAheadPos f -> followImpulse cr w (doP2Imp f (_crPos cr +.+ 20 *.* unitVectorAtAngle (_crDir cr)))
-    MvForward       -> crup $ crMvForward speed cr
-    MvTurnToward p  -> crup
-        $ creatureTurnToward p (turnRad $ safeAngleVV (p -.- cpos) (unitVectorAtAngle cdir)) cr
+    MvForward -> crup $ crMvForward speed cr
+    MvTurnToward p ->
+        crup $
+            creatureTurnToward p (turnRad $ safeAngleVV (p -.- cpos) (unitVectorAtAngle cdir)) cr
   where
     crup = (id,)
     mvType = _crMvType cr
@@ -93,10 +100,11 @@ followImpulse cr w imp = case imp of
     turnRad = doFloatFloat $ _mvTurnRad mvType
     cpos = _crPos cr
     cdir = _crDir cr
-    cid  = _crID cr
+    cid = _crID cr
     posFromID cid' = _crPos $ _creatures (_cWorld w) IM.! cid'
-    rr a = randomR (-a,a) $ _randGen w
-    hitCr i = (cWorld . creatures . ix i . crState . csDamage 
-        .:~ Damage BLUNT 100 cpos (posFromID i) (posFromID i) NoDamageEffect
+    rr a = randomR (- a, a) $ _randGen w
+    hitCr i =
+        ( cWorld . creatures . ix i . crState . csDamage
+            .:~ Damage BLUNT 100 cpos (posFromID i) (posFromID i) NoDamageEffect
         )
-        . soundStart (CrSound cid) cpos hitS Nothing
+            . soundStart (CrSound cid) cpos hitS Nothing