module Swarm.Game.Terrain (
TerrainType (..),
terrainMap,
) where
import Data.Aeson (FromJSON (..), withText)
import Data.Map (Map)
import Data.Map qualified as M
import Data.Text qualified as T
import Swarm.Game.Display
import Swarm.TUI.Attr
import Text.Read (readMaybe)
import Witch (into)
data TerrainType
= StoneT
| DirtT
| GrassT
| IceT
| BlankT
deriving (TerrainType -> TerrainType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TerrainType -> TerrainType -> Bool
$c/= :: TerrainType -> TerrainType -> Bool
== :: TerrainType -> TerrainType -> Bool
$c== :: TerrainType -> TerrainType -> Bool
Eq, Eq TerrainType
TerrainType -> TerrainType -> Bool
TerrainType -> TerrainType -> Ordering
TerrainType -> TerrainType -> TerrainType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TerrainType -> TerrainType -> TerrainType
$cmin :: TerrainType -> TerrainType -> TerrainType
max :: TerrainType -> TerrainType -> TerrainType
$cmax :: TerrainType -> TerrainType -> TerrainType
>= :: TerrainType -> TerrainType -> Bool
$c>= :: TerrainType -> TerrainType -> Bool
> :: TerrainType -> TerrainType -> Bool
$c> :: TerrainType -> TerrainType -> Bool
<= :: TerrainType -> TerrainType -> Bool
$c<= :: TerrainType -> TerrainType -> Bool
< :: TerrainType -> TerrainType -> Bool
$c< :: TerrainType -> TerrainType -> Bool
compare :: TerrainType -> TerrainType -> Ordering
$ccompare :: TerrainType -> TerrainType -> Ordering
Ord, Int -> TerrainType -> ShowS
[TerrainType] -> ShowS
TerrainType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TerrainType] -> ShowS
$cshowList :: [TerrainType] -> ShowS
show :: TerrainType -> String
$cshow :: TerrainType -> String
showsPrec :: Int -> TerrainType -> ShowS
$cshowsPrec :: Int -> TerrainType -> ShowS
Show, ReadPrec [TerrainType]
ReadPrec TerrainType
Int -> ReadS TerrainType
ReadS [TerrainType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TerrainType]
$creadListPrec :: ReadPrec [TerrainType]
readPrec :: ReadPrec TerrainType
$creadPrec :: ReadPrec TerrainType
readList :: ReadS [TerrainType]
$creadList :: ReadS [TerrainType]
readsPrec :: Int -> ReadS TerrainType
$creadsPrec :: Int -> ReadS TerrainType
Read, TerrainType
forall a. a -> a -> Bounded a
maxBound :: TerrainType
$cmaxBound :: TerrainType
minBound :: TerrainType
$cminBound :: TerrainType
Bounded, Int -> TerrainType
TerrainType -> Int
TerrainType -> [TerrainType]
TerrainType -> TerrainType
TerrainType -> TerrainType -> [TerrainType]
TerrainType -> TerrainType -> TerrainType -> [TerrainType]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: TerrainType -> TerrainType -> TerrainType -> [TerrainType]
$cenumFromThenTo :: TerrainType -> TerrainType -> TerrainType -> [TerrainType]
enumFromTo :: TerrainType -> TerrainType -> [TerrainType]
$cenumFromTo :: TerrainType -> TerrainType -> [TerrainType]
enumFromThen :: TerrainType -> TerrainType -> [TerrainType]
$cenumFromThen :: TerrainType -> TerrainType -> [TerrainType]
enumFrom :: TerrainType -> [TerrainType]
$cenumFrom :: TerrainType -> [TerrainType]
fromEnum :: TerrainType -> Int
$cfromEnum :: TerrainType -> Int
toEnum :: Int -> TerrainType
$ctoEnum :: Int -> TerrainType
pred :: TerrainType -> TerrainType
$cpred :: TerrainType -> TerrainType
succ :: TerrainType -> TerrainType
$csucc :: TerrainType -> TerrainType
Enum)
instance FromJSON TerrainType where
parseJSON :: Value -> Parser TerrainType
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"text" forall a b. (a -> b) -> a -> b
$ \Text
t ->
case forall a. Read a => String -> Maybe a
readMaybe (forall target source. From source target => source -> target
into @String (Text -> Text
T.toTitle Text
t) forall a. [a] -> [a] -> [a]
++ String
"T") of
Just TerrainType
ter -> forall (m :: * -> *) a. Monad m => a -> m a
return TerrainType
ter
Maybe TerrainType
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unknown terrain type: " forall a. [a] -> [a] -> [a]
++ forall target source. From source target => source -> target
into @String Text
t
terrainMap :: Map TerrainType Display
terrainMap :: Map TerrainType Display
terrainMap =
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
[ (TerrainType
StoneT, Char -> AttrName -> Display
defaultTerrainDisplay Char
'▒' AttrName
rockAttr)
, (TerrainType
DirtT, Char -> AttrName -> Display
defaultTerrainDisplay Char
'▒' AttrName
dirtAttr)
, (TerrainType
GrassT, Char -> AttrName -> Display
defaultTerrainDisplay Char
'▒' AttrName
grassAttr)
, (TerrainType
IceT, Char -> AttrName -> Display
defaultTerrainDisplay Char
' ' AttrName
iceAttr)
, (TerrainType
BlankT, Char -> AttrName -> Display
defaultTerrainDisplay Char
' ' AttrName
defAttr)
]