Add cellular-automata cave generator
Add a cellular-automata-based cave level generator, plus an optparse-applicative-based CLI for invoking level generators in general.
This commit is contained in:
		
							parent
							
								
									73a52e531d
								
							
						
					
					
						commit
						f03ad6bbd6
					
				
					 10 changed files with 434 additions and 8 deletions
				
			
		|  | @ -18,6 +18,7 @@ dependencies: | |||
| - base | ||||
| 
 | ||||
| - aeson | ||||
| - array | ||||
| - QuickCheck | ||||
| - quickcheck-text | ||||
| - quickcheck-instances | ||||
|  | @ -37,6 +38,7 @@ dependencies: | |||
| - megaparsec | ||||
| - MonadRandom | ||||
| - mtl | ||||
| - optparse-applicative | ||||
| - random | ||||
| - raw-strings-qq | ||||
| - reflection | ||||
|  |  | |||
							
								
								
									
										62
									
								
								src/Main.hs
									
										
									
									
									
								
							
							
						
						
									
										62
									
								
								src/Main.hs
									
										
									
									
									
								
							|  | @ -2,16 +2,70 @@ module Main where | |||
| 
 | ||||
| import Xanthous.Prelude | ||||
| import Brick | ||||
| import qualified Options.Applicative as Opt | ||||
| import System.Random | ||||
| 
 | ||||
| import Xanthous.Game (getInitialState) | ||||
| import Xanthous.App (makeApp) | ||||
| import Xanthous.Generators | ||||
|   ( GeneratorInput(..) | ||||
|   , parseGeneratorInput | ||||
|   , generateFromInput | ||||
|   , showCells | ||||
|   ) | ||||
| import Xanthous.Data (Dimensions, Dimensions'(Dimensions)) | ||||
| 
 | ||||
| ui :: Widget () | ||||
| ui = str "Hello, world!" | ||||
| data Command | ||||
|   = Run | ||||
|   | Generate GeneratorInput Dimensions | ||||
| 
 | ||||
| main :: IO () | ||||
| main = do | ||||
| parseDimensions :: Opt.Parser Dimensions | ||||
| parseDimensions = Dimensions | ||||
|   <$> Opt.option Opt.auto | ||||
|        ( Opt.short 'w' | ||||
|        <> Opt.long "width" | ||||
|        ) | ||||
|   <*> Opt.option Opt.auto | ||||
|        ( Opt.short 'h' | ||||
|        <> Opt.long "height" | ||||
|        ) | ||||
| 
 | ||||
| parseCommand :: Opt.Parser Command | ||||
| parseCommand = Opt.subparser | ||||
|   $ Opt.command "run" | ||||
|       (Opt.info | ||||
|        (pure Run) | ||||
|        (Opt.progDesc "Run the game")) | ||||
|   <> Opt.command "generate" | ||||
|       (Opt.info | ||||
|        (Generate | ||||
|         <$> parseGeneratorInput | ||||
|         <*> parseDimensions | ||||
|         <**> Opt.helper | ||||
|        ) | ||||
|        (Opt.progDesc "Generate a sample level")) | ||||
| 
 | ||||
| optParser :: Opt.ParserInfo Command | ||||
| optParser = Opt.info | ||||
|   (parseCommand <**> Opt.helper) | ||||
|   (Opt.header "Xanthous: a WIP TUI RPG") | ||||
| 
 | ||||
| runGame :: IO () | ||||
| runGame =  do | ||||
|   app <- makeApp | ||||
|   initialState <- getInitialState | ||||
|   _ <- defaultMain app initialState | ||||
|   pure () | ||||
| 
 | ||||
| runGenerate :: GeneratorInput -> Dimensions -> IO () | ||||
| runGenerate input dims = do | ||||
|   randGen <- getStdGen | ||||
|   let res = generateFromInput input dims randGen | ||||
|   putStrLn $ showCells res | ||||
| 
 | ||||
| runCommand :: Command -> IO () | ||||
| runCommand Run = runGame | ||||
| runCommand (Generate input dims) = runGenerate input dims | ||||
| 
 | ||||
| main :: IO () | ||||
| main = runCommand =<< Opt.execParser optParser | ||||
|  |  | |||
|  | @ -16,6 +16,12 @@ module Xanthous.Data | |||
|   , positioned | ||||
|   , loc | ||||
| 
 | ||||
|     -- * | ||||
|   , Dimensions'(..) | ||||
|   , Dimensions | ||||
|   , HasWidth(..) | ||||
|   , HasHeight(..) | ||||
| 
 | ||||
|     -- * | ||||
|   , Direction(..) | ||||
|   , opposite | ||||
|  | @ -88,6 +94,21 @@ loc = iso hither yon | |||
| 
 | ||||
| -------------------------------------------------------------------------------- | ||||
| 
 | ||||
| data Dimensions' a = Dimensions | ||||
|   { _width :: a | ||||
|   , _height :: a | ||||
|   } | ||||
|   deriving stock (Show, Eq, Functor, Generic) | ||||
|   deriving anyclass (CoArbitrary, Function) | ||||
| makeFieldsNoPrefix ''Dimensions' | ||||
| 
 | ||||
| instance Arbitrary a => Arbitrary (Dimensions' a) where | ||||
|   arbitrary = Dimensions <$> arbitrary <*> arbitrary | ||||
| 
 | ||||
| type Dimensions = Dimensions' Word | ||||
| 
 | ||||
| -------------------------------------------------------------------------------- | ||||
| 
 | ||||
| data Direction where | ||||
|   Up        :: Direction | ||||
|   Down      :: Direction | ||||
|  |  | |||
							
								
								
									
										54
									
								
								src/Xanthous/Generators.hs
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										54
									
								
								src/Xanthous/Generators.hs
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,54 @@ | |||
| {-# LANGUAGE GADTs #-} | ||||
| 
 | ||||
| module Xanthous.Generators where | ||||
| 
 | ||||
| import Xanthous.Prelude | ||||
| import Data.Array.Unboxed | ||||
| import System.Random (RandomGen) | ||||
| import qualified Options.Applicative as Opt | ||||
| 
 | ||||
| import qualified Xanthous.Generators.CaveAutomata as CaveAutomata | ||||
| import Xanthous.Data (Dimensions) | ||||
| 
 | ||||
| data Generator = CaveAutomata | ||||
|   deriving stock (Show, Eq) | ||||
| 
 | ||||
| data SGenerator (gen :: Generator) where | ||||
|   SCaveAutomata :: SGenerator 'CaveAutomata | ||||
| 
 | ||||
| data AGenerator where | ||||
|   AGenerator :: forall gen. SGenerator gen -> AGenerator | ||||
| 
 | ||||
| type family Params (gen :: Generator) :: Type where | ||||
|   Params 'CaveAutomata = CaveAutomata.Params | ||||
| 
 | ||||
| generate | ||||
|   :: RandomGen g | ||||
|   => SGenerator gen | ||||
|   -> Params gen | ||||
|   -> Dimensions | ||||
|   -> g | ||||
|   -> UArray (Word, Word) Bool | ||||
| generate SCaveAutomata = CaveAutomata.generate | ||||
| 
 | ||||
| data GeneratorInput where | ||||
|   GeneratorInput :: forall gen. SGenerator gen -> Params gen -> GeneratorInput | ||||
| 
 | ||||
| generateFromInput :: RandomGen g => GeneratorInput -> Dimensions -> g -> UArray (Word, Word) Bool | ||||
| generateFromInput (GeneratorInput sg ps) = generate sg ps | ||||
| 
 | ||||
| parseGeneratorInput :: Opt.Parser GeneratorInput | ||||
| parseGeneratorInput = Opt.subparser $ | ||||
|   Opt.command "cave" (Opt.info | ||||
|                       (GeneratorInput <$> pure SCaveAutomata <*> CaveAutomata.parseParams) | ||||
|                       (Opt.progDesc "cellular-automata based cave generator")) | ||||
| 
 | ||||
| showCells :: UArray (Word, Word) Bool -> Text | ||||
| showCells arr = | ||||
|   let ((minX, minY), (maxX, maxY)) = bounds arr | ||||
|       showCellVal True = "x" | ||||
|       showCellVal False = " " | ||||
|       showCell = showCellVal . (arr !) | ||||
|       row r = foldMap (showCell . (, r)) [minX..maxX] | ||||
|       rows = row <$> [minY..maxY] | ||||
|   in intercalate "\n" rows | ||||
							
								
								
									
										112
									
								
								src/Xanthous/Generators/CaveAutomata.hs
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										112
									
								
								src/Xanthous/Generators/CaveAutomata.hs
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,112 @@ | |||
| {-# LANGUAGE MultiWayIf #-} | ||||
| {-# LANGUAGE ViewPatterns #-} | ||||
| {-# LANGUAGE RecordWildCards #-} | ||||
| {-# LANGUAGE TemplateHaskell #-} | ||||
| 
 | ||||
| module Xanthous.Generators.CaveAutomata | ||||
|   ( Params(..) | ||||
|   , defaultParams | ||||
|   , parseParams | ||||
|   , generate | ||||
|   ) where | ||||
| 
 | ||||
| import Xanthous.Prelude | ||||
| import Control.Monad.Random (RandomGen, runRandT) | ||||
| import Data.Array.ST | ||||
| import Data.Array.Unboxed | ||||
| import qualified Options.Applicative as Opt | ||||
| 
 | ||||
| import Xanthous.Util (between) | ||||
| import Xanthous.Data (Dimensions, width, height) | ||||
| import Xanthous.Generators.Util | ||||
| 
 | ||||
| data Params = Params | ||||
|   { _aliveStartChance :: Double | ||||
|   , _birthLimit :: Word | ||||
|   , _deathLimit :: Word | ||||
|   , _steps :: Word | ||||
|   } | ||||
|   deriving stock (Show, Eq, Generic) | ||||
| makeLenses ''Params | ||||
| 
 | ||||
| defaultParams :: Params | ||||
| defaultParams = Params | ||||
|   { _aliveStartChance = 0.6 | ||||
|   , _birthLimit = 3 | ||||
|   , _deathLimit = 4 | ||||
|   , _steps = 4 | ||||
|   } | ||||
| 
 | ||||
| parseParams :: Opt.Parser Params | ||||
| parseParams = Params | ||||
|   <$> Opt.option parseChance | ||||
|       ( Opt.long "alive-start-chance" | ||||
|       <> Opt.value (defaultParams ^. aliveStartChance) | ||||
|       <> Opt.showDefault | ||||
|       <> Opt.help ( "Chance for each cell to start alive at the beginning of " | ||||
|                  <> "the cellular automata" | ||||
|                  ) | ||||
|       <> Opt.metavar "CHANCE" | ||||
|       ) | ||||
|   <*> Opt.option parseNeighbors | ||||
|       ( Opt.long "birth-limit" | ||||
|       <> Opt.value (defaultParams ^. birthLimit) | ||||
|       <> Opt.showDefault | ||||
|       <> Opt.help "Minimum neighbor count required for birth of a cell" | ||||
|       <> Opt.metavar "NEIGHBORS" | ||||
|       ) | ||||
|   <*> Opt.option parseNeighbors | ||||
|       ( Opt.long "death-limit" | ||||
|       <> Opt.value (defaultParams ^. deathLimit) | ||||
|       <> Opt.showDefault | ||||
|       <> Opt.help "Maximum neighbor count required for death of a cell" | ||||
|       <> Opt.metavar "NEIGHBORS" | ||||
|       ) | ||||
|   <*> Opt.option Opt.auto | ||||
|       ( Opt.long "steps" | ||||
|       <> Opt.value (defaultParams ^. steps) | ||||
|       <> Opt.showDefault | ||||
|       <> Opt.help "Number of generations to run the automata for" | ||||
|       <> Opt.metavar "STEPS" | ||||
|       ) | ||||
|   where | ||||
|     readWithGuard predicate errmsg = do | ||||
|       res <- Opt.auto | ||||
|       unless (predicate res) | ||||
|         $ Opt.readerError | ||||
|         $ errmsg res | ||||
|       pure res | ||||
| 
 | ||||
|     parseChance = readWithGuard | ||||
|       (between 0 1) | ||||
|       $ \res -> "Chance must be in the range [0,1], got: " <> show res | ||||
| 
 | ||||
|     parseNeighbors = readWithGuard | ||||
|       (between 0 8) | ||||
|       $ \res -> "Neighbors must be in the range [0,8], got: " <> show res | ||||
| 
 | ||||
| generate :: RandomGen g => Params -> Dimensions -> g -> UArray (Word, Word) Bool | ||||
| generate params dims gen | ||||
|   = runSTUArray | ||||
|   $ fmap fst | ||||
|   $ flip runRandT gen | ||||
|   $ generate' params dims | ||||
| 
 | ||||
| generate' :: RandomGen g => Params -> Dimensions -> CellM g s (Cells s) | ||||
| generate' params dims = do | ||||
|   cells <- randInitialize dims $ params ^. aliveStartChance | ||||
|   let steps' = params ^. steps | ||||
|   when (steps' > 0) | ||||
|    $ for_ [0 .. pred steps'] . const $ stepAutomata cells dims params | ||||
|   pure cells | ||||
| 
 | ||||
| stepAutomata :: forall s g. Cells s -> Dimensions -> Params -> CellM g s () | ||||
| stepAutomata cells dims params = do | ||||
|   origCells <- lift $ cloneMArray @_ @(STUArray s) cells | ||||
|   for_ (range ((0, 0), (dims ^. width, dims ^. height))) $ \pos -> do | ||||
|     neighs <- lift $ numAliveNeighborsM origCells pos | ||||
|     origValue <- lift $ readArray origCells pos | ||||
|     lift . writeArray cells pos | ||||
|       $ if origValue | ||||
|         then neighs >= params ^. deathLimit | ||||
|         else neighs > params ^. birthLimit | ||||
							
								
								
									
										70
									
								
								src/Xanthous/Generators/Util.hs
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										70
									
								
								src/Xanthous/Generators/Util.hs
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,70 @@ | |||
| -- | | ||||
| 
 | ||||
| module Xanthous.Generators.Util | ||||
|   ( Cells | ||||
|   , CellM | ||||
|   , randInitialize | ||||
|   , numAliveNeighborsM | ||||
|   , cloneMArray | ||||
|   ) where | ||||
| 
 | ||||
| import Xanthous.Prelude | ||||
| import Data.Array.ST | ||||
| import Data.Array.Unboxed | ||||
| import Control.Monad.ST | ||||
| import Control.Monad.Random | ||||
| import Data.Monoid | ||||
| 
 | ||||
| import Xanthous.Util (foldlMapM') | ||||
| import Xanthous.Data (Dimensions, width, height) | ||||
| 
 | ||||
| type Cells s = STUArray s (Word, Word) Bool | ||||
| type CellM g s a = RandT g (ST s) a | ||||
| 
 | ||||
| randInitialize :: RandomGen g => Dimensions -> Double -> CellM g s (Cells s) | ||||
| randInitialize dims aliveChance = do | ||||
|   res <- lift $ newArray ((0, 0), (dims ^. width, dims ^. height)) False | ||||
|   for_ [0..dims ^. width] $ \i -> | ||||
|     for_ [0..dims ^. height] $ \j -> do | ||||
|       val <- (>= aliveChance) <$> getRandomR (0, 1) | ||||
|       lift $ writeArray res (i, j) val | ||||
|   pure res | ||||
| 
 | ||||
| numAliveNeighborsM | ||||
|   :: forall a i j m | ||||
|   . (MArray a Bool m, Ix (i, j), Integral i, Integral j) | ||||
|   => a (i, j) Bool | ||||
|   -> (i, j) | ||||
|   -> m Word | ||||
| numAliveNeighborsM cells (x, y) = do | ||||
|   cellBounds <- getBounds cells | ||||
|   getSum <$> foldlMapM' | ||||
|     (fmap (Sum . fromIntegral . fromEnum) . boundedGet cellBounds) | ||||
|     neighborPositions | ||||
| 
 | ||||
|   where | ||||
|     boundedGet :: ((i, j), (i, j)) -> (Int, Int) -> m Bool | ||||
|     boundedGet ((minX, minY), (maxX, maxY)) (i, j) | ||||
|       | x <= minX | ||||
|         || y <= minY | ||||
|         || x >= maxX | ||||
|         || y >= maxY | ||||
|       = pure True | ||||
|       | otherwise = | ||||
|         let nx = fromIntegral $ fromIntegral x + i | ||||
|             ny = fromIntegral $ fromIntegral y + j | ||||
|         in readArray cells (nx, ny) | ||||
| 
 | ||||
|     neighborPositions :: [(Int, Int)] | ||||
|     neighborPositions = [(i, j) | i <- [-1..1], j <- [-1..1], (i, j) /= (0, 0)] | ||||
| 
 | ||||
| cloneMArray | ||||
|   :: forall a a' i e m. | ||||
|   ( Ix i | ||||
|   , MArray a e m | ||||
|   , MArray a' e m | ||||
|   , IArray UArray e | ||||
|   ) | ||||
|   => a i e | ||||
|   -> m (a' i e) | ||||
| cloneMArray = thaw @_ @UArray <=< freeze | ||||
|  | @ -1,14 +1,46 @@ | |||
| {-# LANGUAGE BangPatterns #-} | ||||
| 
 | ||||
| module Xanthous.Util | ||||
|   ( EqEqProp(..) | ||||
|   , EqProp(..) | ||||
|   , foldlMapM | ||||
|   , foldlMapM' | ||||
|   , between | ||||
|   ) where | ||||
| 
 | ||||
| import Xanthous.Prelude | ||||
| import Xanthous.Prelude hiding (foldr) | ||||
| 
 | ||||
| import Test.QuickCheck.Checkers | ||||
| import Data.Foldable (foldr) | ||||
| 
 | ||||
| newtype EqEqProp a = EqEqProp a | ||||
|   deriving newtype Eq | ||||
| 
 | ||||
| instance Eq a => EqProp (EqEqProp a) where | ||||
|   (=-=) = eq | ||||
| 
 | ||||
| foldlMapM :: forall g b a m. (Foldable g, Monoid b, Applicative m) => (a -> m b) -> g a -> m b | ||||
| foldlMapM f = foldr f' (pure mempty) | ||||
|   where | ||||
|     f' :: a -> m b -> m b | ||||
|     f' x = liftA2 mappend (f x) | ||||
| 
 | ||||
| -- Strict in the monoidal accumulator. For monads strict | ||||
| -- in the left argument of bind, this will run in constant | ||||
| -- space. | ||||
| foldlMapM' :: forall g b a m. (Foldable g, Monoid b, Monad m) => (a -> m b) -> g a -> m b | ||||
| foldlMapM' f xs = foldr f' pure xs mempty | ||||
|   where | ||||
|   f' :: a -> (b -> m b) -> b -> m b | ||||
|   f' x k bl = do | ||||
|     br <- f x | ||||
|     let !b = mappend bl br | ||||
|     k b | ||||
| 
 | ||||
| between | ||||
|   :: Ord a | ||||
|   => a -- ^ lower bound | ||||
|   -> a -- ^ upper bound | ||||
|   -> a -- ^ scrutinee | ||||
|   -> Bool | ||||
| between lower upper x = x >= lower && x <= upper | ||||
|  |  | |||
|  | @ -1,10 +1,11 @@ | |||
| import Test.Prelude | ||||
| import qualified Xanthous.DataSpec | ||||
| import qualified Xanthous.Data.EntityMapSpec | ||||
| import qualified Xanthous.DataSpec | ||||
| import qualified Xanthous.Entities.RawsSpec | ||||
| import qualified Xanthous.GameSpec | ||||
| import qualified Xanthous.Generators.UtilSpec | ||||
| import qualified Xanthous.MessageSpec | ||||
| import qualified Xanthous.OrphansSpec | ||||
| import qualified Xanthous.Entities.RawsSpec | ||||
| 
 | ||||
| main :: IO () | ||||
| main = defaultMain test | ||||
|  | @ -14,6 +15,7 @@ test = testGroup "Xanthous" | |||
|   [ Xanthous.Data.EntityMapSpec.test | ||||
|   , Xanthous.Entities.RawsSpec.test | ||||
|   , Xanthous.GameSpec.test | ||||
|   , Xanthous.Generators.UtilSpec.test | ||||
|   , Xanthous.MessageSpec.test | ||||
|   , Xanthous.OrphansSpec.test | ||||
|   , Xanthous.DataSpec.test | ||||
|  |  | |||
							
								
								
									
										66
									
								
								test/Xanthous/Generators/UtilSpec.hs
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										66
									
								
								test/Xanthous/Generators/UtilSpec.hs
									
										
									
									
									
										Normal file
									
								
							|  | @ -0,0 +1,66 @@ | |||
| {-# LANGUAGE PackageImports #-} | ||||
| 
 | ||||
| module Xanthous.Generators.UtilSpec (main, test) where | ||||
| 
 | ||||
| import Test.Prelude | ||||
| import System.Random (mkStdGen) | ||||
| import Control.Monad.Random (runRandT) | ||||
| import Data.Array.ST (STUArray, runSTUArray, thaw) | ||||
| import Data.Array.IArray (bounds) | ||||
| import Data.Array.MArray (newArray, readArray, writeArray) | ||||
| import Data.Array (Array, range, listArray, Ix) | ||||
| import Control.Monad.ST (ST, runST) | ||||
| import "checkers" Test.QuickCheck.Instances.Array () | ||||
| 
 | ||||
| import Xanthous.Util | ||||
| import Xanthous.Data (width, height) | ||||
| import Xanthous.Generators.Util | ||||
| 
 | ||||
| main :: IO () | ||||
| main = defaultMain test | ||||
| 
 | ||||
| newtype GenArray a b = GenArray (Array a b) | ||||
|   deriving stock (Show, Eq) | ||||
| 
 | ||||
| instance (Ix a, Arbitrary a, CoArbitrary a, Arbitrary b) => Arbitrary (GenArray a b) where | ||||
|   arbitrary = GenArray <$> do | ||||
|     (mkElem :: a -> b) <- arbitrary | ||||
|     minDims <- arbitrary | ||||
|     maxDims <- arbitrary | ||||
|     let bnds = (minDims, maxDims) | ||||
|     pure $ listArray bnds $ mkElem <$> range bnds | ||||
| 
 | ||||
| test :: TestTree | ||||
| test = testGroup "Xanthous.Generators.Util" | ||||
|   [ testGroup "randInitialize" | ||||
|     [ testProperty "returns an array of the correct dimensions" $ \dims seed aliveChance -> | ||||
|         let gen = mkStdGen seed | ||||
|             res = runSTUArray | ||||
|                 $ fmap fst | ||||
|                 $ flip runRandT gen | ||||
|                 $ randInitialize dims aliveChance | ||||
|         in bounds res === ((0, 0), (dims ^. width, dims ^. height)) | ||||
|     ] | ||||
|   , testGroup "numAliveNeighbors" | ||||
|     [ testProperty "maxes out at 8" $ \(GenArray (arr :: Array (Word, Word) Bool)) loc -> | ||||
|         let | ||||
|           act :: forall s. ST s Word | ||||
|           act = do | ||||
|             mArr <- thaw @_ @_ @_ @(STUArray s) arr | ||||
|             numAliveNeighborsM mArr loc | ||||
|           res = runST act | ||||
|         in counterexample (show res) $ between 0 8 res | ||||
|     ] | ||||
|   , testGroup "cloneMArray" | ||||
|       [ testCase "clones the array" $ runST $ | ||||
|           let | ||||
|             go :: forall s. ST s Assertion | ||||
|             go = do | ||||
|               arr <- newArray @(STUArray s) (0 :: Int, 5) (1 :: Int) | ||||
|               arr' <- cloneMArray @_ @(STUArray s) arr | ||||
|               writeArray arr' 0 1234 | ||||
|               x <- readArray arr 0 | ||||
|               pure $ x @?= 1 | ||||
|           in go | ||||
|       ] | ||||
|   ] | ||||
|  | @ -4,7 +4,7 @@ cabal-version: 1.12 | |||
| -- | ||||
| -- see: https://github.com/sol/hpack | ||||
| -- | ||||
| -- hash: 1e2605418faf05255c5de59433688704543e21d7d3edf669e7e18a99977c0241 | ||||
| -- hash: e01963f3bf85136fe2b6993775d225999898d4c478efef6f917056f726d72e33 | ||||
| 
 | ||||
| name:           xanthous | ||||
| version:        0.1.0.0 | ||||
|  | @ -42,6 +42,9 @@ library | |||
|       Xanthous.Entities.SomeEntity | ||||
|       Xanthous.Game | ||||
|       Xanthous.Game.Draw | ||||
|       Xanthous.Generators | ||||
|       Xanthous.Generators.CaveAutomata | ||||
|       Xanthous.Generators.Util | ||||
|       Xanthous.Messages | ||||
|       Xanthous.Monad | ||||
|       Xanthous.Orphans | ||||
|  | @ -59,6 +62,7 @@ library | |||
|       MonadRandom | ||||
|     , QuickCheck | ||||
|     , aeson | ||||
|     , array | ||||
|     , base | ||||
|     , brick | ||||
|     , checkers | ||||
|  | @ -75,6 +79,7 @@ library | |||
|     , lens | ||||
|     , megaparsec | ||||
|     , mtl | ||||
|     , optparse-applicative | ||||
|     , quickcheck-instances | ||||
|     , quickcheck-text | ||||
|     , random | ||||
|  | @ -102,6 +107,9 @@ executable xanthous | |||
|       Xanthous.Entities.SomeEntity | ||||
|       Xanthous.Game | ||||
|       Xanthous.Game.Draw | ||||
|       Xanthous.Generators | ||||
|       Xanthous.Generators.CaveAutomata | ||||
|       Xanthous.Generators.Util | ||||
|       Xanthous.Messages | ||||
|       Xanthous.Monad | ||||
|       Xanthous.Orphans | ||||
|  | @ -118,6 +126,7 @@ executable xanthous | |||
|       MonadRandom | ||||
|     , QuickCheck | ||||
|     , aeson | ||||
|     , array | ||||
|     , base | ||||
|     , brick | ||||
|     , checkers | ||||
|  | @ -134,6 +143,7 @@ executable xanthous | |||
|     , lens | ||||
|     , megaparsec | ||||
|     , mtl | ||||
|     , optparse-applicative | ||||
|     , quickcheck-instances | ||||
|     , quickcheck-text | ||||
|     , random | ||||
|  | @ -155,6 +165,7 @@ test-suite test | |||
|       Xanthous.DataSpec | ||||
|       Xanthous.Entities.RawsSpec | ||||
|       Xanthous.GameSpec | ||||
|       Xanthous.Generators.UtilSpec | ||||
|       Xanthous.MessageSpec | ||||
|       Xanthous.OrphansSpec | ||||
|       Paths_xanthous | ||||
|  | @ -166,6 +177,7 @@ test-suite test | |||
|       MonadRandom | ||||
|     , QuickCheck | ||||
|     , aeson | ||||
|     , array | ||||
|     , base | ||||
|     , brick | ||||
|     , checkers | ||||
|  | @ -183,6 +195,7 @@ test-suite test | |||
|     , lens-properties | ||||
|     , megaparsec | ||||
|     , mtl | ||||
|     , optparse-applicative | ||||
|     , quickcheck-instances | ||||
|     , quickcheck-text | ||||
|     , random | ||||
|  |  | |||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue