refactor(users/glittershark): Rename to grfn r/2485

Rename my //users directory and all places that refer to glittershark to
grfn, including nix references and documentation.

This may require some extra attention inside of gerrit's database after
it lands to allow me to actually push things.

Change-Id: I4728b7ec2c60024392c1c1fa6e0d4a59b3e266fa
Reviewed-on: https://cl.tvl.fyi/c/depot/+/2933
Tested-by: BuildkiteCI
Reviewed-by: tazjin <mail@tazj.in>
Reviewed-by: lukegb <lukegb@tvl.fyi>
Reviewed-by: glittershark <grfn@gws.fyi>

1 files changed, 160 insertions, 0 deletions

diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Environment.hs b/users/grfn/xanthous/src/Xanthous/Entities/Environment.hs
new file mode 100644
index 0000000000..b45a91eabe
--- /dev/null
+++ b/users/grfn/xanthous/src/Xanthous/Entities/Environment.hs
@@ -0,0 +1,160 @@
+{-# LANGUAGE TemplateHaskell #-}
+module Xanthous.Entities.Environment
+  (
+    -- * Walls
+    Wall(..)
+
+    -- * Doors
+  , Door(..)
+  , open
+  , closed
+  , locked
+  , unlockedDoor
+
+    -- * Messages
+  , GroundMessage(..)
+
+    -- * Stairs
+  , Staircase(..)
+  ) where
+--------------------------------------------------------------------------------
+import Xanthous.Prelude
+--------------------------------------------------------------------------------
+import Test.QuickCheck
+import Brick (str)
+import Brick.Widgets.Border.Style (unicode)
+import Brick.Types (Edges(..))
+import Data.Aeson
+import Data.Aeson.Generic.DerivingVia
+--------------------------------------------------------------------------------
+import Xanthous.Entities.Draw.Util
+import Xanthous.Data
+import Xanthous.Data.Entities
+import Xanthous.Game.State
+import Xanthous.Util.QuickCheck
+--------------------------------------------------------------------------------
+
+data Wall = Wall
+  deriving stock (Show, Eq, Ord, Generic, Enum)
+  deriving anyclass (NFData, CoArbitrary, Function)
+
+instance ToJSON Wall where
+  toJSON = const $ String "Wall"
+
+instance FromJSON Wall where
+  parseJSON = withText "Wall" $ \case
+    "Wall" -> pure Wall
+    _      -> fail "Invalid Wall: expected Wall"
+
+instance Brain Wall where step = brainVia Brainless
+
+instance Entity Wall where
+  entityAttributes _ = defaultEntityAttributes
+    & blocksVision .~ True
+    & blocksObject .~ True
+  description _ = "a wall"
+  entityChar _ = "┼"
+
+instance Arbitrary Wall where
+  arbitrary = pure Wall
+
+wallEdges :: (MonoFoldable mono, Element mono ~ SomeEntity)
+          => Neighbors mono -> Edges Bool
+wallEdges neighs = any (entityIs @Wall) <$> edges neighs
+
+instance Draw Wall where
+  drawWithNeighbors neighs _wall =
+    str . pure . borderFromEdges unicode $ wallEdges neighs
+
+data Door = Door
+  { _open   :: Bool
+  , _locked :: Bool
+  }
+  deriving stock (Show, Eq, Ord, Generic)
+  deriving anyclass (NFData, CoArbitrary, Function, ToJSON, FromJSON)
+  deriving Arbitrary via GenericArbitrary Door
+makeLenses ''Door
+
+instance Draw Door where
+  drawWithNeighbors neighs door
+    = str . pure . ($ door ^. open) $ case wallEdges neighs of
+        Edges True  False  False False -> vertDoor
+        Edges False True   False False -> vertDoor
+        Edges True  True   False False -> vertDoor
+        Edges False False  True  False -> horizDoor
+        Edges False False  False True  -> horizDoor
+        Edges False False  True  True  -> horizDoor
+        _                              -> allsidesDoor
+    where
+      horizDoor True = '␣'
+      horizDoor False = 'ᚔ'
+      vertDoor True = '['
+      vertDoor False = 'ǂ'
+      allsidesDoor True = '+'
+      allsidesDoor False = '▥'
+
+instance Brain Door where step = brainVia Brainless
+
+instance Entity Door where
+  entityAttributes door = defaultEntityAttributes
+    & blocksVision .~ not (door ^. open)
+  description door | door ^. open = "an open door"
+                   | otherwise    = "a closed door"
+  entityChar _ = "d"
+  entityCollision door | door ^. open = Nothing
+                       | otherwise = Just Stop
+
+closed :: Lens' Door Bool
+closed = open . involuted not
+
+-- | A closed, unlocked door
+unlockedDoor :: Door
+unlockedDoor = Door
+  { _open = False
+  , _locked = False
+  }
+
+--------------------------------------------------------------------------------
+
+newtype GroundMessage = GroundMessage Text
+  deriving stock (Show, Eq, Ord, Generic)
+  deriving anyclass (NFData, CoArbitrary, Function)
+  deriving Arbitrary via GenericArbitrary GroundMessage
+  deriving (ToJSON, FromJSON)
+       via WithOptions '[ 'TagSingleConstructors 'True
+                        , 'SumEnc 'ObjWithSingleField
+                        ]
+           GroundMessage
+  deriving Draw
+       via DrawStyledCharacter ('Just 'Yellow) 'Nothing "≈"
+           GroundMessage
+instance Brain GroundMessage where step = brainVia Brainless
+
+instance Entity GroundMessage where
+  description = const "a message on the ground. Press r. to read it."
+  entityChar = const "≈"
+  entityCollision = const Nothing
+
+--------------------------------------------------------------------------------
+
+data Staircase = UpStaircase | DownStaircase
+  deriving stock (Show, Eq, Ord, Generic)
+  deriving anyclass (NFData, CoArbitrary, Function)
+  deriving Arbitrary via GenericArbitrary Staircase
+  deriving (ToJSON, FromJSON)
+       via WithOptions '[ 'TagSingleConstructors 'True
+                        , 'SumEnc 'ObjWithSingleField
+                        ]
+           Staircase
+instance Brain Staircase where step = brainVia Brainless
+
+instance Draw Staircase where
+  draw UpStaircase = str "<"
+  draw DownStaircase = str ">"
+
+instance Entity Staircase where
+  description UpStaircase = "a staircase leading upwards"
+  description DownStaircase = "a staircase leading downwards"
+  entityChar UpStaircase = "<"
+  entityChar DownStaircase = ">"
+  entityCollision = const Nothing