{-# LANGUAGE ViewPatterns #-} import Control.Monad import Control.Lens import System.Console.Shell import System.Console.Shell.ShellMonad import System.Console.Shell.Backend.Haskeline import System.Environment.XDG.BaseDir import System.FilePath import System.Directory import Data.Default import Data.CaseInsensitive (CI) import qualified Data.CaseInsensitive import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map import Data.List import Data.Maybe import Data.Function import Control.Monad.State.Strict import Sequence.Types import Sequence.Utils import Text.Layout.Table main :: IO () main = do historyFile <- getUserCacheFile "sequence" "history" createDirectoryIfMissing True $ takeDirectory historyFile let description = initialShellDescription { historyFile = Just historyFile , prompt = \st -> return $ maybe "" (++ " ") ((evalState ?? st) . toName . snd <$> (listToMaybe $ view priorityQueue st)) ++ "→ " , beforePrompt = gets stateOutline >>= (\str -> if null str then return () else shellPutStrLn str) , commandStyle = OnlyCommands , shellCommands = [ exitCommand "exit" , helpCommand "help" , cmd "factions" listFactions "List all inhabited factions" , cmd "members" listFaction "List all members of a faction" , cmd "entities" listEntities "List all entities" ] } void $ runShell description haskelineBackend (def :: GameState) stateOutline :: GameState -> String stateOutline st | null pQueue = "" | otherwise = layoutTableToString rowGs (Just ("" : factions, repeat def)) (repeat def) unicodeBoldHeaderS where factions = map (view faction') $ st ^. inhabitedFactions pQueue = st ^. priorityQueue protoRows = groupBy ((==) `on` fst) pQueue faction id = fromJust $ view eFaction <$> Map.lookup id (st ^. gEntities) factionIndex id = fromJust $ elemIndex (view faction' $ faction id) factions rowGs = do rowGroup'@((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)] listFaction :: Completable Faction -> Sh GameState () listFaction (Completable (flip (set faction') def -> qFaction)) = use gEntities >>= mapM_ (shellPutStrLn <=< toName) . Map.keys . Map.filter ((==) qFaction . view eFaction) listFactions :: Sh GameState () listFactions = use inhabitedFactions >>= mapM_ (shellPutStrLn . view faction') listEntities :: Sh GameState () listEntities = use (gEntities . to Map.keys) >>= mapM_ (shellPutStrLn <=< toName)