about summary refs log tree commit diff
diff options
context:
space:
mode:
-rw-r--r--users/glittershark/xanthous/package.yaml2
-rw-r--r--users/glittershark/xanthous/src/Xanthous/App.hs1
-rw-r--r--users/glittershark/xanthous/src/Xanthous/Data.hs12
-rw-r--r--users/glittershark/xanthous/src/Xanthous/Generators.hs16
-rw-r--r--users/glittershark/xanthous/src/Xanthous/Generators/CaveAutomata.hs1
-rw-r--r--users/glittershark/xanthous/src/Xanthous/Generators/Util.hs10
-rw-r--r--users/glittershark/xanthous/src/Xanthous/Generators/Village.hs127
-rw-r--r--users/glittershark/xanthous/src/Xanthous/Random.hs16
-rw-r--r--users/glittershark/xanthous/src/Xanthous/Util/Graphics.hs2
-rw-r--r--users/glittershark/xanthous/test/Spec.hs20
-rw-r--r--users/glittershark/xanthous/test/Xanthous/RandomSpec.hs25
-rw-r--r--users/glittershark/xanthous/xanthous.cabal88
12 files changed, 300 insertions, 20 deletions
diff --git a/users/glittershark/xanthous/package.yaml b/users/glittershark/xanthous/package.yaml
index 5321b1fd3ce5..013c483db55a 100644
--- a/users/glittershark/xanthous/package.yaml
+++ b/users/glittershark/xanthous/package.yaml
@@ -54,6 +54,7 @@ dependencies:
 - MonadRandom
 - mtl
 - optparse-applicative
+- parallel
 - parser-combinators
 - pointed
 - random
@@ -67,6 +68,7 @@ dependencies:
 - stache
 - semigroupoids
 - tomland
+- transformers
 - text
 - text-zipper
 - vector
diff --git a/users/glittershark/xanthous/src/Xanthous/App.hs b/users/glittershark/xanthous/src/Xanthous/App.hs
index 672aa93f6b32..e20c5d97b854 100644
--- a/users/glittershark/xanthous/src/Xanthous/App.hs
+++ b/users/glittershark/xanthous/src/Xanthous/App.hs
@@ -15,7 +15,6 @@ import           Control.Monad.State (get, gets)
 import           Control.Monad.State.Class (modify)
 import           Data.Aeson (object, ToJSON)
 import qualified Data.Aeson as A
-import           Data.List.NonEmpty (NonEmpty(..))
 import qualified Data.Vector as V
 import           System.Exit
 import           System.Directory (doesFileExist)
diff --git a/users/glittershark/xanthous/src/Xanthous/Data.hs b/users/glittershark/xanthous/src/Xanthous/Data.hs
index 67173cc89646..031815b8fba4 100644
--- a/users/glittershark/xanthous/src/Xanthous/Data.hs
+++ b/users/glittershark/xanthous/src/Xanthous/Data.hs
@@ -79,8 +79,17 @@ module Xanthous.Data
   , edges
   , neighborDirections
   , neighborPositions
+  , neighborCells
   , arrayNeighbors
   , rotations
+  , HasTopLeft(..)
+  , HasTop(..)
+  , HasTopRight(..)
+  , HasLeft(..)
+  , HasRight(..)
+  , HasBottomLeft(..)
+  , HasBottom(..)
+  , HasBottomRight(..)
 
     -- *
   , Hitpoints(..)
@@ -439,6 +448,9 @@ neighborDirections = Neighbors
 neighborPositions :: Num a => Position' a -> Neighbors (Position' a)
 neighborPositions pos = (`move` pos) <$> neighborDirections
 
+neighborCells :: Num a => (a, a) -> Neighbors (a, a)
+neighborCells = map (view _Position) . neighborPositions . review _Position
+
 arrayNeighbors
   :: (IArray a e, Ix i, Num i)
   => a (i, i) e
diff --git a/users/glittershark/xanthous/src/Xanthous/Generators.hs b/users/glittershark/xanthous/src/Xanthous/Generators.hs
index 9b2b90e300c7..5bc8bcf03582 100644
--- a/users/glittershark/xanthous/src/Xanthous/Generators.hs
+++ b/users/glittershark/xanthous/src/Xanthous/Generators.hs
@@ -6,7 +6,7 @@ module Xanthous.Generators
   ( generate
   , Generator(..)
   , SGenerator(..)
-  , GeneratorInput
+  , GeneratorInput(..)
   , generateFromInput
   , parseGeneratorInput
   , showCells
@@ -17,6 +17,7 @@ module Xanthous.Generators
   , levelDoors
   , levelCharacterPosition
   , levelTutorialMessage
+  , levelExtra
   , generateLevel
   , levelToEntityMap
   ) where
@@ -31,6 +32,7 @@ import qualified Xanthous.Generators.CaveAutomata as CaveAutomata
 import qualified Xanthous.Generators.Dungeon as Dungeon
 import           Xanthous.Generators.Util
 import           Xanthous.Generators.LevelContents
+import           Xanthous.Generators.Village as Village
 import           Xanthous.Data (Dimensions, Position'(Position), Position)
 import           Xanthous.Data.EntityMap (EntityMap, _EntityMap)
 import qualified Xanthous.Data.EntityMap as EntityMap
@@ -118,6 +120,7 @@ data Level = Level
   , _levelCreatures         :: !(EntityMap Creature)
   , _levelTutorialMessage   :: !(EntityMap GroundMessage)
   , _levelStaircases        :: !(EntityMap Staircase)
+  , _levelExtra             :: !(EntityMap SomeEntity) -- ^ TODO this is a bit of a hack...
   , _levelCharacterPosition :: !Position
   }
   deriving stock (Generic)
@@ -134,6 +137,8 @@ generateLevel gen ps dims = do
   rand <- mkStdGen <$> getRandom
   let cells = generate gen ps dims rand
       _levelWalls = cellsToWalls cells
+  village <- generateVillage cells gen
+  let _levelExtra = village
   _levelItems <- randomItems cells
   _levelCreatures <- randomCreatures cells
   _levelDoors <- randomDoors cells
@@ -152,3 +157,12 @@ levelToEntityMap level
   <> (SomeEntity <$> level ^. levelCreatures)
   <> (SomeEntity <$> level ^. levelTutorialMessage)
   <> (SomeEntity <$> level ^. levelStaircases)
+  <> (level ^. levelExtra)
+
+generateVillage
+  :: MonadRandom m
+  => Cells -- ^ Wall positions
+  -> SGenerator gen
+  -> m (EntityMap SomeEntity)
+generateVillage wallPositions SCaveAutomata = Village.fromCave wallPositions
+generateVillage _ _ = pure mempty
diff --git a/users/glittershark/xanthous/src/Xanthous/Generators/CaveAutomata.hs b/users/glittershark/xanthous/src/Xanthous/Generators/CaveAutomata.hs
index 83740fe4b73d..ada201ef3d6c 100644
--- a/users/glittershark/xanthous/src/Xanthous/Generators/CaveAutomata.hs
+++ b/users/glittershark/xanthous/src/Xanthous/Generators/CaveAutomata.hs
@@ -70,6 +70,7 @@ parseParams = Params
       <> Opt.help "Number of generations to run the automata for"
       <> Opt.metavar "STEPS"
       )
+  <**> Opt.helper
   where
     parseChance = readWithGuard
       (between 0 1)
diff --git a/users/glittershark/xanthous/src/Xanthous/Generators/Util.hs b/users/glittershark/xanthous/src/Xanthous/Generators/Util.hs
index 70d94860dc68..e1e367007e65 100644
--- a/users/glittershark/xanthous/src/Xanthous/Generators/Util.hs
+++ b/users/glittershark/xanthous/src/Xanthous/Generators/Util.hs
@@ -75,9 +75,6 @@ numAliveNeighborsM cells (x, y) = do
             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)]
-
 numAliveNeighbors
   :: forall a i j
   . (IArray a Bool, Ix (i, j), Integral i, Integral j)
@@ -103,8 +100,8 @@ numAliveNeighbors cells (x, y) =
             ny = fromIntegral $ fromIntegral y + j
         in cells ! (nx, ny)
 
-    neighborPositions :: [(Int, Int)]
-    neighborPositions = [(i, j) | i <- [-1..1], j <- [-1..1], (i, j) /= (0, 0)]
+neighborPositions :: [(Int, Int)]
+neighborPositions = [(i, j) | i <- [-1..1], j <- [-1..1], (i, j) /= (0, 0)]
 
 fillOuterEdgesM :: (MArray a Bool m, Ix i, Ix j) => a (i, j) Bool -> m ()
 fillOuterEdgesM arr = do
@@ -137,7 +134,6 @@ floodFill :: forall a i j.
             , Enum i , Enum j
             , Bounded i , Bounded j
             , Eq i , Eq j
-            , Show i, Show j
             )
           => a (i, j) Bool -- ^ array
           -> (i, j)        -- ^ position
@@ -145,7 +141,6 @@ floodFill :: forall a i j.
 floodFill = go mempty
   where
     go :: Set (i, j) -> a (i, j) Bool -> (i, j) -> Set (i, j)
-    -- TODO pass result in rather than passing seen in, return result
     go res arr@(bounds -> arrBounds) idx@(x, y)
       | not (inRange arrBounds idx) =  res
       | not (arr ! idx) =  res
@@ -177,7 +172,6 @@ regions :: forall a i j.
           , Enum i , Enum j
           , Bounded i , Bounded j
           , Eq i , Eq j
-          , Show i, Show j
           )
         => a (i, j) Bool
         -> [Set (i, j)]
diff --git a/users/glittershark/xanthous/src/Xanthous/Generators/Village.hs b/users/glittershark/xanthous/src/Xanthous/Generators/Village.hs
new file mode 100644
index 000000000000..52f26dcde018
--- /dev/null
+++ b/users/glittershark/xanthous/src/Xanthous/Generators/Village.hs
@@ -0,0 +1,127 @@
+{-# LANGUAGE PartialTypeSignatures #-}
+module Xanthous.Generators.Village
+  -- ( fromCave
+  -- )
+  where
+--------------------------------------------------------------------------------
+import           Xanthous.Prelude hiding (any, failing, toList)
+--------------------------------------------------------------------------------
+import           Control.Monad.Random (MonadRandom)
+import           Control.Monad.State (execStateT, MonadState, modify)
+import           Control.Monad.Trans.Maybe
+import           Control.Parallel.Strategies
+import           Data.Array.IArray
+import           Data.Foldable (any, toList)
+--------------------------------------------------------------------------------
+import           Xanthous.Data
+import           Xanthous.Data.EntityMap (EntityMap)
+import qualified Xanthous.Data.EntityMap as EntityMap
+import           Xanthous.Entities.Environment
+import           Xanthous.Generators.Util
+import           Xanthous.Game.State (SomeEntity(..))
+import           Xanthous.Random
+--------------------------------------------------------------------------------
+
+fromCave :: MonadRandom m
+         => Cells -- ^ The positions of all the walls
+         -> m (EntityMap SomeEntity)
+fromCave wallPositions = execStateT (fromCave' wallPositions) mempty
+
+fromCave' :: forall m. (MonadRandom m, MonadState (EntityMap SomeEntity) m)
+          => Cells
+          -> m ()
+fromCave' wallPositions = failing (pure ()) $ do
+  Just villageRegion <-
+    choose
+    . (`using` parTraversable rdeepseq)
+    . weightedBy (\reg -> let circSize = length $ circumference reg
+                         in if circSize == 50
+                            then (1.0 :: Double)
+                            else 1.0 / (fromIntegral . abs $ circSize - 50))
+    $ regions closedHallways
+
+  let circ = setFromList . circumference $ villageRegion
+
+  centerPoints <- chooseSubset (0.1 :: Double) $ toList circ
+
+  roomTiles <- foldM
+              (flip $ const $ stepOut circ)
+              (map pure centerPoints)
+              [0 :: Int ..2]
+
+  let roomWalls = circumference . setFromList @(Set _) <$> roomTiles
+      allWalls = join roomWalls
+
+  doorPositions <- fmap join . for roomWalls $ \room ->
+    let candidates = filter (`notMember` circ) room
+    in fmap toList . choose $ ChooseElement candidates
+
+  let entryways =
+        filter (\pt ->
+                  let ncs = neighborCells pt
+                  in any ((&&) <$> (not . (wallPositions !))
+                              <*> (`notMember` villageRegion)) ncs
+                   && any ((&&) <$> (`member` villageRegion)
+                              <*> (`notElem` allWalls)) ncs)
+                  $ toList villageRegion
+
+  Just entryway <- choose $ ChooseElement entryways
+
+  for_ (filter ((&&) <$> (`notElem` doorPositions) <*> (/= entryway)) allWalls)
+    $ insertEntity Wall
+  for_ (filter (/= entryway) doorPositions) $ insertEntity unlockedDoor
+  insertEntity unlockedDoor entryway
+
+
+  where
+    insertEntity e pt = modify $ EntityMap.insertAt (ptToPos pt) $ SomeEntity e
+    ptToPos pt = _Position # (pt & both %~ fromIntegral)
+
+    stepOut :: Set (Word, Word) -> [[(Word, Word)]] -> MaybeT m [[(Word, Word)]]
+    stepOut circ rooms = for rooms $ \room ->
+      let nextLevels = hashNub $ toList . neighborCells =<< room
+      in pure
+         . (<> room)
+         $ filter ((&&) <$> (`notMember` circ) <*> (`notElem` join rooms))
+         nextLevels
+
+    circumference pts =
+      filter (any (`notMember` pts) . neighborCells) $ toList pts
+    closedHallways = closeHallways livePositions
+    livePositions = amap not wallPositions
+
+--------------------------------------------------------------------------------
+
+closeHallways :: Cells -> Cells
+closeHallways livePositions =
+  livePositions // mapMaybe closeHallway (assocs livePositions)
+  where
+    closeHallway (_, False) = Nothing
+    closeHallway (pos, _)
+      | isHallway pos = Just (pos, False)
+      | otherwise     = Nothing
+    isHallway pos = any ((&&) <$> not . view left <*> not . view right)
+      . rotations
+      . fmap (fromMaybe False)
+      $ arrayNeighbors livePositions pos
+
+failing :: Monad m => m a -> MaybeT m a -> m a
+failing result = (maybe result pure =<<) . runMaybeT
+
+{-
+
+import Xanthous.Generators.Village
+import Xanthous.Generators
+import Xanthous.Data
+import System.Random
+import qualified Data.Text
+import qualified Xanthous.Generators.CaveAutomata as CA
+let gi = GeneratorInput SCaveAutomata CA.defaultParams
+wallPositions <- generateFromInput gi (Dimensions 80 50) <$> getStdGen
+putStrLn . Data.Text.unpack $ showCells wallPositions
+
+import Data.Array.IArray
+let closedHallways = closeHallways . amap not $ wallPositions
+putStrLn . Data.Text.unpack . showCells $ amap not closedHallways
+
+-}
diff --git a/users/glittershark/xanthous/src/Xanthous/Random.hs b/users/glittershark/xanthous/src/Xanthous/Random.hs
index 41c80ab73c4c..6d34109df7f8 100644
--- a/users/glittershark/xanthous/src/Xanthous/Random.hs
+++ b/users/glittershark/xanthous/src/Xanthous/Random.hs
@@ -10,6 +10,7 @@ module Xanthous.Random
   , weightedBy
   , subRand
   , chance
+  , chooseSubset
   ) where
 --------------------------------------------------------------------------------
 import Xanthous.Prelude
@@ -17,6 +18,7 @@ import Xanthous.Prelude
 import           Data.List.NonEmpty (NonEmpty(..))
 import           Control.Monad.Random.Class (MonadRandom(getRandomR, getRandom))
 import           Control.Monad.Random (Rand, evalRand, mkStdGen, StdGen)
+import           Data.Functor.Compose
 import           Data.Random.Shuffle.Weighted
 import           Data.Random.Distribution
 import           Data.Random.Distribution.Uniform
@@ -66,10 +68,16 @@ instance Choose (a, a) where
   choose (x, y) = choose (x :| [y])
 
 newtype Weighted w t a = Weighted (t (w, a))
+  deriving (Functor, Foldable) via (t `Compose` (,) w)
+
+instance Traversable t => Traversable (Weighted w t) where
+  traverse f (Weighted twa) = Weighted <$> (traverse . traverse) f twa
 
 evenlyWeighted :: [a] -> Weighted Int [] a
 evenlyWeighted = Weighted . itoList
 
+-- | Weight the elements of some functor by a function. Larger values of 'w' per
+-- its 'Ord' instance will be more likely to be generated
 weightedBy :: Functor t => (a -> w) -> t a -> Weighted w t a
 weightedBy weighting xs = Weighted $ (weighting &&& id) <$> xs
 
@@ -96,6 +104,14 @@ chance
   -> m Bool
 chance n = choose $ weightedBy (bool 1 (n * 2)) bools
 
+-- | Choose a random subset of *about* @w@ of the elements of the given
+-- 'Witherable' structure
+chooseSubset :: ( Num w, Ord w, Distribution Uniform w, Excludable w
+               , Witherable t
+               , MonadRandom m
+               ) => w -> t a -> m (t a)
+chooseSubset = filterA . const . chance
+
 --------------------------------------------------------------------------------
 
 bools :: NonEmpty Bool
diff --git a/users/glittershark/xanthous/src/Xanthous/Util/Graphics.hs b/users/glittershark/xanthous/src/Xanthous/Util/Graphics.hs
index 5f7432f4c7e2..1b8b79164397 100644
--- a/users/glittershark/xanthous/src/Xanthous/Util/Graphics.hs
+++ b/users/glittershark/xanthous/src/Xanthous/Util/Graphics.hs
@@ -128,6 +128,8 @@ line pa@(xa, ya) pb@(xb, yb)
         (newY, newError) = if (2 * tempError) >= δx
                            then (yTemp + ystep, tempError - δx)
                            else (yTemp, tempError)
+{-# SPECIALIZE line :: (Int, Int) -> (Int, Int) -> [(Int, Int)] #-}
+{-# SPECIALIZE line :: (Word, Word) -> (Word, Word) -> [(Word, Word)] #-}
 
 straightLine :: (Num i, Ord i) => (i, i) -> (i, i) -> [(i, i)]
 straightLine pa@(xa, _) pb@(_, yb) = line pa midpoint ++ line midpoint pb
diff --git a/users/glittershark/xanthous/test/Spec.hs b/users/glittershark/xanthous/test/Spec.hs
index b7004b4f8948..f15c393ac917 100644
--- a/users/glittershark/xanthous/test/Spec.hs
+++ b/users/glittershark/xanthous/test/Spec.hs
@@ -1,11 +1,11 @@
 --------------------------------------------------------------------------------
 import           Test.Prelude
 --------------------------------------------------------------------------------
+import qualified Xanthous.Data.EntitiesSpec
 import qualified Xanthous.Data.EntityCharSpec
-import qualified Xanthous.Data.EntityMapSpec
 import qualified Xanthous.Data.EntityMap.GraphicsSpec
+import qualified Xanthous.Data.EntityMapSpec
 import qualified Xanthous.Data.LevelsSpec
-import qualified Xanthous.Data.EntitiesSpec
 import qualified Xanthous.Data.NestedMapSpec
 import qualified Xanthous.DataSpec
 import qualified Xanthous.Entities.RawsSpec
@@ -14,8 +14,9 @@ import qualified Xanthous.Generators.UtilSpec
 import qualified Xanthous.MessageSpec
 import qualified Xanthous.Messages.TemplateSpec
 import qualified Xanthous.OrphansSpec
-import qualified Xanthous.Util.GraphicsSpec
+import qualified Xanthous.RandomSpec
 import qualified Xanthous.Util.GraphSpec
+import qualified Xanthous.Util.GraphicsSpec
 import qualified Xanthous.Util.InflectionSpec
 import qualified Xanthous.UtilSpec
 --------------------------------------------------------------------------------
@@ -25,21 +26,22 @@ main = defaultMain test
 
 test :: TestTree
 test = testGroup "Xanthous"
-  [ Xanthous.Data.EntityCharSpec.test
-  , Xanthous.Data.EntityMapSpec.test
+  [ Xanthous.Data.EntitiesSpec.test
   , Xanthous.Data.EntityMap.GraphicsSpec.test
-  , Xanthous.Data.EntitiesSpec.test
+  , Xanthous.Data.EntityMapSpec.test
   , Xanthous.Data.LevelsSpec.test
   , Xanthous.Data.NestedMapSpec.test
+  , Xanthous.DataSpec.test
   , Xanthous.Entities.RawsSpec.test
   , Xanthous.GameSpec.test
   , Xanthous.Generators.UtilSpec.test
   , Xanthous.MessageSpec.test
   , Xanthous.Messages.TemplateSpec.test
   , Xanthous.OrphansSpec.test
-  , Xanthous.DataSpec.test
-  , Xanthous.UtilSpec.test
-  , Xanthous.Util.GraphicsSpec.test
+  , Xanthous.RandomSpec.test
   , Xanthous.Util.GraphSpec.test
+  , Xanthous.Util.GraphicsSpec.test
   , Xanthous.Util.InflectionSpec.test
+  , Xanthous.UtilSpec.test
+  , Xanthous.Data.EntityCharSpec.test
   ]
diff --git a/users/glittershark/xanthous/test/Xanthous/RandomSpec.hs b/users/glittershark/xanthous/test/Xanthous/RandomSpec.hs
new file mode 100644
index 000000000000..187336f08650
--- /dev/null
+++ b/users/glittershark/xanthous/test/Xanthous/RandomSpec.hs
@@ -0,0 +1,25 @@
+--------------------------------------------------------------------------------
+module Xanthous.RandomSpec (main, test) where
+--------------------------------------------------------------------------------
+import Test.Prelude
+--------------------------------------------------------------------------------
+import Control.Monad.Random
+--------------------------------------------------------------------------------
+import Xanthous.Random
+--------------------------------------------------------------------------------
+
+main :: IO ()
+main = defaultMain test
+
+test :: TestTree
+test = testGroup "Xanthous.Random"
+  [ testGroup "chooseSubset"
+    [ testProperty "chooses a subset"
+      $ \(l :: [Int]) (Positive (r :: Double)) -> randomTest $ do
+        ss <- chooseSubset r l
+        pure $ all (`elem` l) ss
+
+    ]
+  ]
+  where
+    randomTest prop = evalRandT prop . mkStdGen =<< arbitrary
diff --git a/users/glittershark/xanthous/xanthous.cabal b/users/glittershark/xanthous/xanthous.cabal
index 63649a89a897..653389a4c5cb 100644
--- a/users/glittershark/xanthous/xanthous.cabal
+++ b/users/glittershark/xanthous/xanthous.cabal
@@ -4,7 +4,7 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 88019942f93977e08b513ce6991401694c431b7b2b7b1b5d2afccb3f0afb26ed
+-- hash: 5f419c8c149f045c818a2fb392b1233a0958e71e92d7a837deabc412e2b5adda
 
 name:           xanthous
 version:        0.1.0.0
@@ -68,6 +68,7 @@ library
       Xanthous.Generators.Dungeon
       Xanthous.Generators.LevelContents
       Xanthous.Generators.Util
+      Xanthous.Generators.Village
       Xanthous.Messages
       Xanthous.Messages.Template
       Xanthous.Monad
@@ -126,6 +127,7 @@ library
     , monad-control
     , mtl
     , optparse-applicative
+    , parallel
     , parser-combinators
     , pointed
     , quickcheck-instances
@@ -142,6 +144,7 @@ library
     , text
     , text-zipper
     , tomland
+    , transformers
     , vector
     , vty
     , witherable
@@ -191,6 +194,7 @@ executable xanthous
       Xanthous.Generators.Dungeon
       Xanthous.Generators.LevelContents
       Xanthous.Generators.Util
+      Xanthous.Generators.Village
       Xanthous.Messages
       Xanthous.Messages.Template
       Xanthous.Monad
@@ -248,6 +252,7 @@ executable xanthous
     , monad-control
     , mtl
     , optparse-applicative
+    , parallel
     , parser-combinators
     , pointed
     , quickcheck-instances
@@ -264,6 +269,7 @@ executable xanthous
     , text
     , text-zipper
     , tomland
+    , transformers
     , vector
     , vty
     , witherable
@@ -290,6 +296,7 @@ test-suite test
       Xanthous.Messages.TemplateSpec
       Xanthous.MessageSpec
       Xanthous.OrphansSpec
+      Xanthous.RandomSpec
       Xanthous.Util.GraphicsSpec
       Xanthous.Util.GraphSpec
       Xanthous.Util.InflectionSpec
@@ -338,6 +345,7 @@ test-suite test
     , monad-control
     , mtl
     , optparse-applicative
+    , parallel
     , parser-combinators
     , pointed
     , quickcheck-instances
@@ -357,6 +365,84 @@ test-suite test
     , text
     , text-zipper
     , tomland
+    , transformers
+    , vector
+    , vty
+    , witherable
+    , xanthous
+    , yaml
+    , zlib
+  default-language: Haskell2010
+
+benchmark benchmark
+  type: exitcode-stdio-1.0
+  main-is: Bench.hs
+  other-modules:
+      Bench.Prelude
+      Xanthous.Generators.UtilBench
+      Xanthous.RandomBench
+      Paths_xanthous
+  hs-source-dirs:
+      bench
+  default-extensions: BlockArguments ConstraintKinds DataKinds DeriveAnyClass DeriveGeneric DerivingStrategies DerivingVia FlexibleContexts FlexibleInstances FunctionalDependencies GADTSyntax GeneralizedNewtypeDeriving KindSignatures LambdaCase MultiWayIf NoImplicitPrelude NoStarIsType OverloadedStrings PolyKinds RankNTypes ScopedTypeVariables TupleSections TypeApplications TypeFamilies TypeOperators ViewPatterns
+  ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N
+  build-depends:
+      JuicyPixels
+    , MonadRandom
+    , QuickCheck
+    , Rasterific
+    , aeson
+    , array
+    , async
+    , base
+    , bifunctors
+    , brick
+    , checkers
+    , classy-prelude
+    , comonad
+    , comonad-extras
+    , constraints
+    , containers
+    , criterion
+    , data-default
+    , deepseq
+    , directory
+    , fgl
+    , fgl-arbitrary
+    , file-embed
+    , filepath
+    , generic-arbitrary
+    , generic-lens
+    , generic-monoid
+    , groups
+    , hgeometry
+    , hgeometry-combinatorial
+    , lens
+    , lifted-async
+    , linear
+    , megaparsec
+    , mmorph
+    , monad-control
+    , mtl
+    , optparse-applicative
+    , parallel
+    , parser-combinators
+    , pointed
+    , quickcheck-instances
+    , quickcheck-text
+    , random
+    , random-extras
+    , random-fu
+    , random-source
+    , raw-strings-qq
+    , reflection
+    , semigroupoids
+    , stache
+    , streams
+    , text
+    , text-zipper
+    , tomland
+    , transformers
     , vector
     , vty
     , witherable