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:
		
							parent
							
								
									4ef19aa35a
								
							
						
					
					
						commit
						2fd3e4c9ad
					
				
					 13 changed files with 587 additions and 17 deletions
				
			
		
							
								
								
									
										22
									
								
								package.yaml
									
										
									
									
									
								
							
							
						
						
									
										22
									
								
								package.yaml
									
										
									
									
									
								
							|  | @ -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: | ||||||
|  |  | ||||||
							
								
								
									
										160
									
								
								src/Data/Aeson/Generic/DerivingVia.hs
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										160
									
								
								src/Data/Aeson/Generic/DerivingVia.hs
									
										
									
									
									
										Normal 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)) | ||||||
|  | @ -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" | ||||||
|  |  | ||||||
|  | @ -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
									
								
							
							
						
						
									
										87
									
								
								src/Xanthous/Messages.hs
									
										
									
									
									
										Normal 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" | ||||||
|  | @ -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 | ||||||
|  |  | ||||||
|  | @ -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
									
								
							
							
						
						
									
										40
									
								
								src/Xanthous/Random.hs
									
										
									
									
									
										Normal 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 @[_] | ||||||
							
								
								
									
										1
									
								
								src/Xanthous/messages.yaml
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										1
									
								
								src/Xanthous/messages.yaml
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1 @@ | ||||||
|  | welcome: Welcome to Xanthous! It's dangerous out there, why not stay inside? | ||||||
|  | @ -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 | ||||||
|   ] |   ] | ||||||
|  |  | ||||||
							
								
								
									
										53
									
								
								test/Xanthous/MessageSpec.hs
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										53
									
								
								test/Xanthous/MessageSpec.hs
									
										
									
									
									
										Normal 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 () | ||||||
|  |     ] | ||||||
|  |   ] | ||||||
							
								
								
									
										31
									
								
								test/Xanthous/OrphansSpec.hs
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										31
									
								
								test/Xanthous/OrphansSpec.hs
									
										
									
									
									
										Normal 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 | ||||||
|  |     ] | ||||||
|  |   ] | ||||||
|  | @ -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 | ||||||
|  |  | ||||||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue