Add entities, and allow walking around
Add support for entities via a port of the EntityMap type, and implement command support starting at basic hjkl.
This commit is contained in:
		
							parent
							
								
									6eba471e24
								
							
						
					
					
						commit
						4ef19aa35a
					
				
					 21 changed files with 719 additions and 32 deletions
				
			
		
							
								
								
									
										19
									
								
								package.yaml
									
										
									
									
									
								
							
							
						
						
									
										19
									
								
								package.yaml
									
										
									
									
									
								
							|  | @ -15,17 +15,20 @@ category:            Game | ||||||
| description:         Please see the README on GitHub at <https://github.com/glittershark/xanthous> | description:         Please see the README on GitHub at <https://github.com/glittershark/xanthous> | ||||||
| 
 | 
 | ||||||
| dependencies: | dependencies: | ||||||
| - base |  | ||||||
| - lens |  | ||||||
| - containers |  | ||||||
| - constraints |  | ||||||
| - QuickCheck | - QuickCheck | ||||||
|  | - base | ||||||
|  | - brick | ||||||
|  | - checkers | ||||||
| - classy-prelude | - classy-prelude | ||||||
| - mtl | - constraints | ||||||
|  | - containers | ||||||
| - data-default | - data-default | ||||||
| - deepseq | - deepseq | ||||||
| - ascii-art-to-unicode | - generic-arbitrary | ||||||
| - brick | - generic-monoid | ||||||
|  | - groups | ||||||
|  | - lens | ||||||
|  | - mtl | ||||||
| - vty | - vty | ||||||
| 
 | 
 | ||||||
| default-extensions: | default-extensions: | ||||||
|  | @ -34,6 +37,7 @@ default-extensions: | ||||||
| - DeriveAnyClass | - DeriveAnyClass | ||||||
| - DeriveGeneric | - DeriveGeneric | ||||||
| - DerivingStrategies | - DerivingStrategies | ||||||
|  | - DerivingVia | ||||||
| - FlexibleContexts | - FlexibleContexts | ||||||
| - FlexibleInstances | - FlexibleInstances | ||||||
| - FunctionalDependencies | - FunctionalDependencies | ||||||
|  | @ -77,3 +81,4 @@ tests: | ||||||
|     - tasty |     - tasty | ||||||
|     - tasty-hunit |     - tasty-hunit | ||||||
|     - tasty-quickcheck |     - tasty-quickcheck | ||||||
|  |     - lens-properties | ||||||
|  |  | ||||||
|  | @ -12,6 +12,6 @@ ui = str "Hello, world!" | ||||||
| main :: IO () | main :: IO () | ||||||
| main = do | main = do | ||||||
|   app <- makeApp |   app <- makeApp | ||||||
|   initialState <- getInitialState |   let initialState = getInitialState | ||||||
|   _ <- defaultMain app initialState |   _ <- defaultMain app initialState | ||||||
|   pure () |   pure () | ||||||
|  |  | ||||||
|  | @ -4,10 +4,13 @@ import Xanthous.Prelude | ||||||
| import Brick hiding (App) | import Brick hiding (App) | ||||||
| import qualified Brick | import qualified Brick | ||||||
| import Graphics.Vty.Attributes (defAttr) | import Graphics.Vty.Attributes (defAttr) | ||||||
|  | import Graphics.Vty.Input.Events (Event(EvResize, EvKey)) | ||||||
| 
 | 
 | ||||||
| import Xanthous.Game | import Xanthous.Game | ||||||
| import Xanthous.Game.Draw (drawGame) | import Xanthous.Game.Draw (drawGame) | ||||||
| import Xanthous.Resource (Name) | import Xanthous.Resource (Name) | ||||||
|  | import Xanthous.Command | ||||||
|  | import Xanthous.Data (move) | ||||||
| 
 | 
 | ||||||
| type App = Brick.App GameState () Name | type App = Brick.App GameState () Name | ||||||
| 
 | 
 | ||||||
|  | @ -15,7 +18,18 @@ makeApp :: IO App | ||||||
| makeApp = pure $ Brick.App | makeApp = pure $ Brick.App | ||||||
|   { appDraw = drawGame |   { appDraw = drawGame | ||||||
|   , appChooseCursor = const headMay |   , appChooseCursor = const headMay | ||||||
|   , appHandleEvent = resizeOrQuit |   , appHandleEvent = handleEvent | ||||||
|   , appStartEvent = pure |   , appStartEvent = pure | ||||||
|   , appAttrMap = const $ attrMap defAttr [] |   , appAttrMap = const $ attrMap defAttr [] | ||||||
|   } |   } | ||||||
|  | 
 | ||||||
|  | handleEvent :: GameState -> BrickEvent Name () -> EventM Name (Next GameState) | ||||||
|  | handleEvent game (VtyEvent (EvKey k mods)) | ||||||
|  |   | Just command <- commandFromKey k mods | ||||||
|  |   = handleCommand command game | ||||||
|  | handleEvent game _ = continue game | ||||||
|  | 
 | ||||||
|  | handleCommand :: Command -> GameState -> EventM Name (Next GameState) | ||||||
|  | handleCommand Quit = halt | ||||||
|  | handleCommand (Move dir) = continue . (characterPosition %~ move dir) | ||||||
|  | handleCommand _ = undefined | ||||||
|  |  | ||||||
							
								
								
									
										20
									
								
								src/Xanthous/Command.hs
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										20
									
								
								src/Xanthous/Command.hs
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,20 @@ | ||||||
|  | module Xanthous.Command where | ||||||
|  | 
 | ||||||
|  | import Graphics.Vty.Input (Key(..), Modifier(..)) | ||||||
|  | 
 | ||||||
|  | import Xanthous.Prelude hiding (Left, Right, Down) | ||||||
|  | import Xanthous.Data (Direction(..)) | ||||||
|  | 
 | ||||||
|  | data Command | ||||||
|  |   = Quit | ||||||
|  |   | Move Direction | ||||||
|  |   | PickUp | ||||||
|  |   | PreviousMessage | ||||||
|  | 
 | ||||||
|  | commandFromKey :: Key -> [Modifier] -> Maybe Command | ||||||
|  | commandFromKey (KChar 'q') [] = Just Quit | ||||||
|  | commandFromKey (KChar 'h') [] = Just $ Move Left | ||||||
|  | commandFromKey (KChar 'j') [] = Just $ Move Down | ||||||
|  | commandFromKey (KChar 'k') [] = Just $ Move Up | ||||||
|  | commandFromKey (KChar 'l') [] = Just $ Move Right | ||||||
|  | commandFromKey _ _ = Nothing | ||||||
							
								
								
									
										118
									
								
								src/Xanthous/Data.hs
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										118
									
								
								src/Xanthous/Data.hs
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,118 @@ | ||||||
|  | {-# LANGUAGE DeriveTraversable #-} | ||||||
|  | {-# LANGUAGE DeriveFoldable #-} | ||||||
|  | {-# LANGUAGE DeriveFunctor #-} | ||||||
|  | {-# LANGUAGE TemplateHaskell #-} | ||||||
|  | -------------------------------------------------------------------------------- | ||||||
|  | -- | Common data types for Xanthous | ||||||
|  | -------------------------------------------------------------------------------- | ||||||
|  | module Xanthous.Data | ||||||
|  |   ( Position(..) | ||||||
|  |   , x | ||||||
|  |   , y | ||||||
|  | 
 | ||||||
|  |   , Positioned(..) | ||||||
|  |   , position | ||||||
|  |   , positioned | ||||||
|  |   , loc | ||||||
|  | 
 | ||||||
|  |     -- * | ||||||
|  |   , Direction(..) | ||||||
|  |   , opposite | ||||||
|  |   , move | ||||||
|  |   , asPosition | ||||||
|  |   ) where | ||||||
|  | -------------------------------------------------------------------------------- | ||||||
|  | import Xanthous.Prelude hiding (Left, Down, Right) | ||||||
|  | import Test.QuickCheck (Arbitrary, CoArbitrary, Function) | ||||||
|  | import Test.QuickCheck.Arbitrary.Generic | ||||||
|  | import Data.Group | ||||||
|  | import Brick (Location(Location)) | ||||||
|  | -------------------------------------------------------------------------------- | ||||||
|  | import Xanthous.Util (EqEqProp(..), EqProp) | ||||||
|  | -------------------------------------------------------------------------------- | ||||||
|  | 
 | ||||||
|  | data Position where | ||||||
|  |   Position :: { _x :: Int | ||||||
|  |              , _y :: Int | ||||||
|  |              } -> Position | ||||||
|  |   deriving stock (Show, Eq, Generic, Ord) | ||||||
|  |   deriving anyclass (Hashable, CoArbitrary, Function) | ||||||
|  |   deriving EqProp via EqEqProp Position | ||||||
|  | makeLenses ''Position | ||||||
|  | 
 | ||||||
|  | instance Arbitrary Position where | ||||||
|  |   arbitrary = genericArbitrary | ||||||
|  |   shrink = genericShrink | ||||||
|  | 
 | ||||||
|  | instance Semigroup Position where | ||||||
|  |   (Position x₁ y₁) <> (Position x₂ y₂) = Position (x₁ + x₂) (y₁ + y₂) | ||||||
|  | 
 | ||||||
|  | instance Monoid Position where | ||||||
|  |   mempty = Position 0 0 | ||||||
|  | 
 | ||||||
|  | instance Group Position where | ||||||
|  |   invert (Position px py) = Position (-px) (-py) | ||||||
|  | 
 | ||||||
|  | data Positioned a where | ||||||
|  |   Positioned :: Position -> a -> Positioned a | ||||||
|  |   deriving stock (Show, Eq, Ord, Functor, Foldable, Traversable, Generic) | ||||||
|  |   deriving anyclass (CoArbitrary, Function) | ||||||
|  | 
 | ||||||
|  | instance Arbitrary a => Arbitrary (Positioned a) where | ||||||
|  |   arbitrary = Positioned <$> arbitrary <*> arbitrary | ||||||
|  | 
 | ||||||
|  | position :: Lens' (Positioned a) Position | ||||||
|  | position = lens | ||||||
|  |   (\(Positioned pos _) -> pos) | ||||||
|  |   (\(Positioned _ a) pos -> Positioned pos a) | ||||||
|  | 
 | ||||||
|  | positioned :: Lens (Positioned a) (Positioned b) a b | ||||||
|  | positioned = lens | ||||||
|  |   (\(Positioned _ x') -> x') | ||||||
|  |   (\(Positioned pos _) x' -> Positioned pos x') | ||||||
|  | 
 | ||||||
|  | loc :: Iso' Position Location | ||||||
|  | loc = iso hither yon | ||||||
|  |   where | ||||||
|  |     hither (Position px py) = Location (px, py) | ||||||
|  |     yon (Location (lx, ly)) = Position lx ly | ||||||
|  | 
 | ||||||
|  | -------------------------------------------------------------------------------- | ||||||
|  | 
 | ||||||
|  | data Direction where | ||||||
|  |   Up        :: Direction | ||||||
|  |   Down      :: Direction | ||||||
|  |   Left      :: Direction | ||||||
|  |   Right     :: Direction | ||||||
|  |   UpLeft    :: Direction | ||||||
|  |   UpRight   :: Direction | ||||||
|  |   DownLeft  :: Direction | ||||||
|  |   DownRight :: Direction | ||||||
|  |   deriving stock (Show, Eq, Generic) | ||||||
|  | 
 | ||||||
|  | instance Arbitrary Direction where | ||||||
|  |   arbitrary = genericArbitrary | ||||||
|  |   shrink = genericShrink | ||||||
|  | 
 | ||||||
|  | opposite :: Direction -> Direction | ||||||
|  | opposite Up        = Down | ||||||
|  | opposite Down      = Up | ||||||
|  | opposite Left      = Right | ||||||
|  | opposite Right     = Left | ||||||
|  | opposite UpLeft    = DownRight | ||||||
|  | opposite UpRight   = DownLeft | ||||||
|  | opposite DownLeft  = UpRight | ||||||
|  | opposite DownRight = UpLeft | ||||||
|  | 
 | ||||||
|  | move :: Direction -> Position -> Position | ||||||
|  | move Up        = y -~ 1 | ||||||
|  | move Down      = y +~ 1 | ||||||
|  | move Left      = x -~ 1 | ||||||
|  | move Right     = x +~ 1 | ||||||
|  | move UpLeft    = move Up . move Left | ||||||
|  | move UpRight   = move Up . move Right | ||||||
|  | move DownLeft  = move Down . move Left | ||||||
|  | move DownRight = move Down . move Right | ||||||
|  | 
 | ||||||
|  | asPosition :: Direction -> Position | ||||||
|  | asPosition dir = move dir mempty | ||||||
							
								
								
									
										141
									
								
								src/Xanthous/Data/EntityMap.hs
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										141
									
								
								src/Xanthous/Data/EntityMap.hs
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,141 @@ | ||||||
|  | {-# LANGUAGE DeriveTraversable #-} | ||||||
|  | {-# LANGUAGE TupleSections #-} | ||||||
|  | {-# LANGUAGE TemplateHaskell #-} | ||||||
|  | {-# LANGUAGE StandaloneDeriving #-} | ||||||
|  | {-# LANGUAGE DeriveFunctor #-} | ||||||
|  | 
 | ||||||
|  | module Xanthous.Data.EntityMap | ||||||
|  |   ( EntityMap | ||||||
|  |   , EntityID | ||||||
|  |   , emptyEntityMap | ||||||
|  |   , insertAt | ||||||
|  |   , insertAtReturningID | ||||||
|  |   , atPosition | ||||||
|  |   , positions | ||||||
|  |   , lookup | ||||||
|  |   , lookupWithPosition | ||||||
|  |   -- , positionedEntities | ||||||
|  |   ) where | ||||||
|  | 
 | ||||||
|  | import Data.Monoid (Endo(..)) | ||||||
|  | import Test.QuickCheck (Arbitrary(..)) | ||||||
|  | import Test.QuickCheck.Checkers (EqProp) | ||||||
|  | 
 | ||||||
|  | import Xanthous.Prelude hiding (lookup) | ||||||
|  | import Xanthous.Data (Position, Positioned(..), positioned, position) | ||||||
|  | import Xanthous.Orphans () | ||||||
|  | import Xanthous.Util (EqEqProp(..)) | ||||||
|  | 
 | ||||||
|  | type EntityID = Word32 | ||||||
|  | type NonNullVector a = NonNull (Vector a) | ||||||
|  | 
 | ||||||
|  | data EntityMap a where | ||||||
|  |   EntityMap :: | ||||||
|  |     { _byPosition :: Map Position (NonNullVector EntityID) | ||||||
|  |     , _byID       :: HashMap EntityID (Positioned a) | ||||||
|  |     , _lastID     :: EntityID | ||||||
|  |     } -> EntityMap a | ||||||
|  |   deriving stock (Functor, Foldable, Traversable) | ||||||
|  | deriving via (EqEqProp (EntityMap a)) instance Eq a => EqProp (EntityMap a) | ||||||
|  | makeLenses ''EntityMap | ||||||
|  | 
 | ||||||
|  | byIDInvariantError :: forall a. a | ||||||
|  | byIDInvariantError = error $ "Invariant violation: All EntityIDs in byPosition " | ||||||
|  |   <> "must point to entityIDs in byID" | ||||||
|  | 
 | ||||||
|  | instance Eq a => Eq (EntityMap a) where | ||||||
|  |   em₁ == em₂ = em₁ ^. _EntityMap == em₂ ^. _EntityMap | ||||||
|  | 
 | ||||||
|  | instance Show a => Show (EntityMap a) where | ||||||
|  |   show em = "_EntityMap # " <> show (em ^. _EntityMap) | ||||||
|  | 
 | ||||||
|  | instance Arbitrary a => Arbitrary (EntityMap a) where | ||||||
|  |   arbitrary = review _EntityMap <$> arbitrary | ||||||
|  | 
 | ||||||
|  | type instance Index (EntityMap a) = EntityID | ||||||
|  | type instance IxValue (EntityMap a) = (Positioned a) | ||||||
|  | instance Ixed (EntityMap a) where ix eid = at eid . traverse | ||||||
|  | 
 | ||||||
|  | instance At (EntityMap a) where | ||||||
|  |   at eid = lens (view $ byID . at eid) setter | ||||||
|  |     where | ||||||
|  |       setter :: EntityMap a -> Maybe (Positioned a) -> EntityMap a | ||||||
|  |       setter m Nothing = fromMaybe m $ do | ||||||
|  |         Positioned pos _ <- m ^. byID . at eid | ||||||
|  |         pure $ m | ||||||
|  |           & removeEIDAtPos pos | ||||||
|  |           & byID . at eid .~ Nothing | ||||||
|  |       setter m (Just (Positioned pos e)) = | ||||||
|  |         case lookupWithPosition eid m of | ||||||
|  |           Nothing -> insertAt pos e m | ||||||
|  |           Just (Positioned origPos _) -> m | ||||||
|  |             & removeEIDAtPos origPos | ||||||
|  |             & byID . ix eid . position .~ pos | ||||||
|  |             & byPosition . at pos %~ \case | ||||||
|  |               Nothing -> Just $ ncons eid mempty | ||||||
|  |               Just es -> Just $ eid <| es | ||||||
|  |       removeEIDAtPos pos = | ||||||
|  |         byPosition . at pos %~ (>>= fromNullable . nfilter (/= eid)) | ||||||
|  | 
 | ||||||
|  | emptyEntityMap :: EntityMap a | ||||||
|  | emptyEntityMap = EntityMap mempty mempty 0 | ||||||
|  | 
 | ||||||
|  | _EntityMap :: Iso' (EntityMap a) [(Position, a)] | ||||||
|  | _EntityMap = iso hither yon | ||||||
|  |   where | ||||||
|  |     hither :: EntityMap a -> [(Position, a)] | ||||||
|  |     hither em = do | ||||||
|  |        (pos, eids) <- em ^. byPosition . _Wrapped | ||||||
|  |        eid <- toList eids | ||||||
|  |        ent <- em ^.. byID . at eid . folded . positioned | ||||||
|  |        pure (pos, ent) | ||||||
|  |     yon :: [(Position, a)] -> EntityMap a | ||||||
|  |     yon poses = alaf Endo foldMap (uncurry insertAt) poses emptyEntityMap | ||||||
|  | 
 | ||||||
|  | instance Semigroup (EntityMap a) where | ||||||
|  |   em₁ <> em₂ = alaf Endo foldMap (uncurry insertAt) (em₁ ^. _EntityMap) em₂ | ||||||
|  | 
 | ||||||
|  | instance Monoid (EntityMap a) where | ||||||
|  |   mempty = emptyEntityMap | ||||||
|  | 
 | ||||||
|  | 
 | ||||||
|  | insertAtReturningID :: forall a. Position -> a -> EntityMap a -> (EntityID, EntityMap a) | ||||||
|  | insertAtReturningID pos e em = | ||||||
|  |   let (eid, em') = em & lastID <+~ 1 | ||||||
|  |   in em' | ||||||
|  |      & byID . at eid ?~ Positioned pos e | ||||||
|  |      & byPosition . at pos %~ \case | ||||||
|  |        Nothing -> Just $ ncons eid mempty | ||||||
|  |        Just es -> Just $ eid <| es | ||||||
|  |      & (eid, ) | ||||||
|  | 
 | ||||||
|  | insertAt :: forall a. Position -> a -> EntityMap a -> EntityMap a | ||||||
|  | insertAt pos e = snd . insertAtReturningID pos e | ||||||
|  | 
 | ||||||
|  | atPosition :: forall a. Position -> Lens' (EntityMap a) (Vector a) | ||||||
|  | atPosition pos = lens getter setter | ||||||
|  |   where | ||||||
|  |     getter em = | ||||||
|  |       let | ||||||
|  |         eids :: Vector EntityID | ||||||
|  |         eids = maybe mempty toNullable $ em ^. byPosition . at pos | ||||||
|  | 
 | ||||||
|  |         getEIDAssume :: EntityID -> a | ||||||
|  |         getEIDAssume eid = fromMaybe byIDInvariantError | ||||||
|  |           $ em ^? byID . ix eid . positioned | ||||||
|  |       in getEIDAssume <$> eids | ||||||
|  |     setter em Empty = em & byPosition . at pos .~ Nothing | ||||||
|  |     setter em entities = alaf Endo foldMap (insertAt pos) entities em | ||||||
|  | 
 | ||||||
|  | positions :: EntityMap a -> [Position] | ||||||
|  | positions = toListOf $ byPosition . to keys . folded | ||||||
|  | 
 | ||||||
|  | lookupWithPosition :: EntityID -> EntityMap a -> Maybe (Positioned a) | ||||||
|  | lookupWithPosition eid = view $ byID . at eid | ||||||
|  | 
 | ||||||
|  | lookup :: EntityID -> EntityMap a -> Maybe a | ||||||
|  | lookup eid = fmap (view positioned) . lookupWithPosition eid | ||||||
|  | 
 | ||||||
|  | -- unlawful :( | ||||||
|  | -- positionedEntities :: IndexedTraversal EntityID (EntityMap a) (EntityMap b) (Positioned a) (Positioned b) | ||||||
|  | -- positionedEntities = byID . itraversed | ||||||
							
								
								
									
										64
									
								
								src/Xanthous/Entities.hs
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										64
									
								
								src/Xanthous/Entities.hs
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,64 @@ | ||||||
|  | {-# LANGUAGE UndecidableInstances #-} | ||||||
|  | 
 | ||||||
|  | module Xanthous.Entities | ||||||
|  |   ( Draw(..) | ||||||
|  |   , DrawCharacter(..) | ||||||
|  |   , DrawStyledCharacter(..) | ||||||
|  |   , Entity | ||||||
|  | 
 | ||||||
|  |   , Color(..) | ||||||
|  |   , KnownColor(..) | ||||||
|  |   ) where | ||||||
|  | 
 | ||||||
|  | import Xanthous.Prelude | ||||||
|  | import Brick | ||||||
|  | import Data.Typeable | ||||||
|  | import qualified Graphics.Vty.Attributes as Vty | ||||||
|  | import qualified Graphics.Vty.Image as Vty | ||||||
|  | 
 | ||||||
|  | class Draw a where | ||||||
|  |   draw :: a -> Widget n | ||||||
|  | 
 | ||||||
|  | newtype DrawCharacter (char :: Symbol) (a :: Type) where | ||||||
|  |   DrawCharacter :: a -> DrawCharacter char a | ||||||
|  | 
 | ||||||
|  | instance KnownSymbol char => Draw (DrawCharacter char a) where | ||||||
|  |   draw _ = str $ symbolVal @char Proxy | ||||||
|  | 
 | ||||||
|  | -------------------------------------------------------------------------------- | ||||||
|  | 
 | ||||||
|  | data Color = Black | Red | Green | Yellow | Blue | Magenta | Cyan | White | ||||||
|  | 
 | ||||||
|  | class KnownColor (color :: Color) where | ||||||
|  |   colorVal :: forall proxy. proxy color -> Vty.Color | ||||||
|  | 
 | ||||||
|  | instance KnownColor 'Black where colorVal _ = Vty.black | ||||||
|  | instance KnownColor 'Red where colorVal _ = Vty.red | ||||||
|  | instance KnownColor 'Green where colorVal _ = Vty.green | ||||||
|  | instance KnownColor 'Yellow where colorVal _ = Vty.yellow | ||||||
|  | instance KnownColor 'Blue where colorVal _ = Vty.blue | ||||||
|  | instance KnownColor 'Magenta where colorVal _ = Vty.magenta | ||||||
|  | instance KnownColor 'Cyan where colorVal _ = Vty.cyan | ||||||
|  | instance KnownColor 'White where colorVal _ = Vty.white | ||||||
|  | 
 | ||||||
|  | newtype DrawStyledCharacter (fg :: Color) (bg :: Color) (char :: Symbol) (a :: Type) where | ||||||
|  |   DrawStyledCharacter :: a -> DrawStyledCharacter fg bg char a | ||||||
|  | 
 | ||||||
|  | instance | ||||||
|  |   ( KnownColor fg | ||||||
|  |   , KnownColor bg | ||||||
|  |   , KnownSymbol char | ||||||
|  |   ) | ||||||
|  |   => Draw (DrawStyledCharacter fg bg char a) where | ||||||
|  |   draw _ = raw $ Vty.string attr $ symbolVal @char Proxy | ||||||
|  |     where attr = Vty.Attr | ||||||
|  |             { Vty.attrStyle = Vty.Default | ||||||
|  |             , Vty.attrForeColor = Vty.SetTo $ colorVal @fg Proxy | ||||||
|  |             , Vty.attrBackColor = Vty.SetTo $ colorVal @bg Proxy | ||||||
|  |             , Vty.attrURL = Vty.Default | ||||||
|  |             } | ||||||
|  | 
 | ||||||
|  | -------------------------------------------------------------------------------- | ||||||
|  | 
 | ||||||
|  | class (Show a, Eq a, Draw a) => Entity a | ||||||
|  | instance (Show a, Eq a, Draw a) => Entity a | ||||||
							
								
								
									
										21
									
								
								src/Xanthous/Entities/Character.hs
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										21
									
								
								src/Xanthous/Entities/Character.hs
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,21 @@ | ||||||
|  | module Xanthous.Entities.Character | ||||||
|  |   ( Character(..) | ||||||
|  |   , mkCharacter | ||||||
|  |   ) where | ||||||
|  | 
 | ||||||
|  | import Xanthous.Prelude | ||||||
|  | import Test.QuickCheck | ||||||
|  | 
 | ||||||
|  | import Xanthous.Entities | ||||||
|  | 
 | ||||||
|  | data Character where | ||||||
|  |   Character :: Character | ||||||
|  |   deriving stock (Show, Eq, Ord, Generic) | ||||||
|  |   deriving anyclass (CoArbitrary, Function) | ||||||
|  |   deriving Draw via (DrawCharacter "@" Character) | ||||||
|  | 
 | ||||||
|  | instance Arbitrary Character where | ||||||
|  |   arbitrary = pure Character | ||||||
|  | 
 | ||||||
|  | mkCharacter :: Character | ||||||
|  | mkCharacter = Character | ||||||
							
								
								
									
										34
									
								
								src/Xanthous/Entities/SomeEntity.hs
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										34
									
								
								src/Xanthous/Entities/SomeEntity.hs
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,34 @@ | ||||||
|  | {-# LANGUAGE GADTs #-} | ||||||
|  | module Xanthous.Entities.SomeEntity | ||||||
|  |   ( SomeEntity(..) | ||||||
|  |   , downcastEntity | ||||||
|  |   ) where | ||||||
|  | 
 | ||||||
|  | import Xanthous.Prelude | ||||||
|  | import Test.QuickCheck (Arbitrary(..)) | ||||||
|  | import qualified Test.QuickCheck.Gen as Gen | ||||||
|  | 
 | ||||||
|  | import Xanthous.Entities (Draw(..), Entity) | ||||||
|  | import Data.Typeable | ||||||
|  | import Xanthous.Entities.Character | ||||||
|  | 
 | ||||||
|  | data SomeEntity where | ||||||
|  |   SomeEntity :: forall a. (Entity a, Typeable a) => a -> SomeEntity | ||||||
|  | 
 | ||||||
|  | instance Show SomeEntity where | ||||||
|  |   show (SomeEntity x) = "SomeEntity (" <> show x <> ")" | ||||||
|  | 
 | ||||||
|  | instance Eq SomeEntity where | ||||||
|  |   (SomeEntity (a :: ea)) == (SomeEntity (b :: eb)) = case eqT @ea @eb of | ||||||
|  |     Just Refl -> a == b | ||||||
|  |     _ -> False | ||||||
|  | 
 | ||||||
|  | instance Arbitrary SomeEntity where | ||||||
|  |   arbitrary = Gen.oneof | ||||||
|  |     [pure $ SomeEntity Character] | ||||||
|  | 
 | ||||||
|  | instance Draw SomeEntity where | ||||||
|  |   draw (SomeEntity ent) = draw ent | ||||||
|  | 
 | ||||||
|  | downcastEntity :: (Entity a, Typeable a) => SomeEntity -> Maybe a | ||||||
|  | downcastEntity (SomeEntity e) = cast e | ||||||
|  | @ -1,12 +1,73 @@ | ||||||
|  | {-# LANGUAGE TemplateHaskell #-} | ||||||
|  | {-# LANGUAGE RecordWildCards #-} | ||||||
| module Xanthous.Game | module Xanthous.Game | ||||||
|   ( GameState(..) |   ( GameState(..) | ||||||
|  |   , entities | ||||||
|   , getInitialState |   , getInitialState | ||||||
|  | 
 | ||||||
|  |   , positionedCharacter | ||||||
|  |   , character | ||||||
|  |   , characterPosition | ||||||
|   ) where |   ) where | ||||||
| 
 | 
 | ||||||
| import Xanthous.Prelude | import Xanthous.Prelude | ||||||
|  | import Test.QuickCheck.Arbitrary | ||||||
|  | 
 | ||||||
|  | import Xanthous.Data.EntityMap (EntityMap, EntityID) | ||||||
|  | import qualified Xanthous.Data.EntityMap as EntityMap | ||||||
|  | import Xanthous.Data (Positioned, Position(..), positioned, position) | ||||||
|  | import Xanthous.Entities | ||||||
|  | import Xanthous.Entities.SomeEntity | ||||||
|  | import Xanthous.Entities.Character | ||||||
| 
 | 
 | ||||||
| data GameState = GameState | data GameState = GameState | ||||||
|   { } |   { _entities          :: EntityMap SomeEntity | ||||||
|  |   , _characterEntityID :: EntityID | ||||||
|  |   } | ||||||
|  |   deriving stock (Show, Eq) | ||||||
|  | makeLenses ''GameState | ||||||
| 
 | 
 | ||||||
| getInitialState :: IO GameState | instance Arbitrary GameState where | ||||||
| getInitialState = pure GameState |   arbitrary = do | ||||||
|  |     ents <- arbitrary | ||||||
|  |     char <- arbitrary | ||||||
|  |     pure $ getInitialState | ||||||
|  |       & entities .~ ents | ||||||
|  |       & positionedCharacter .~ char | ||||||
|  | 
 | ||||||
|  | getInitialState :: GameState | ||||||
|  | getInitialState = | ||||||
|  |   let char = mkCharacter | ||||||
|  |       (_characterEntityID, _entities) | ||||||
|  |         = EntityMap.insertAtReturningID | ||||||
|  |           (Position 0 0) | ||||||
|  |           (SomeEntity char) | ||||||
|  |           mempty | ||||||
|  |   in GameState {..} | ||||||
|  | 
 | ||||||
|  | positionedCharacter :: Lens' GameState (Positioned Character) | ||||||
|  | positionedCharacter = lens getPositionedCharacter setPositionedCharacter | ||||||
|  |   where | ||||||
|  |     setPositionedCharacter :: GameState -> Positioned Character -> GameState | ||||||
|  |     setPositionedCharacter game char | ||||||
|  |       = game | ||||||
|  |       &  entities . at (game ^. characterEntityID) | ||||||
|  |       ?~ fmap SomeEntity char | ||||||
|  | 
 | ||||||
|  |     getPositionedCharacter :: GameState -> Positioned Character | ||||||
|  |     getPositionedCharacter game | ||||||
|  |       = over positioned | ||||||
|  |         ( fromMaybe (error "Invariant error: Character was not a character!") | ||||||
|  |         . downcastEntity | ||||||
|  |         ) | ||||||
|  |       . fromMaybe (error "Invariant error: Character not found!") | ||||||
|  |       $ EntityMap.lookupWithPosition | ||||||
|  |         (game ^. characterEntityID) | ||||||
|  |         (game ^. entities) | ||||||
|  | 
 | ||||||
|  | 
 | ||||||
|  | character :: Lens' GameState Character | ||||||
|  | character = positionedCharacter . positioned | ||||||
|  | 
 | ||||||
|  | characterPosition :: Lens' GameState Position | ||||||
|  | characterPosition = positionedCharacter . position | ||||||
|  |  | ||||||
|  | @ -1,28 +1,45 @@ | ||||||
|  | {-# LANGUAGE ViewPatterns #-} | ||||||
|  | 
 | ||||||
| module Xanthous.Game.Draw | module Xanthous.Game.Draw | ||||||
|   ( drawGame |   ( drawGame | ||||||
|   ) where |   ) where | ||||||
| 
 | 
 | ||||||
| import Xanthous.Prelude | import Xanthous.Prelude | ||||||
| import Brick | import Brick hiding (loc) | ||||||
| import Brick.Widgets.Border | import Brick.Widgets.Border | ||||||
| import Brick.Widgets.Border.Style | import Brick.Widgets.Border.Style | ||||||
| 
 | 
 | ||||||
| import Xanthous.Game (GameState(..)) | import Xanthous.Data (Position(Position), x, y, loc) | ||||||
|  | import Xanthous.Data.EntityMap | ||||||
|  | import Xanthous.Entities | ||||||
|  | import Xanthous.Game (GameState(..), entities, characterPosition) | ||||||
| import Xanthous.Resource (Name(..)) | import Xanthous.Resource (Name(..)) | ||||||
| 
 | 
 | ||||||
| drawMessages :: GameState -> Widget Name | drawMessages :: GameState -> Widget Name | ||||||
| drawMessages _ = str "Welcome to Xanthous! It's dangerous out there, why not stay inside?" | drawMessages _ = str "Welcome to Xanthous! It's dangerous out there, why not stay inside?" | ||||||
| 
 | 
 | ||||||
| drawMap :: GameState -> Widget Name | drawEntities :: (Draw a, Show a) => EntityMap a -> Widget Name | ||||||
| drawMap _game | drawEntities em@(fromNullable . positions -> Just entityPositions) | ||||||
|   = viewport MapViewport Both |   = vBox rows | ||||||
|   $ vBox mapRows |  | ||||||
|   where |   where | ||||||
|     -- TODO |     maxPosition = maximum entityPositions | ||||||
|     firstRow = [str "@"] <> replicate 79 (str " ") |     maxY = maxPosition ^. y | ||||||
|     mapRows = firstRow <> (replicate 20 . hBox . replicate 80 $ str " ") |     maxX = maxPosition ^. x | ||||||
|  |     rows = mkRow <$> [0..maxY] | ||||||
|  |     mkRow rowY = hBox $ renderEntityAt . flip Position rowY <$> [0..maxX] | ||||||
|  |     renderEntityAt pos = maybe (str " ") draw $ em ^? atPosition pos . folded | ||||||
|  | drawEntities _ = emptyWidget | ||||||
|  | 
 | ||||||
|  | drawMap :: GameState -> Widget Name | ||||||
|  | drawMap game | ||||||
|  |   = viewport MapViewport Both | ||||||
|  |   . showCursor Character (game ^. characterPosition . loc) | ||||||
|  |   . drawEntities | ||||||
|  |   $ game ^. entities | ||||||
| 
 | 
 | ||||||
| drawGame :: GameState -> [Widget Name] | drawGame :: GameState -> [Widget Name] | ||||||
| drawGame game = pure . withBorderStyle unicode | drawGame game | ||||||
|  |   = pure | ||||||
|  |   . withBorderStyle unicode | ||||||
|   $   drawMessages game |   $   drawMessages game | ||||||
|   <=> border (drawMap game) |   <=> border (drawMap game) | ||||||
|  |  | ||||||
							
								
								
									
										23
									
								
								src/Xanthous/Orphans.hs
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										23
									
								
								src/Xanthous/Orphans.hs
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,23 @@ | ||||||
|  | {-# LANGUAGE UndecidableInstances, PatternSynonyms #-} | ||||||
|  | {-# OPTIONS_GHC -Wno-orphans #-} | ||||||
|  | -- | | ||||||
|  | 
 | ||||||
|  | module Xanthous.Orphans () where | ||||||
|  | 
 | ||||||
|  | import Xanthous.Prelude | ||||||
|  | 
 | ||||||
|  | instance forall s a. | ||||||
|  |   ( Cons s s a a | ||||||
|  |   , MonoFoldable s | ||||||
|  |   ) => Cons (NonNull s) (NonNull s) a a where | ||||||
|  |   _Cons = prism hither yon | ||||||
|  |     where | ||||||
|  |       hither :: (a, NonNull s) -> NonNull s | ||||||
|  |       hither (a, ns) = | ||||||
|  |         let s = toNullable ns | ||||||
|  |         in impureNonNull $ a <| s | ||||||
|  | 
 | ||||||
|  |       yon :: NonNull s -> Either (NonNull s) (a, NonNull s) | ||||||
|  |       yon ns = case ns ^? _Cons of | ||||||
|  |         Nothing -> Left ns | ||||||
|  |         Just (a, ns') -> Right (a, ns') | ||||||
|  | @ -3,8 +3,11 @@ module Xanthous.Prelude | ||||||
|   , Type |   , Type | ||||||
|   , Constraint |   , Constraint | ||||||
|   , module GHC.TypeLits |   , module GHC.TypeLits | ||||||
|  |   , module Control.Lens | ||||||
|   ) where |   ) where | ||||||
| 
 | 
 | ||||||
| import ClassyPrelude hiding (return) | import ClassyPrelude hiding | ||||||
|  |   (return, (<|), unsnoc, uncons, cons, snoc, index, (<.>), Index) | ||||||
| import Data.Kind | import Data.Kind | ||||||
| import GHC.TypeLits hiding (Text) | import GHC.TypeLits hiding (Text) | ||||||
|  | import Control.Lens | ||||||
|  |  | ||||||
|  | @ -6,6 +6,8 @@ import Xanthous.Prelude | ||||||
| 
 | 
 | ||||||
| data Name = MapViewport | data Name = MapViewport | ||||||
|             -- ^ The main viewport where we display the game content |             -- ^ The main viewport where we display the game content | ||||||
|  |           | Character | ||||||
|  |             -- ^ The character | ||||||
|           | MessageBox |           | MessageBox | ||||||
|             -- ^ The box where we display messages to the user |             -- ^ The box where we display messages to the user | ||||||
|   deriving stock (Show, Eq, Ord) |   deriving stock (Show, Eq, Ord) | ||||||
|  |  | ||||||
							
								
								
									
										14
									
								
								src/Xanthous/Util.hs
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										14
									
								
								src/Xanthous/Util.hs
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,14 @@ | ||||||
|  | module Xanthous.Util | ||||||
|  |   ( EqEqProp(..) | ||||||
|  |   , EqProp(..) | ||||||
|  |   ) where | ||||||
|  | 
 | ||||||
|  | import Xanthous.Prelude | ||||||
|  | 
 | ||||||
|  | import Test.QuickCheck.Checkers | ||||||
|  | 
 | ||||||
|  | newtype EqEqProp a = EqEqProp a | ||||||
|  |   deriving newtype Eq | ||||||
|  | 
 | ||||||
|  | instance Eq a => EqProp (EqEqProp a) where | ||||||
|  |   (=-=) = eq | ||||||
							
								
								
									
										15
									
								
								test/Spec.hs
									
										
									
									
									
								
							
							
						
						
									
										15
									
								
								test/Spec.hs
									
										
									
									
									
								
							|  | @ -1,3 +1,14 @@ | ||||||
| -- | | import Test.Prelude | ||||||
|  | import qualified Xanthous.DataSpec | ||||||
|  | import qualified Xanthous.Data.EntityMapSpec | ||||||
|  | import qualified Xanthous.GameSpec | ||||||
| 
 | 
 | ||||||
| module Spec where | main :: IO () | ||||||
|  | main = defaultMain test | ||||||
|  | 
 | ||||||
|  | test :: TestTree | ||||||
|  | test = testGroup "Xanthous" | ||||||
|  |   [ Xanthous.DataSpec.test | ||||||
|  |   , Xanthous.Data.EntityMapSpec.test | ||||||
|  |   , Xanthous.GameSpec.test | ||||||
|  |   ] | ||||||
|  |  | ||||||
							
								
								
									
										18
									
								
								test/Test/Prelude.hs
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										18
									
								
								test/Test/Prelude.hs
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,18 @@ | ||||||
|  | module Test.Prelude | ||||||
|  |   ( module Xanthous.Prelude | ||||||
|  |   , module Test.Tasty | ||||||
|  |   , module Test.Tasty.HUnit | ||||||
|  |   , module Test.Tasty.QuickCheck | ||||||
|  |   , module Test.QuickCheck.Classes | ||||||
|  |   , testBatch | ||||||
|  |   ) where | ||||||
|  | 
 | ||||||
|  | import Xanthous.Prelude hiding (assert, elements) | ||||||
|  | import Test.Tasty | ||||||
|  | import Test.Tasty.QuickCheck | ||||||
|  | import Test.Tasty.HUnit | ||||||
|  | import Test.QuickCheck.Classes | ||||||
|  | import Test.QuickCheck.Checkers (TestBatch) | ||||||
|  | 
 | ||||||
|  | testBatch :: TestBatch -> TestTree | ||||||
|  | testBatch (name, tests) = testGroup name $ uncurry testProperty <$> tests | ||||||
							
								
								
									
										26
									
								
								test/Xanthous/Data/EntityMapSpec.hs
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										26
									
								
								test/Xanthous/Data/EntityMapSpec.hs
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,26 @@ | ||||||
|  | {-# LANGUAGE ApplicativeDo #-} | ||||||
|  | -------------------------------------------------------------------------------- | ||||||
|  | module Xanthous.Data.EntityMapSpec where | ||||||
|  | -------------------------------------------------------------------------------- | ||||||
|  | import Test.Prelude | ||||||
|  | -------------------------------------------------------------------------------- | ||||||
|  | import Xanthous.Data.EntityMap | ||||||
|  | -------------------------------------------------------------------------------- | ||||||
|  | 
 | ||||||
|  | main :: IO () | ||||||
|  | main = defaultMain test | ||||||
|  | 
 | ||||||
|  | test :: TestTree | ||||||
|  | test = testGroup "Xanthous.Data.EntityMap" | ||||||
|  |   [ testBatch $ monoid @(EntityMap Int) mempty | ||||||
|  |   , testGroup "Eq laws" | ||||||
|  |     [ testProperty "reflexivity" $ \(em :: EntityMap Int) -> | ||||||
|  |         em == em | ||||||
|  |     , testProperty "symmetric" $ \(em₁ :: EntityMap Int) em₂ -> | ||||||
|  |         (em₁ == em₂) == (em₂ == em₁) | ||||||
|  |     , testProperty "transitive" $ \(em₁ :: EntityMap Int) em₂ em₃ -> | ||||||
|  |         if (em₁ == em₂ && em₂ == em₃) | ||||||
|  |         then (em₁ == em₃) | ||||||
|  |         else True | ||||||
|  |     ] | ||||||
|  |   ] | ||||||
							
								
								
									
										35
									
								
								test/Xanthous/DataSpec.hs
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										35
									
								
								test/Xanthous/DataSpec.hs
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,35 @@ | ||||||
|  | -- | | ||||||
|  | 
 | ||||||
|  | module Xanthous.DataSpec where | ||||||
|  | 
 | ||||||
|  | import Test.Prelude hiding (Right, Left, Down) | ||||||
|  | import Xanthous.Data | ||||||
|  | import Data.Group | ||||||
|  | 
 | ||||||
|  | main :: IO () | ||||||
|  | main = defaultMain test | ||||||
|  | 
 | ||||||
|  | test :: TestTree | ||||||
|  | test = testGroup "Xanthous.Data" | ||||||
|  |   [ testGroup "Position" | ||||||
|  |     [ testBatch $ monoid @Position mempty | ||||||
|  |     , testProperty "group laws" $ \(pos :: Position) -> | ||||||
|  |         pos <> invert pos == mempty && invert pos <> pos == mempty | ||||||
|  |     ] | ||||||
|  |   , testGroup "Direction" | ||||||
|  |     [ testProperty "opposite is involutive" $ \(dir :: Direction) -> | ||||||
|  |         opposite (opposite dir) == dir | ||||||
|  |     , testProperty "opposite provides inverse" $ \dir -> | ||||||
|  |         invert (asPosition dir) == asPosition (opposite dir) | ||||||
|  |     , testGroup "Move" | ||||||
|  |       [ testCase "Up"        $ move Up mempty        @?= Position 0 (-1) | ||||||
|  |       , testCase "Down"      $ move Down mempty      @?= Position 0 1 | ||||||
|  |       , testCase "Left"      $ move Left mempty      @?= Position (-1) 0 | ||||||
|  |       , testCase "Right"     $ move Right mempty     @?= Position 1 0 | ||||||
|  |       , testCase "UpLeft"    $ move UpLeft mempty    @?= Position (-1) (-1) | ||||||
|  |       , testCase "UpRight"   $ move UpRight mempty   @?= Position 1 (-1) | ||||||
|  |       , testCase "DownLeft"  $ move DownLeft mempty  @?= Position (-1) 1 | ||||||
|  |       , testCase "DownRight" $ move DownRight mempty @?= Position 1 1 | ||||||
|  |       ] | ||||||
|  |     ] | ||||||
|  |   ] | ||||||
							
								
								
									
										30
									
								
								test/Xanthous/GameSpec.hs
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										30
									
								
								test/Xanthous/GameSpec.hs
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,30 @@ | ||||||
|  | module Xanthous.GameSpec where | ||||||
|  | 
 | ||||||
|  | import Test.Prelude hiding (Down) | ||||||
|  | import Xanthous.Game | ||||||
|  | import Control.Lens.Properties | ||||||
|  | import Xanthous.Data (move, Direction(Down)) | ||||||
|  | import Xanthous.Data.EntityMap (atPosition) | ||||||
|  | import Xanthous.Entities.SomeEntity | ||||||
|  | 
 | ||||||
|  | main :: IO () | ||||||
|  | main = defaultMain test | ||||||
|  | 
 | ||||||
|  | test :: TestTree | ||||||
|  | test = testGroup "Xanthous.Game" | ||||||
|  |   [ testGroup "positionedCharacter" | ||||||
|  |     [ testProperty "lens laws" $ isLens positionedCharacter | ||||||
|  |     , testCase "updates the position of the character" $ do | ||||||
|  |       let initialGame = getInitialState | ||||||
|  |           initialPos = initialGame ^. characterPosition | ||||||
|  |           updatedGame = initialGame & characterPosition %~ move Down | ||||||
|  |           updatedPos = updatedGame ^. characterPosition | ||||||
|  |       updatedPos @?= move Down initialPos | ||||||
|  |       updatedGame ^. entities . atPosition initialPos @?= fromList [] | ||||||
|  |       updatedGame ^. entities . atPosition updatedPos | ||||||
|  |         @?= fromList [SomeEntity $ initialGame ^. character] | ||||||
|  |     ] | ||||||
|  |   , testGroup "characterPosition" | ||||||
|  |     [ testProperty "lens laws" $ isLens characterPosition | ||||||
|  |     ] | ||||||
|  |   ] | ||||||
|  | @ -4,7 +4,7 @@ cabal-version: 1.12 | ||||||
| -- | -- | ||||||
| -- see: https://github.com/sol/hpack | -- see: https://github.com/sol/hpack | ||||||
| -- | -- | ||||||
| -- hash: 82abd26f60a9ec818eed37784bf7d873658bb40772a67205c42977a98a108566 | -- hash: d069cdc1d0657c9b140465b8156b86722d399db49289c8352cccb2a70ab548e0 | ||||||
| 
 | 
 | ||||||
| name:           xanthous | name:           xanthous | ||||||
| version:        0.1.0.0 | version:        0.1.0.0 | ||||||
|  | @ -30,26 +30,37 @@ library | ||||||
|   exposed-modules: |   exposed-modules: | ||||||
|       Main |       Main | ||||||
|       Xanthous.App |       Xanthous.App | ||||||
|  |       Xanthous.Command | ||||||
|  |       Xanthous.Data | ||||||
|  |       Xanthous.Data.EntityMap | ||||||
|  |       Xanthous.Entities | ||||||
|  |       Xanthous.Entities.Character | ||||||
|  |       Xanthous.Entities.SomeEntity | ||||||
|       Xanthous.Game |       Xanthous.Game | ||||||
|       Xanthous.Game.Draw |       Xanthous.Game.Draw | ||||||
|  |       Xanthous.Orphans | ||||||
|       Xanthous.Prelude |       Xanthous.Prelude | ||||||
|       Xanthous.Resource |       Xanthous.Resource | ||||||
|  |       Xanthous.Util | ||||||
|   other-modules: |   other-modules: | ||||||
|       Paths_xanthous |       Paths_xanthous | ||||||
|   hs-source-dirs: |   hs-source-dirs: | ||||||
|       src |       src | ||||||
|   default-extensions: ConstraintKinds DataKinds DeriveAnyClass DeriveGeneric DerivingStrategies FlexibleContexts FlexibleInstances FunctionalDependencies GADTSyntax GeneralizedNewtypeDeriving KindSignatures LambdaCase NoImplicitPrelude NoStarIsType OverloadedStrings PolyKinds RankNTypes ScopedTypeVariables TypeApplications TypeFamilies TypeOperators |   default-extensions: ConstraintKinds DataKinds DeriveAnyClass DeriveGeneric DerivingStrategies DerivingVia FlexibleContexts FlexibleInstances FunctionalDependencies GADTSyntax GeneralizedNewtypeDeriving KindSignatures LambdaCase NoImplicitPrelude NoStarIsType OverloadedStrings PolyKinds RankNTypes ScopedTypeVariables TypeApplications TypeFamilies TypeOperators | ||||||
|   ghc-options: -Wall -threaded |   ghc-options: -Wall -threaded | ||||||
|   build-depends: |   build-depends: | ||||||
|       QuickCheck |       QuickCheck | ||||||
|     , ascii-art-to-unicode |  | ||||||
|     , base |     , base | ||||||
|     , brick |     , brick | ||||||
|  |     , checkers | ||||||
|     , classy-prelude |     , classy-prelude | ||||||
|     , constraints |     , constraints | ||||||
|     , containers |     , containers | ||||||
|     , data-default |     , data-default | ||||||
|     , deepseq |     , deepseq | ||||||
|  |     , generic-arbitrary | ||||||
|  |     , generic-monoid | ||||||
|  |     , groups | ||||||
|     , lens |     , lens | ||||||
|     , mtl |     , mtl | ||||||
|     , vty |     , vty | ||||||
|  | @ -59,25 +70,36 @@ executable xanthous | ||||||
|   main-is: Main.hs |   main-is: Main.hs | ||||||
|   other-modules: |   other-modules: | ||||||
|       Xanthous.App |       Xanthous.App | ||||||
|  |       Xanthous.Command | ||||||
|  |       Xanthous.Data | ||||||
|  |       Xanthous.Data.EntityMap | ||||||
|  |       Xanthous.Entities | ||||||
|  |       Xanthous.Entities.Character | ||||||
|  |       Xanthous.Entities.SomeEntity | ||||||
|       Xanthous.Game |       Xanthous.Game | ||||||
|       Xanthous.Game.Draw |       Xanthous.Game.Draw | ||||||
|  |       Xanthous.Orphans | ||||||
|       Xanthous.Prelude |       Xanthous.Prelude | ||||||
|       Xanthous.Resource |       Xanthous.Resource | ||||||
|  |       Xanthous.Util | ||||||
|       Paths_xanthous |       Paths_xanthous | ||||||
|   hs-source-dirs: |   hs-source-dirs: | ||||||
|       src |       src | ||||||
|   default-extensions: ConstraintKinds DataKinds DeriveAnyClass DeriveGeneric DerivingStrategies FlexibleContexts FlexibleInstances FunctionalDependencies GADTSyntax GeneralizedNewtypeDeriving KindSignatures LambdaCase NoImplicitPrelude NoStarIsType OverloadedStrings PolyKinds RankNTypes ScopedTypeVariables TypeApplications TypeFamilies TypeOperators |   default-extensions: ConstraintKinds DataKinds DeriveAnyClass DeriveGeneric DerivingStrategies DerivingVia FlexibleContexts FlexibleInstances FunctionalDependencies GADTSyntax GeneralizedNewtypeDeriving KindSignatures LambdaCase NoImplicitPrelude NoStarIsType OverloadedStrings PolyKinds RankNTypes ScopedTypeVariables TypeApplications TypeFamilies TypeOperators | ||||||
|   ghc-options: -Wall -threaded |   ghc-options: -Wall -threaded | ||||||
|   build-depends: |   build-depends: | ||||||
|       QuickCheck |       QuickCheck | ||||||
|     , ascii-art-to-unicode |  | ||||||
|     , base |     , base | ||||||
|     , brick |     , brick | ||||||
|  |     , checkers | ||||||
|     , classy-prelude |     , classy-prelude | ||||||
|     , constraints |     , constraints | ||||||
|     , containers |     , containers | ||||||
|     , data-default |     , data-default | ||||||
|     , deepseq |     , deepseq | ||||||
|  |     , generic-arbitrary | ||||||
|  |     , generic-monoid | ||||||
|  |     , groups | ||||||
|     , lens |     , lens | ||||||
|     , mtl |     , mtl | ||||||
|     , vty |     , vty | ||||||
|  | @ -88,22 +110,30 @@ test-suite test | ||||||
|   type: exitcode-stdio-1.0 |   type: exitcode-stdio-1.0 | ||||||
|   main-is: Spec.hs |   main-is: Spec.hs | ||||||
|   other-modules: |   other-modules: | ||||||
|  |       Test.Prelude | ||||||
|  |       Xanthous.Data.EntityMapSpec | ||||||
|  |       Xanthous.DataSpec | ||||||
|  |       Xanthous.GameSpec | ||||||
|       Paths_xanthous |       Paths_xanthous | ||||||
|   hs-source-dirs: |   hs-source-dirs: | ||||||
|       test |       test | ||||||
|   default-extensions: ConstraintKinds DataKinds DeriveAnyClass DeriveGeneric DerivingStrategies FlexibleContexts FlexibleInstances FunctionalDependencies GADTSyntax GeneralizedNewtypeDeriving KindSignatures LambdaCase NoImplicitPrelude NoStarIsType OverloadedStrings PolyKinds RankNTypes ScopedTypeVariables TypeApplications TypeFamilies TypeOperators |   default-extensions: ConstraintKinds DataKinds DeriveAnyClass DeriveGeneric DerivingStrategies DerivingVia FlexibleContexts FlexibleInstances FunctionalDependencies GADTSyntax GeneralizedNewtypeDeriving KindSignatures LambdaCase NoImplicitPrelude NoStarIsType OverloadedStrings PolyKinds RankNTypes ScopedTypeVariables TypeApplications TypeFamilies TypeOperators | ||||||
|   ghc-options: -Wall -threaded -threaded -rtsopts -with-rtsopts=-N |   ghc-options: -Wall -threaded -threaded -rtsopts -with-rtsopts=-N | ||||||
|   build-depends: |   build-depends: | ||||||
|       QuickCheck |       QuickCheck | ||||||
|     , ascii-art-to-unicode |  | ||||||
|     , base |     , base | ||||||
|     , brick |     , brick | ||||||
|  |     , checkers | ||||||
|     , classy-prelude |     , classy-prelude | ||||||
|     , constraints |     , constraints | ||||||
|     , containers |     , containers | ||||||
|     , data-default |     , data-default | ||||||
|     , deepseq |     , deepseq | ||||||
|  |     , generic-arbitrary | ||||||
|  |     , generic-monoid | ||||||
|  |     , groups | ||||||
|     , lens |     , lens | ||||||
|  |     , lens-properties | ||||||
|     , mtl |     , mtl | ||||||
|     , tasty |     , tasty | ||||||
|     , tasty-hunit |     , tasty-hunit | ||||||
|  |  | ||||||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue