Implement messages

Implement messages almost the same as in the Rust version, only with
YAML instead of TOML this time, and a regular old mustache template
instead of something handrolled. Besides that, pretty much everything
here is the same.
This commit is contained in:
Griffin Smith 2019-09-01 13:54:27 -04:00
parent 4ef19aa35a
commit 2fd3e4c9ad
13 changed files with 587 additions and 17 deletions

View file

@ -15,8 +15,12 @@ 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:
- QuickCheck
- base - base
- aeson
- QuickCheck
- quickcheck-text
- quickcheck-instances
- brick - brick
- checkers - checkers
- classy-prelude - classy-prelude
@ -24,14 +28,24 @@ dependencies:
- containers - containers
- data-default - data-default
- deepseq - deepseq
- file-embed
- generic-arbitrary - generic-arbitrary
- generic-monoid - generic-monoid
- groups - groups
- lens - lens
- megaparsec
- MonadRandom
- mtl - mtl
- random
- raw-strings-qq
- reflection
- stache
- tomland
- vty - vty
- yaml
default-extensions: default-extensions:
- BlockArguments
- ConstraintKinds - ConstraintKinds
- DataKinds - DataKinds
- DeriveAnyClass - DeriveAnyClass
@ -51,13 +65,13 @@ default-extensions:
- PolyKinds - PolyKinds
- RankNTypes - RankNTypes
- ScopedTypeVariables - ScopedTypeVariables
- TupleSections
- TypeApplications - TypeApplications
- TypeFamilies - TypeFamilies
- TypeOperators - TypeOperators
ghc-options: ghc-options:
- -Wall - -Wall
- -threaded
library: library:
source-dirs: src source-dirs: src
@ -67,6 +81,10 @@ executable:
main: Main.hs main: Main.hs
dependencies: dependencies:
- xanthous - xanthous
ghc-options:
- -threaded
- -rtsopts
- -with-rtsopts=-N
tests: tests:
test: test:

View file

@ -0,0 +1,160 @@
{-# LANGUAGE ConstraintKinds, DataKinds, DeriveGeneric, DerivingVia #-}
{-# LANGUAGE ExplicitNamespaces, FlexibleContexts, FlexibleInstances #-}
{-# LANGUAGE GADTs, GeneralizedNewtypeDeriving, MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds, ScopedTypeVariables, StandaloneDeriving #-}
{-# LANGUAGE TypeApplications, TypeFamilies, TypeInType, TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wall #-}
-- | https://gist.github.com/konn/27c00f784dd883ec2b90eab8bc84a81d
module Data.Aeson.Generic.DerivingVia
( StrFun(..), Setting(..), SumEncoding'(..), DefaultOptions, WithOptions(..)
, -- Utility type synonyms to save ticks (') before promoted data constructors
type Drop, type CamelTo2, type UserDefined
, type TaggedObj, type UntaggedVal, type ObjWithSingleField, type TwoElemArr
, type FieldLabelModifier
, type ConstructorTagModifier
, type AllNullaryToStringTag
, type OmitNothingFields
, type SumEnc
, type UnwrapUnaryRecords
, type TagSingleConstructors
)
where
import Prelude
import Data.Aeson (FromJSON (..), GFromJSON, GToJSON,
ToJSON (..))
import Data.Aeson (Options (..), Zero, camelTo2,
genericParseJSON)
import Data.Aeson (defaultOptions, genericToJSON)
import qualified Data.Aeson as Aeson
import Data.Kind (Constraint, Type)
import Data.Proxy (Proxy (..))
import Data.Reflection (Reifies (..))
import GHC.Generics (Generic, Rep)
import GHC.TypeLits (KnownNat, KnownSymbol, natVal, symbolVal)
import GHC.TypeLits (Nat, Symbol)
newtype WithOptions options a = WithOptions { runWithOptions :: a }
data StrFun = Drop Nat
| CamelTo2 Symbol
| forall p. UserDefined p
type Drop = 'Drop
type CamelTo2 = 'CamelTo2
type UserDefined = 'UserDefined
type family Demoted a where
Demoted Symbol = String
Demoted StrFun = String -> String
Demoted [a] = [Demoted a]
Demoted Setting = Options -> Options
Demoted SumEncoding' = Aeson.SumEncoding
Demoted a = a
data SumEncoding' = TaggedObj {tagFieldName' :: Symbol, contentsFieldName :: Symbol }
| UntaggedVal
| ObjWithSingleField
| TwoElemArr
type TaggedObj = 'TaggedObj
type UntaggedVal = 'UntaggedVal
type ObjWithSingleField = 'ObjWithSingleField
type TwoElemArr = 'TwoElemArr
data Setting = FieldLabelModifier [StrFun]
| ConstructorTagModifier [StrFun]
| AllNullaryToStringTag Bool
| OmitNothingFields Bool
| SumEnc SumEncoding'
| UnwrapUnaryRecords Bool
| TagSingleConstructors Bool
type FieldLabelModifier = 'FieldLabelModifier
type ConstructorTagModifier = 'ConstructorTagModifier
type AllNullaryToStringTag = 'AllNullaryToStringTag
type OmitNothingFields = 'OmitNothingFields
type SumEnc = 'SumEnc
type UnwrapUnaryRecords = 'UnwrapUnaryRecords
type TagSingleConstructors = 'TagSingleConstructors
class Demotable (a :: k) where
demote :: proxy a -> Demoted k
type family All (p :: Type -> Constraint) (xs :: [k]) :: Constraint where
All p '[] = ()
All p (x ': xs) = (p x, All p xs)
instance Reifies f (String -> String) => Demotable ('UserDefined f) where
demote _ = reflect @f Proxy
instance KnownSymbol sym => Demotable sym where
demote = symbolVal
instance (KnownSymbol s, KnownSymbol t) => Demotable ('TaggedObj s t) where
demote _ = Aeson.TaggedObject (symbolVal @s Proxy) (symbolVal @t Proxy)
instance Demotable 'UntaggedVal where
demote _ = Aeson.UntaggedValue
instance Demotable 'ObjWithSingleField where
demote _ = Aeson.ObjectWithSingleField
instance Demotable 'TwoElemArr where
demote _ = Aeson.TwoElemArray
instance Demotable xs => Demotable ('FieldLabelModifier xs) where
demote _ o = o { fieldLabelModifier = foldr (.) id (demote (Proxy @xs)) }
instance Demotable xs => Demotable ('ConstructorTagModifier xs) where
demote _ o = o { constructorTagModifier = foldr (.) id (demote (Proxy @xs)) }
instance Demotable b => Demotable ('AllNullaryToStringTag b) where
demote _ o = o { allNullaryToStringTag = demote (Proxy @b) }
instance Demotable b => Demotable ('OmitNothingFields b) where
demote _ o = o { omitNothingFields = demote (Proxy @b) }
instance Demotable b => Demotable ('UnwrapUnaryRecords b) where
demote _ o = o { unwrapUnaryRecords = demote (Proxy @b) }
instance Demotable b => Demotable ('TagSingleConstructors b) where
demote _ o = o { tagSingleConstructors = demote (Proxy @b) }
instance Demotable b => Demotable ('SumEnc b) where
demote _ o = o { sumEncoding = demote (Proxy @b) }
instance Demotable 'True where
demote _ = True
instance Demotable 'False where
demote _ = False
instance KnownNat n => Demotable ('Drop n) where
demote _ = drop (fromIntegral $ natVal (Proxy :: Proxy n))
instance KnownSymbol sym => Demotable ('CamelTo2 sym) where
demote _ = camelTo2 $ head $ symbolVal @sym Proxy
instance {-# OVERLAPPING #-} Demotable ('[] :: [k]) where
demote _ = []
instance (Demotable (x :: k), Demotable (xs :: [k])) => Demotable (x ': xs) where
demote _ = demote (Proxy @x) : demote (Proxy @xs)
type DefaultOptions = ('[] :: [Setting])
reflectOptions :: forall xs proxy. Demotable (xs :: [Setting]) => proxy xs -> Options
reflectOptions pxy = foldr (.) id (demote pxy) defaultOptions
instance (Demotable (options :: [Setting])) => Reifies options Options where
reflect = reflectOptions
instance (Generic a, GToJSON Zero (Rep a), Reifies (options :: k) Options)
=> ToJSON (WithOptions options a) where
toJSON = genericToJSON (reflect (Proxy @options)) . runWithOptions
instance (Generic a, GFromJSON Zero (Rep a), Reifies (options :: k) Options)
=> FromJSON (WithOptions options a) where
parseJSON = fmap WithOptions . genericParseJSON (reflect (Proxy @options))

View file

@ -4,7 +4,7 @@ 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 Graphics.Vty.Input.Events (Event(EvKey))
import Xanthous.Game import Xanthous.Game
import Xanthous.Game.Draw (drawGame) import Xanthous.Game.Draw (drawGame)
@ -32,4 +32,4 @@ handleEvent game _ = continue game
handleCommand :: Command -> GameState -> EventM Name (Next GameState) handleCommand :: Command -> GameState -> EventM Name (Next GameState)
handleCommand Quit = halt handleCommand Quit = halt
handleCommand (Move dir) = continue . (characterPosition %~ move dir) handleCommand (Move dir) = continue . (characterPosition %~ move dir)
handleCommand _ = undefined handleCommand _ = error "unimplemented"

View file

@ -16,7 +16,6 @@ import Test.QuickCheck.Arbitrary
import Xanthous.Data.EntityMap (EntityMap, EntityID) import Xanthous.Data.EntityMap (EntityMap, EntityID)
import qualified Xanthous.Data.EntityMap as EntityMap import qualified Xanthous.Data.EntityMap as EntityMap
import Xanthous.Data (Positioned, Position(..), positioned, position) import Xanthous.Data (Positioned, Position(..), positioned, position)
import Xanthous.Entities
import Xanthous.Entities.SomeEntity import Xanthous.Entities.SomeEntity
import Xanthous.Entities.Character import Xanthous.Entities.Character

87
src/Xanthous/Messages.hs Normal file
View file

@ -0,0 +1,87 @@
{-# LANGUAGE TemplateHaskell #-}
module Xanthous.Messages
( Message(..)
, resolve
, MessageMap(..)
, lookupMessage
-- * Game messages
, messages
, message
) where
import Xanthous.Prelude
import Data.List.NonEmpty
import Test.QuickCheck hiding (choose)
import Test.QuickCheck.Arbitrary.Generic
import Test.QuickCheck.Instances.UnorderedContainers ()
import Text.Mustache
import Data.Aeson (FromJSON, ToJSON)
import Data.Aeson.Generic.DerivingVia
import Data.FileEmbed
import qualified Data.Yaml as Yaml
import Data.Aeson (toJSON)
import Control.Monad.Random.Class (MonadRandom)
import Xanthous.Random
import Xanthous.Orphans ()
data Message = Single Template | Choice (NonEmpty Template)
deriving stock (Show, Eq, Ord, Generic)
deriving anyclass (CoArbitrary, Function, NFData)
deriving (ToJSON, FromJSON)
via WithOptions '[ SumEnc UntaggedVal ]
Message
instance Arbitrary Message where
arbitrary = genericArbitrary
shrink = genericShrink
resolve :: MonadRandom m => Message -> m Template
resolve (Single t) = pure t
resolve (Choice ts) = choose ts
data MessageMap = Direct Message | Nested (HashMap Text MessageMap)
deriving stock (Show, Eq, Ord, Generic)
deriving anyclass (CoArbitrary, Function, NFData)
deriving (ToJSON, FromJSON)
via WithOptions '[ SumEnc UntaggedVal ]
MessageMap
instance Arbitrary MessageMap where
arbitrary = frequency [ (10, Direct <$> arbitrary)
, (1, Nested <$> arbitrary)
]
lookupMessage :: [Text] -> MessageMap -> Maybe Message
lookupMessage [] (Direct msg) = Just msg
lookupMessage (k:ks) (Nested m) = lookupMessage ks =<< m ^. at k
lookupMessage _ _ = Nothing
type instance Index MessageMap = [Text]
type instance IxValue MessageMap = Message
instance Ixed MessageMap where
ix [] f (Direct msg) = Direct <$> f msg
ix (k:ks) f (Nested m) = case m ^. at k of
Just m' -> ix ks f m' <&> \m'' ->
Nested $ m & at k ?~ m''
Nothing -> pure $ Nested m
ix _ _ m = pure m
--------------------------------------------------------------------------------
rawMessages :: ByteString
rawMessages = $(embedFile "src/Xanthous/messages.yaml")
messages :: MessageMap
messages
= either (error . Yaml.prettyPrintParseException) id
$ Yaml.decodeEither' rawMessages
message :: (MonadRandom m, ToJSON params) => [Text] -> params -> m Text
message path params = maybe notFound renderMessage $ messages ^? ix path
where
renderMessage msg = do
tpl <- resolve msg
pure . toStrict . renderMustache tpl $ toJSON params
notFound = pure "Message not found"

View file

@ -1,10 +1,23 @@
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE UndecidableInstances, PatternSynonyms #-} {-# LANGUAGE UndecidableInstances, PatternSynonyms #-}
{-# OPTIONS_GHC -Wno-orphans #-} {-# OPTIONS_GHC -Wno-orphans #-}
-- | -- |
module Xanthous.Orphans () where module Xanthous.Orphans
( ppTemplate
) where
import Xanthous.Prelude import Xanthous.Prelude hiding (elements)
import Text.Mustache
import Test.QuickCheck
import Data.Text.Arbitrary ()
import Text.Megaparsec (errorBundlePretty)
import Text.Megaparsec.Pos
import Text.Mustache.Type ( showKey )
import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NonEmpty
import Data.Aeson
instance forall s a. instance forall s a.
( Cons s s a a ( Cons s s a a
@ -21,3 +34,121 @@ instance forall s a.
yon ns = case ns ^? _Cons of yon ns = case ns ^? _Cons of
Nothing -> Left ns Nothing -> Left ns
Just (a, ns') -> Right (a, ns') Just (a, ns') -> Right (a, ns')
instance Arbitrary PName where
arbitrary = PName . pack <$> listOf1 (elements ['a'..'z'])
instance Arbitrary Key where
arbitrary = Key <$> listOf1 arbSafeText
where arbSafeText = pack <$> listOf1 (elements ['a'..'z'])
shrink (Key []) = error "unreachable"
shrink k@(Key [_]) = pure k
shrink (Key (p:ps)) = Key . (p :) <$> shrink ps
instance Arbitrary Pos where
arbitrary = mkPos . succ . abs <$> arbitrary
shrink (unPos -> 1) = []
shrink (unPos -> x) = mkPos <$> [x..1]
instance Arbitrary Node where
arbitrary = sized node
where
node n | n > 0 = oneof $ leaves ++ branches (n `div` 2)
node _ = oneof leaves
branches n =
[ Section <$> arbitrary <*> subnodes n
, InvertedSection <$> arbitrary <*> subnodes n
]
subnodes = fmap concatTextBlocks . listOf . node
leaves =
[ TextBlock . pack <$> listOf1 (elements ['a'..'z'])
, EscapedVar <$> arbitrary
, UnescapedVar <$> arbitrary
-- TODO fix pretty-printing of mustache partials
-- , Partial <$> arbitrary <*> arbitrary
]
shrink = genericShrink
concatTextBlocks :: [Node] -> [Node]
concatTextBlocks [] = []
concatTextBlocks [x] = [x]
concatTextBlocks (TextBlock txt : TextBlock txt : xs)
= concatTextBlocks $ TextBlock (txt <> txt) : concatTextBlocks xs
concatTextBlocks (x : xs) = x : concatTextBlocks xs
instance Arbitrary Template where
arbitrary = do
template <- concatTextBlocks <$> arbitrary
templateName <- arbitrary
rest <- arbitrary
pure $ Template
{ templateActual = templateName
, templateCache = rest & at templateName ?~ template
}
shrink (Template actual cache) =
let Just tpl = cache ^. at actual
in do
cache' <- shrink cache
tpl' <- shrink tpl
actual' <- shrink actual
pure $ Template
{ templateActual = actual'
, templateCache = cache' & at actual' ?~ tpl'
}
instance CoArbitrary Template where
coarbitrary = coarbitrary . ppTemplate
instance Function Template where
function = functionMap ppTemplate parseTemplatePartial
where
parseTemplatePartial txt
= compileMustacheText "template" txt ^?! _Right
instance Arbitrary a => Arbitrary (NonEmpty a) where
arbitrary = do
x <- arbitrary
xs <- arbitrary
pure $ x :| xs
instance CoArbitrary a => CoArbitrary (NonEmpty a) where
coarbitrary = coarbitrary . toList
instance Function a => Function (NonEmpty a) where
function = functionMap toList NonEmpty.fromList
ppNode :: Map PName [Node] -> Node -> Text
ppNode _ (TextBlock txt) = txt
ppNode _ (EscapedVar k) = "{{" <> showKey k <> "}}"
ppNode ctx (Section k body) =
let sk = showKey k
in "{{#" <> sk <> "}}" <> foldMap (ppNode ctx) body <> "{{/" <> sk <> "}}"
ppNode _ (UnescapedVar k) = "{{{" <> showKey k <> "}}}"
ppNode ctx (InvertedSection k body) =
let sk = showKey k
in "{{^" <> sk <> "}}" <> foldMap (ppNode ctx) body <> "{{/" <> sk <> "}}"
ppNode _ (Partial n _) = "{{> " <> unPName n <> "}}"
ppTemplate :: Template -> Text
ppTemplate (Template actual cache) =
case cache ^. at actual of
Nothing -> error "Template not found?"
Just nodes -> foldMap (ppNode cache) nodes
instance ToJSON Template where
toJSON = String . ppTemplate
instance FromJSON Template where
parseJSON
= withText "Template"
$ either (fail . errorBundlePretty) pure
. compileMustacheText "template"
instance CoArbitrary Text where
coarbitrary = coarbitrary . unpack
instance Function Text where
function = functionMap unpack pack
deriving anyclass instance NFData Node
deriving anyclass instance NFData Template

View file

@ -4,6 +4,7 @@ module Xanthous.Prelude
, Constraint , Constraint
, module GHC.TypeLits , module GHC.TypeLits
, module Control.Lens , module Control.Lens
, module Data.Void
) where ) where
import ClassyPrelude hiding import ClassyPrelude hiding
@ -11,3 +12,4 @@ import ClassyPrelude hiding
import Data.Kind import Data.Kind
import GHC.TypeLits hiding (Text) import GHC.TypeLits hiding (Text)
import Control.Lens import Control.Lens
import Data.Void

40
src/Xanthous/Random.hs Normal file
View file

@ -0,0 +1,40 @@
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE UndecidableInstances #-}
module Xanthous.Random
( Choose(..)
, ChooseElement(..)
) where
import Xanthous.Prelude
import Data.List.NonEmpty (NonEmpty)
import System.Random
import Control.Monad.Random.Class (MonadRandom(getRandomR))
class Choose a where
type RandomResult a
choose :: MonadRandom m => a -> m (RandomResult a)
newtype ChooseElement a = ChooseElement a
instance MonoFoldable a => Choose (ChooseElement a) where
type RandomResult (ChooseElement a) = Maybe (Element a)
choose (ChooseElement xs) = do
chosenIdx <- getRandomR (0, olength xs - 1)
let pick _ (Just x) = Just x
pick (x, i) Nothing
| i == chosenIdx = Just x
| otherwise = Nothing
pure $ ofoldr pick Nothing $ zip (toList xs) [0..]
instance MonoFoldable a => Choose (NonNull a) where
type RandomResult (NonNull a) = Element a
choose
= fmap (fromMaybe (error "unreachable")) -- why not lol
. choose
. ChooseElement
. toNullable
instance Choose (NonEmpty a) where
type RandomResult (NonEmpty a) = a
choose = choose . fromNonEmpty @[_]

View file

@ -0,0 +1 @@
welcome: Welcome to Xanthous! It's dangerous out there, why not stay inside?

View file

@ -2,6 +2,8 @@ import Test.Prelude
import qualified Xanthous.DataSpec import qualified Xanthous.DataSpec
import qualified Xanthous.Data.EntityMapSpec import qualified Xanthous.Data.EntityMapSpec
import qualified Xanthous.GameSpec import qualified Xanthous.GameSpec
import qualified Xanthous.MessageSpec
import qualified Xanthous.OrphansSpec
main :: IO () main :: IO ()
main = defaultMain test main = defaultMain test
@ -11,4 +13,6 @@ test = testGroup "Xanthous"
[ Xanthous.DataSpec.test [ Xanthous.DataSpec.test
, Xanthous.Data.EntityMapSpec.test , Xanthous.Data.EntityMapSpec.test
, Xanthous.GameSpec.test , Xanthous.GameSpec.test
, Xanthous.MessageSpec.test
, Xanthous.OrphansSpec.test
] ]

View file

@ -0,0 +1,53 @@
{-# LANGUAGE OverloadedLists #-}
module Xanthous.MessageSpec ( main, test ) where
import Test.Prelude
import Xanthous.Messages
import Data.Aeson
import Text.Mustache
import Control.Lens.Properties
main :: IO ()
main = defaultMain test
test :: TestTree
test = testGroup "Xanthous.Messages"
[ testGroup "Message"
[ testGroup "JSON decoding"
[ testCase "Single"
$ decode "\"Test Single Template\""
@?= Just (Single
$ compileMustacheText "template" "Test Single Template"
^?! _Right)
, testCase "Choice"
$ decode "[\"Choice 1\", \"Choice 2\"]"
@?= Just
(Choice
[ compileMustacheText "template" "Choice 1" ^?! _Right
, compileMustacheText "template" "Choice 2" ^?! _Right
])
]
]
, localOption (QuickCheckTests 50)
. localOption (QuickCheckMaxSize 10)
$ testGroup "MessageMap"
[ testGroup "instance Ixed"
[ testProperty "traversal laws" $ \k ->
isTraversal $ ix @MessageMap k
, testCase "preview when exists" $
let
Right tpl = compileMustacheText "foo" "bar"
msg = Single tpl
mm = Nested $ [("foo", Direct msg)]
in mm ^? ix ["foo"] @?= Just msg
]
, testGroup "lookupMessage"
[ testProperty "is equivalent to preview ix" $ \msgMap path ->
lookupMessage path msgMap === msgMap ^? ix path
]
]
, testGroup "Messages"
[ testCase "are all valid" $ messages `deepseq` pure ()
]
]

View file

@ -0,0 +1,31 @@
{-# LANGUAGE BlockArguments #-}
module Xanthous.OrphansSpec where
import Test.Prelude
import Xanthous.Orphans
import Text.Mustache
import Text.Megaparsec (errorBundlePretty)
import Xanthous.Orphans ()
main :: IO ()
main = defaultMain test
test :: TestTree
test = testGroup "Xanthous.Orphans"
[ localOption (QuickCheckTests 50)
. localOption (QuickCheckMaxSize 10)
$ testGroup "Template"
[ testProperty "ppTemplate / compileMustacheText " \tpl ->
let src = ppTemplate tpl
res :: Either String Template
res = over _Left errorBundlePretty
$ compileMustacheText (templateActual tpl) src
expected = templateCache tpl ^?! at (templateActual tpl)
in
counterexample (unpack src)
$ Right expected === do
(Template actual cache) <- res
maybe (Left "Template not found") Right $ cache ^? at actual
]
]

View file

@ -4,7 +4,7 @@ cabal-version: 1.12
-- --
-- see: https://github.com/sol/hpack -- see: https://github.com/sol/hpack
-- --
-- hash: d069cdc1d0657c9b140465b8156b86722d399db49289c8352cccb2a70ab548e0 -- hash: d86e44c1f3fe890c699f9af19ae10b013973d1cb6e79cc403d6e1c35a74c99c1
name: xanthous name: xanthous
version: 0.1.0.0 version: 0.1.0.0
@ -28,6 +28,7 @@ source-repository head
library library
exposed-modules: exposed-modules:
Data.Aeson.Generic.DerivingVia
Main Main
Xanthous.App Xanthous.App
Xanthous.Command Xanthous.Command
@ -38,18 +39,22 @@ library
Xanthous.Entities.SomeEntity Xanthous.Entities.SomeEntity
Xanthous.Game Xanthous.Game
Xanthous.Game.Draw Xanthous.Game.Draw
Xanthous.Messages
Xanthous.Orphans Xanthous.Orphans
Xanthous.Prelude Xanthous.Prelude
Xanthous.Random
Xanthous.Resource Xanthous.Resource
Xanthous.Util 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 DerivingVia FlexibleContexts FlexibleInstances FunctionalDependencies GADTSyntax GeneralizedNewtypeDeriving KindSignatures LambdaCase NoImplicitPrelude NoStarIsType OverloadedStrings PolyKinds RankNTypes ScopedTypeVariables TypeApplications TypeFamilies TypeOperators default-extensions: BlockArguments ConstraintKinds DataKinds DeriveAnyClass DeriveGeneric DerivingStrategies DerivingVia FlexibleContexts FlexibleInstances FunctionalDependencies GADTSyntax GeneralizedNewtypeDeriving KindSignatures LambdaCase NoImplicitPrelude NoStarIsType OverloadedStrings PolyKinds RankNTypes ScopedTypeVariables TupleSections TypeApplications TypeFamilies TypeOperators
ghc-options: -Wall -threaded ghc-options: -Wall
build-depends: build-depends:
QuickCheck MonadRandom
, QuickCheck
, aeson
, base , base
, brick , brick
, checkers , checkers
@ -58,17 +63,28 @@ library
, containers , containers
, data-default , data-default
, deepseq , deepseq
, file-embed
, generic-arbitrary , generic-arbitrary
, generic-monoid , generic-monoid
, groups , groups
, lens , lens
, megaparsec
, mtl , mtl
, quickcheck-instances
, quickcheck-text
, random
, raw-strings-qq
, reflection
, stache
, tomland
, vty , vty
, yaml
default-language: Haskell2010 default-language: Haskell2010
executable xanthous executable xanthous
main-is: Main.hs main-is: Main.hs
other-modules: other-modules:
Data.Aeson.Generic.DerivingVia
Xanthous.App Xanthous.App
Xanthous.Command Xanthous.Command
Xanthous.Data Xanthous.Data
@ -78,17 +94,21 @@ executable xanthous
Xanthous.Entities.SomeEntity Xanthous.Entities.SomeEntity
Xanthous.Game Xanthous.Game
Xanthous.Game.Draw Xanthous.Game.Draw
Xanthous.Messages
Xanthous.Orphans Xanthous.Orphans
Xanthous.Prelude Xanthous.Prelude
Xanthous.Random
Xanthous.Resource Xanthous.Resource
Xanthous.Util Xanthous.Util
Paths_xanthous Paths_xanthous
hs-source-dirs: hs-source-dirs:
src src
default-extensions: ConstraintKinds DataKinds DeriveAnyClass DeriveGeneric DerivingStrategies DerivingVia FlexibleContexts FlexibleInstances FunctionalDependencies GADTSyntax GeneralizedNewtypeDeriving KindSignatures LambdaCase NoImplicitPrelude NoStarIsType OverloadedStrings PolyKinds RankNTypes ScopedTypeVariables TypeApplications TypeFamilies TypeOperators default-extensions: BlockArguments ConstraintKinds DataKinds DeriveAnyClass DeriveGeneric DerivingStrategies DerivingVia FlexibleContexts FlexibleInstances FunctionalDependencies GADTSyntax GeneralizedNewtypeDeriving KindSignatures LambdaCase NoImplicitPrelude NoStarIsType OverloadedStrings PolyKinds RankNTypes ScopedTypeVariables TupleSections TypeApplications TypeFamilies TypeOperators
ghc-options: -Wall -threaded ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N
build-depends: build-depends:
QuickCheck MonadRandom
, QuickCheck
, aeson
, base , base
, brick , brick
, checkers , checkers
@ -97,13 +117,23 @@ executable xanthous
, containers , containers
, data-default , data-default
, deepseq , deepseq
, file-embed
, generic-arbitrary , generic-arbitrary
, generic-monoid , generic-monoid
, groups , groups
, lens , lens
, megaparsec
, mtl , mtl
, quickcheck-instances
, quickcheck-text
, random
, raw-strings-qq
, reflection
, stache
, tomland
, vty , vty
, xanthous , xanthous
, yaml
default-language: Haskell2010 default-language: Haskell2010
test-suite test test-suite test
@ -114,13 +144,17 @@ test-suite test
Xanthous.Data.EntityMapSpec Xanthous.Data.EntityMapSpec
Xanthous.DataSpec Xanthous.DataSpec
Xanthous.GameSpec Xanthous.GameSpec
Xanthous.MessageSpec
Xanthous.OrphansSpec
Paths_xanthous Paths_xanthous
hs-source-dirs: hs-source-dirs:
test test
default-extensions: ConstraintKinds DataKinds DeriveAnyClass DeriveGeneric DerivingStrategies DerivingVia FlexibleContexts FlexibleInstances FunctionalDependencies GADTSyntax GeneralizedNewtypeDeriving KindSignatures LambdaCase NoImplicitPrelude NoStarIsType OverloadedStrings PolyKinds RankNTypes ScopedTypeVariables TypeApplications TypeFamilies TypeOperators default-extensions: BlockArguments ConstraintKinds DataKinds DeriveAnyClass DeriveGeneric DerivingStrategies DerivingVia FlexibleContexts FlexibleInstances FunctionalDependencies GADTSyntax GeneralizedNewtypeDeriving KindSignatures LambdaCase NoImplicitPrelude NoStarIsType OverloadedStrings PolyKinds RankNTypes ScopedTypeVariables TupleSections TypeApplications TypeFamilies TypeOperators
ghc-options: -Wall -threaded -threaded -rtsopts -with-rtsopts=-N ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N
build-depends: build-depends:
QuickCheck MonadRandom
, QuickCheck
, aeson
, base , base
, brick , brick
, checkers , checkers
@ -129,15 +163,25 @@ test-suite test
, containers , containers
, data-default , data-default
, deepseq , deepseq
, file-embed
, generic-arbitrary , generic-arbitrary
, generic-monoid , generic-monoid
, groups , groups
, lens , lens
, lens-properties , lens-properties
, megaparsec
, mtl , mtl
, quickcheck-instances
, quickcheck-text
, random
, raw-strings-qq
, reflection
, stache
, tasty , tasty
, tasty-hunit , tasty-hunit
, tasty-quickcheck , tasty-quickcheck
, tomland
, vty , vty
, xanthous , xanthous
, yaml
default-language: Haskell2010 default-language: Haskell2010