More faction utilities

4 files changed, 68 insertions, 14 deletions

diff --git a/sequence.cabal b/sequence.cabal
index b721848..2def576 100644
--- a/sequence.cabal
+++ b/sequence.cabal
@@ -37,5 +37,7 @@ executable sequence
                      , transformers
                      , transformers-base
                      , ansi-terminal
+                     , text
+                     , template
   hs-source-dirs:      src
   default-language:    Haskell2010
\ No newline at end of file
diff --git a/sequence.nix b/sequence.nix
index 5e8a130..ae75127 100644
--- a/sequence.nix
+++ b/sequence.nix
@@ -1,7 +1,8 @@
 { mkDerivation, ansi-terminal, base, bimap, case-insensitive
 , containers, data-default, directory, filepath, game-probability
 , lens, mtl, readline, Shellac, Shellac-haskeline, stdenv
-, table-layout, transformers, transformers-base, xdg-basedir
+, table-layout, template, text, transformers, transformers-base
+, xdg-basedir
 }:
 mkDerivation {
   pname = "sequence";
@@ -12,8 +13,8 @@ mkDerivation {
   executableHaskellDepends = [
     ansi-terminal base bimap case-insensitive containers data-default
     directory filepath game-probability lens mtl readline Shellac
-    Shellac-haskeline table-layout transformers transformers-base
-    xdg-basedir
+    Shellac-haskeline table-layout template text transformers
+    transformers-base xdg-basedir
   ];
   license = stdenv.lib.licenses.mit;
 }
diff --git a/src/Main.hs b/src/Main.hs
index f4a863f..8d74def 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE ViewPatterns, RecordWildCards #-}
+{-# LANGUAGE ViewPatterns, RecordWildCards, OverloadedStrings, FlexibleContexts #-}
 
 import Control.Monad
 
@@ -43,6 +43,12 @@ import Text.Layout.Table
 
 import Text.Read (readMaybe)
 
+import Data.Text (Text)
+import qualified Data.Text as Text
+import qualified Data.Text.Lazy as Lazy (Text)
+import qualified Data.Text.Lazy as Lazy.Text
+import Data.Text.Template
+
 main :: IO ()
 main = do
   historyFile <- getUserCacheFile "sequence" "history"
@@ -65,7 +71,10 @@ main = do
                                     , cmd "align" alignEntity "Align the focused entity to a faction – creating it, if necessary"
                                     , cmd "name" nameEntity "Name the current entity overriding previous name assignments"
                                     , cmd "spawn" spawnEntity "Create a new entity from an archetype focusing on it"
-                                    , cmd "roll" rollTest "Roll a test using the stats of the currently focused entity"
+                                    , cmd "spawn'" spawnFaction "Create a new faction and spawn multiple copies of an archetype in it"
+                                    , cmd "test" rollTest "Roll a test using the stats of the currently focused entity"
+                                    , cmd "combat" entitySeqVal "Roll sequence value for the current focus and enter combat"
+                                    , cmd "combat'" factionSeqVal "Roll sequence values for all members of a faction and have them enter combat"
                                     ]
                   }
   void $ runShell description haskelineBackend (def :: GameState)
@@ -81,11 +90,11 @@ stateOutline st
     faction id = fromJust $ view eFaction <$> Map.lookup id (st ^. gEntities)
     factionIndex id = fromJust $ elemIndex (view faction' $ faction id) factions
     rowGs = do
-      rowGroup'@((seqVal', _):_) <- protoRows
+      rowGroup'@((review seqVal' -> seqVal, _):_) <- protoRows
       let
         rowGroup = map snd rowGroup'
         factionColumn i = [evalState ?? st $ toName x | x <- rowGroup, factionIndex x == i ]
-      return . colsAllG top $ [show (seqVal' ^. seqVal)] : map factionColumn [0..(length factions - 1)]
+      return . colsAllG top $ [seqVal] : map factionColumn [0..(length factions - 1)]
 
 -- Query state
 listFactions, listEntities :: Sh GameState ()
@@ -127,6 +136,27 @@ nameEntity :: String -> Sh GameState ()
 nameEntity ('#':_) = shellPutErrLn "We do not allow names that might shadow explicit access to entities via their number (‘#<n>’)"
 nameEntity name = withFocus $ \ident -> modifying gEntityNames $ Bimap.insert ident (name ^. entityName)
 
+spawnFaction :: Completable Faction -> Integer -> Completable Entity -> String -> Sh GameState ()
+spawnFaction cFaction num cEntity nameTemplate
+  | ('#':_) <- nameTemplate = shellPutErrLn "We do not allow names that might shadow explicit access to entities via their number (‘#<n>’)"
+  | otherwise = do
+      let nameTemplate' = templateSafe $ Text.pack nameTemplate
+      case nameTemplate' of
+        Left _ -> shellPutErrLn "Invalid template – ‘$n’ gets replaced by [1..<n>], ‘$faction’ gets replaced by name of faction, and ‘$i’ gets replaced by a numerical identifier – quote ‘$’ as ‘$$’"
+        Right nameTemplate -> withArg (\faction -> withArg (\entity -> mapM_ (spawnFaction' faction entity nameTemplate) [1..num]) cEntity) cFaction
+  where
+    spawnFaction' faction entity nameTemplate num = do
+      identifier <- use gNextId'
+      let name = Lazy.Text.unpack <$> renderA nameTemplate (context num)
+          context num "i" = Just . Text.pack $ review entityId' identifier
+          context num "n" = Just . Text.pack $ show num
+          context num "faction" = Just . Text.pack $ faction ^. faction'
+          context num _ = Nothing
+      modify $ insertEntity entity
+      maybe (return ()) (nameEntity identifier) name
+      gEntities %= Map.adjust (set eFaction faction) identifier
+    nameEntity identifier name = modifying gEntityNames $ Bimap.insert identifier (name ^. entityName)
+
 -- Dice rolls
 rollTest :: Completable (FormulaM Stats Test) -> Sh GameState ()
 rollTest = withArg $ enactTest' >=> maybe (return ()) (shellPutStrLn . ppResult)
@@ -150,3 +180,18 @@ enactTest' test = withFocus' $ \focus -> do
   gFocus' .= newFocus
   return result
       
+entitySeqVal :: Sh GameState ()
+entitySeqVal = withFocus entitySeqVal'
+
+factionSeqVal :: Completable Faction -> Sh GameState ()
+factionSeqVal = withArg $ \qFaction -> use gEntities >>= mapM_ (entitySeqVal') . Map.keys . Map.filter ((==) qFaction . view eFaction)
+
+entitySeqVal' :: EntityIdentifier -> Sh GameState ()
+entitySeqVal' ident = do
+  entity <- preuse (gEntities . ix ident)
+  let sVal = preview (eStats . sSeqVal) =<< entity
+  case (,) <$> entity <*> sVal of
+    Nothing -> return ()
+    Just (entity, sVal) -> do
+      (newEntity, view (seqVal . re _Just) -> val) <- evalFormula entity sVal
+      gEntities . at ident .= Just (newEntity & set eSeqVal val)
diff --git a/src/Sequence/Types.hs b/src/Sequence/Types.hs
index 3d95b9a..02389a1 100644
--- a/src/Sequence/Types.hs
+++ b/src/Sequence/Types.hs
@@ -3,7 +3,7 @@
 module Sequence.Types
   ( GameState, gEntities, gEntityNames, gFocus, gNextId'
   , Faction, faction, faction'
-  , SeqVal(..), seqVal
+  , SeqVal(..), seqVal, seqVal'
   , Entity(..), eFaction, eSeqVal, eStats
   , EntityName(..), entityName
   , EntityIdentifier(..), entityId, entityId'
@@ -61,8 +61,13 @@ faction' = lens (CI.original . fromMaybe unaligned . view faction) (\s a -> s {
 
 newtype SeqVal = SeqVal { _seqVal :: Int }
   deriving (Show, Ord, Eq, Num, Integral, Enum, Real)
-makeLenses ''SeqVal
-  
+
+seqVal :: Integral a => Iso' a SeqVal
+seqVal = iso (SeqVal . fromIntegral) (fromIntegral . _seqVal)
+
+seqVal' :: Prism' String SeqVal
+seqVal' = _Show . seqVal
+
 
 data Entity = Entity
               { _eSeqVal :: Maybe SeqVal
@@ -90,11 +95,12 @@ entityName = iso (EntityName . CI.mk) (CI.original . _entityName)
 newtype EntityIdentifier = EntityIdentifier { _entityId :: Integer }
   deriving (Show, Eq, Ord, Enum)
 
-entityId :: Iso' Integer EntityIdentifier
-entityId = iso EntityIdentifier _entityId
+entityId :: Integral a => Iso' a EntityIdentifier
+entityId = iso (EntityIdentifier . fromIntegral) (fromIntegral . _entityId)
 
 entityId' :: Prism' String EntityIdentifier
-entityId' = prism' (show . _entityId) (fmap EntityIdentifier . readMaybe)
+entityId' = _Show . entityId
+
 
 data GameState = GameState
                  { _gEntities    :: Map EntityIdentifier Entity
@@ -118,7 +124,7 @@ inhabitedFactions = to $ nub . sort . Map.elems . fmap (view eFaction) . view gE
 priorityQueue :: Getter GameState [(SeqVal, EntityIdentifier)]
 priorityQueue = to priorityQueue'
   where
-    priorityQueue' (Map.toAscList . view gEntities -> entities) = sortBy (comparing $ Down . snd) . concat . map filter . map (over _1 $ view eSeqVal) . map swap $ entities
+    priorityQueue' (Map.toAscList . view gEntities -> entities) = sortBy (comparing $ Down . fst) . concat . map filter . map (over _1 $ view eSeqVal) . map swap $ entities
     filter (Nothing, _) = mempty
     filter (Just val, id) = pure (val, id)