justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Add generic derivations and To/FromJSON instances

Browse Source
This commit is contained in:
justin
2022-07-25 22:49:18 +01:00
parent f5604ef429
commit b8e8413daa
99 changed files with 1406 additions and 517 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data/ActionPlan.hs
+27 -130
View File
@@ -1,7 +1,10 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE DeriveGeneric #-}
module Dodge.Data.ActionPlan where
import GHC.Generics
import Data.Aeson
import Dodge.Creature.Stance.Data
import Dodge.Data.CreatureEffect
--import Dodge.ShortShow
@@ -17,11 +20,17 @@ data ActionPlan
,_apStrategy :: Strategy
,_apGoal :: [Goal]
}
deriving (Eq,Ord,Show,Read)
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON ActionPlan where
toEncoding = genericToEncoding defaultOptions
instance FromJSON ActionPlan
data RandImpulse
= RandImpulseList [Impulse]
| RandImpulseCircMove Float
deriving (Eq,Ord,Show,Read)
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON RandImpulse where
toEncoding = genericToEncoding defaultOptions
instance FromJSON RandImpulse
data Impulse
= Move Point2
| MoveForward Float
@@ -54,34 +63,10 @@ data Impulse
{_impulseUseAheadPos :: P2Imp
}
| ImpulseNothing
deriving (Eq,Ord,Show,Read)
--instance Show Impulse where
-- show imp = case imp of
-- Move p -> "Move "++shortPoint2 p
-- MoveForward f -> "MoveForward "++ show f
-- Turn f -> "Turn "++show f
-- RandomTurn f -> "RandomTurn "++show f
-- TurnToward p f -> "TurnToward "++shortPoint2 p++show f
-- MvTurnToward p -> "MvTurnToward "++shortPoint2 p
-- MvForward -> "MvForward"
-- TurnTo p -> "TurnTo "++shortPoint2 p
-- UseItem -> "UseItem"
-- SwitchToItem i -> "SwitchToItem "++show i
-- DropItem -> "DropItem"
-- Bark sid -> "Bark "++show sid
-- Melee i -> "Melee "++show i
-- ChangePosture post -> "ChangePosture " ++ show post
-- MakeSound sid -> "MakeSound " ++ show sid
-- ChangeStrategy s -> "ChangeStrategy " ++ show s
-- AddGoal g -> "AddGoal " ++ show g
-- ArbitraryImpulseFunction {} -> "ArbitraryImpulseFunction"
-- ArbitraryImpulse {} -> "ArbitraryImpulse"
-- ArbitraryImpulseEffect {} -> "ArbitraryImpulseEffect"
-- ImpulseUseTargetCID {} -> "ImpulseUseTargetCID"
-- ImpulseUseTarget {} -> "ImpulseUseTarget"
-- ImpulseUseAheadPos {} -> "ImpulseUseAheadPos"
-- RandomImpulse {} -> "RandomImpulse"
-- ImpulseNothing -> "ImpulseNothing"
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON Impulse where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Impulse
infixr 9 `WaitThen`
infixr 9 `DoActionThen`
infixr 9 `DoActionWhile`
@@ -182,103 +167,10 @@ data Action
{_sideImpulses :: [Impulse]
,_mainAction :: Action
}
deriving (Eq,Ord,Show,Read)
--instance Show Action where
-- show act = case act of
-- ActionNothing -> "ActionNothing"
-- LabelAction
-- {_actLabel = str
-- ,_actAction = subAct
-- } -> str++":"++show subAct
-- AimAt
-- {_targetID = tid
-- ,_targetSeenAt = p
-- } -> "AimAt tid:"++show tid++" seenAt:"++shortPoint2 p
-- PathTo
-- {_pathToPoint = p
-- } -> "PathTo:"++shortPoint2 p
-- TurnToPoint
-- {_turnToPoint = p
-- } -> "TurnToPoint:"++shortPoint2 p
------ | PickupItem
------ {_pickupItemID :: Int
------ }
-- ImpulsesList
-- {_impulsesListList = iss
-- } -> "ImpulsesList:"++show iss
-- DoImpulses
-- {_doImpulsesList = is
-- } -> "DoImpulses:"++show is
-- WaitThen
-- {_waitThenTimer = i
-- ,_waitThenAction = a
-- } -> "WaitThen timer:"++show i++" act:"++show a
-- DoActionWhile
-- {_doActionWhileCondition = _
-- ,_doActionWhileAction = a
-- } -> "DoActionWhile (function) act:"++show a
-- DoActionWhilePartial
-- {_doActionWhilePartial = partact
-- ,_doActionWhileCondition = _
-- ,_doActionWhileAction = a
-- } -> "DoActionWhilePartial partAct:"++show partact++" resetAct:"++show a
-- DoActionIf
-- {_doActionIfCondition = _
-- ,_doActionIfAction = a
-- } -> "DoActionIf act:"++show a
-- DoActionIfElse
-- {_doActionIfElseIfAction = ifa
-- ,_doActionIfElseCondition = _
-- ,_doActionIfElseElseAction = elsea
-- } -> "DoActionIfElse ifa:"++show ifa++" elsea:"++show elsea
-- DoActionWhileInterrupt
-- {_doActionWhileThenDo = whilea
-- ,_doActionWhileThenCondition = _
-- ,_doActionWhileThenThen = thena
-- } -> "DoActionWhileInterrupt whilea:" ++show whilea++" interrupta:"++show thena
-- DoActions
-- {_doActionsList = as
-- } -> "DoActions " ++ foldMap show as
-- DoActionThen
-- {_doActionThenFirst = a1
-- ,_doActionThenSecond = a2
-- } -> "DoActionThen " ++ show a1 ++ " then:" ++ show a2
------ | DoGuardActions
------ {_doGuardActionsList :: [( (World, Creature) -> Bool, Action, Maybe Action)]
------ }
-- DoReplicate
-- {_doReplicateTimes = i
-- ,_doReplicateAction = a
-- } -> "DoReplicate times:" ++ show i ++ " act:"++ show a
-- DoReplicatePartial
-- {_partialAction = pa
-- ,_doReplicateTimes = i
-- ,_doReplicateAction = ra
-- } -> "DoReplicatePartial pa:" ++ show pa ++ " times:" ++ show i ++ " reset:"++ show ra
-- LeadTarget
-- {_leadTargetBy = p
-- } -> "LeadTarget by:"++ show p
-- NoAction -> "NoAction"
-- StartSentinelPost -> "StartSentinelPost"
-- UseTarget
-- {_useTarget = _
-- } -> "UseTarget func"
-- UseSelf
-- {_useSelf = _
-- } -> "UseSelf func"
-- UseAheadPos
-- {_useAheadPos = _
-- } -> "UseAheadPos func"
-- UseMvTargetPos
-- {_useMvTargetPos = _
-- } -> "UseMvTargetPos func"
-- ArbitraryAction {} -> "ArbitraryAction func"
-- DoImpulsesAlongside
-- {_sideImpulses = is
-- ,_mainAction = a
-- } -> "DoImpulsesAlongside sideImpulses:"++show is ++ " mainA:"++show a
-- deriving (Eq,Ord,Show)
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON Action where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Action
data Strategy
= Flank Int
| Ambush Int
@@ -295,13 +187,18 @@ data Strategy
| Reload
| Flee
| MeleeStrike
deriving (Eq,Ord,Show,Read)
-- deriving (Eq,Ord,Show)
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON Strategy where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Strategy
data Goal
= LiveLongAndProsper
| Kill Int
| SentinelAt Point2 Float
deriving (Eq,Ord,Show,Read)
deriving (Eq,Ord,Show,Read,Generic)
instance ToJSON Goal where
toEncoding = genericToEncoding defaultOptions
instance FromJSON Goal
makeLenses ''ActionPlan
makeLenses ''Impulse
makeLenses ''Action