{-# LANGUAGE OverloadedStrings #-}
module Swarm.Game.World.Syntax (
World,
RawCellVal,
CellTag (..),
CellVal (..),
Rot (..),
Var,
Axis (..),
Op (..),
WExp (..),
)
where
import Control.Lens (view, (^.))
import Data.List.NonEmpty qualified as NE
import Data.Semigroup (Last (..))
import Data.Text (Text)
import Data.Text qualified as T
import Prettyprinter
import Swarm.Game.Entity (Entity, entityName)
import Swarm.Game.Robot (Robot, robotName)
import Swarm.Game.Terrain
import Swarm.Game.World.Coords
import Swarm.Language.Pretty
import Swarm.Util (showT)
import Swarm.Util.Erasable
type World b = Coords -> b
data CellTag = CellTerrain | CellEntity | CellRobot
deriving (CellTag -> CellTag -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CellTag -> CellTag -> Bool
$c/= :: CellTag -> CellTag -> Bool
== :: CellTag -> CellTag -> Bool
$c== :: CellTag -> CellTag -> Bool
Eq, Eq CellTag
CellTag -> CellTag -> Bool
CellTag -> CellTag -> Ordering
CellTag -> CellTag -> CellTag
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 :: CellTag -> CellTag -> CellTag
$cmin :: CellTag -> CellTag -> CellTag
max :: CellTag -> CellTag -> CellTag
$cmax :: CellTag -> CellTag -> CellTag
>= :: CellTag -> CellTag -> Bool
$c>= :: CellTag -> CellTag -> Bool
> :: CellTag -> CellTag -> Bool
$c> :: CellTag -> CellTag -> Bool
<= :: CellTag -> CellTag -> Bool
$c<= :: CellTag -> CellTag -> Bool
< :: CellTag -> CellTag -> Bool
$c< :: CellTag -> CellTag -> Bool
compare :: CellTag -> CellTag -> Ordering
$ccompare :: CellTag -> CellTag -> Ordering
Ord, Int -> CellTag -> ShowS
[CellTag] -> ShowS
CellTag -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CellTag] -> ShowS
$cshowList :: [CellTag] -> ShowS
show :: CellTag -> String
$cshow :: CellTag -> String
showsPrec :: Int -> CellTag -> ShowS
$cshowsPrec :: Int -> CellTag -> ShowS
Show, Int -> CellTag
CellTag -> Int
CellTag -> [CellTag]
CellTag -> CellTag
CellTag -> CellTag -> [CellTag]
CellTag -> CellTag -> CellTag -> [CellTag]
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 :: CellTag -> CellTag -> CellTag -> [CellTag]
$cenumFromThenTo :: CellTag -> CellTag -> CellTag -> [CellTag]
enumFromTo :: CellTag -> CellTag -> [CellTag]
$cenumFromTo :: CellTag -> CellTag -> [CellTag]
enumFromThen :: CellTag -> CellTag -> [CellTag]
$cenumFromThen :: CellTag -> CellTag -> [CellTag]
enumFrom :: CellTag -> [CellTag]
$cenumFrom :: CellTag -> [CellTag]
fromEnum :: CellTag -> Int
$cfromEnum :: CellTag -> Int
toEnum :: Int -> CellTag
$ctoEnum :: Int -> CellTag
pred :: CellTag -> CellTag
$cpred :: CellTag -> CellTag
succ :: CellTag -> CellTag
$csucc :: CellTag -> CellTag
Enum, CellTag
forall a. a -> a -> Bounded a
maxBound :: CellTag
$cmaxBound :: CellTag
minBound :: CellTag
$cminBound :: CellTag
Bounded)
instance PrettyPrec CellTag where
prettyPrec :: forall ann. Int -> CellTag -> Doc ann
prettyPrec Int
_ = \case
CellTag
CellTerrain -> Doc ann
"terrain"
CellTag
CellEntity -> Doc ann
"an entity"
CellTag
CellRobot -> Doc ann
"a robot"
type RawCellVal = [(Maybe CellTag, Text)]
prettyRawCellItem :: (Maybe CellTag, Text) -> Doc ann
prettyRawCellItem :: forall ann. (Maybe CellTag, Text) -> Doc ann
prettyRawCellItem (Maybe CellTag
Nothing, Text
t) = forall a ann. Pretty a => a -> Doc ann
pretty Text
t
prettyRawCellItem (Just CellTag
tag, Text
t) = forall a ann. Pretty a => a -> Doc ann
pretty (Text -> Text
T.toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
T.drop Int
4 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> Text
showT forall a b. (a -> b) -> a -> b
$ CellTag
tag) forall a. Semigroup a => a -> a -> a
<> Doc ann
":" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Text
t
data CellVal = CellVal TerrainType (Erasable (Last Entity)) [Robot]
deriving (CellVal -> CellVal -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CellVal -> CellVal -> Bool
$c/= :: CellVal -> CellVal -> Bool
== :: CellVal -> CellVal -> Bool
$c== :: CellVal -> CellVal -> Bool
Eq, Int -> CellVal -> ShowS
[CellVal] -> ShowS
CellVal -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CellVal] -> ShowS
$cshowList :: [CellVal] -> ShowS
show :: CellVal -> String
$cshow :: CellVal -> String
showsPrec :: Int -> CellVal -> ShowS
$cshowsPrec :: Int -> CellVal -> ShowS
Show)
instance PrettyPrec CellVal where
prettyPrec :: forall ann. Int -> CellVal -> Doc ann
prettyPrec Int
_ (CellVal TerrainType
terr Erasable (Last Entity)
ent [Robot]
rs) =
Doc ann
"{" forall a. Semigroup a => a -> a -> a
<> forall ann. [Doc ann] -> Doc ann
hsep (forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
"," (forall a b. (a -> b) -> [a] -> [b]
map forall ann. (Maybe CellTag, Text) -> Doc ann
prettyRawCellItem [(Maybe CellTag, Text)]
items)) forall a. Semigroup a => a -> a -> a
<> Doc ann
"}"
where
items :: [(Maybe CellTag, Text)]
items =
[(forall a. a -> Maybe a
Just CellTag
CellTerrain, TerrainType -> Text
getTerrainWord TerrainType
terr) | TerrainType
terr forall a. Eq a => a -> a -> Bool
/= TerrainType
BlankT]
forall a. [a] -> [a] -> [a]
++ [(forall a. a -> Maybe a
Just CellTag
CellEntity, Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity Text
entityName) | EJust (Last Entity
e) <- [Erasable (Last Entity)
ent]]
forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map ((forall a. a -> Maybe a
Just CellTag
CellRobot,) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Robot Text
robotName) [Robot]
rs
data Rot = Rot0 | Rot90 | Rot180 | Rot270
deriving (Rot -> Rot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Rot -> Rot -> Bool
$c/= :: Rot -> Rot -> Bool
== :: Rot -> Rot -> Bool
$c== :: Rot -> Rot -> Bool
Eq, Eq Rot
Rot -> Rot -> Bool
Rot -> Rot -> Ordering
Rot -> Rot -> Rot
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 :: Rot -> Rot -> Rot
$cmin :: Rot -> Rot -> Rot
max :: Rot -> Rot -> Rot
$cmax :: Rot -> Rot -> Rot
>= :: Rot -> Rot -> Bool
$c>= :: Rot -> Rot -> Bool
> :: Rot -> Rot -> Bool
$c> :: Rot -> Rot -> Bool
<= :: Rot -> Rot -> Bool
$c<= :: Rot -> Rot -> Bool
< :: Rot -> Rot -> Bool
$c< :: Rot -> Rot -> Bool
compare :: Rot -> Rot -> Ordering
$ccompare :: Rot -> Rot -> Ordering
Ord, Int -> Rot -> ShowS
[Rot] -> ShowS
Rot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Rot] -> ShowS
$cshowList :: [Rot] -> ShowS
show :: Rot -> String
$cshow :: Rot -> String
showsPrec :: Int -> Rot -> ShowS
$cshowsPrec :: Int -> Rot -> ShowS
Show, Rot
forall a. a -> a -> Bounded a
maxBound :: Rot
$cmaxBound :: Rot
minBound :: Rot
$cminBound :: Rot
Bounded, Int -> Rot
Rot -> Int
Rot -> [Rot]
Rot -> Rot
Rot -> Rot -> [Rot]
Rot -> Rot -> Rot -> [Rot]
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 :: Rot -> Rot -> Rot -> [Rot]
$cenumFromThenTo :: Rot -> Rot -> Rot -> [Rot]
enumFromTo :: Rot -> Rot -> [Rot]
$cenumFromTo :: Rot -> Rot -> [Rot]
enumFromThen :: Rot -> Rot -> [Rot]
$cenumFromThen :: Rot -> Rot -> [Rot]
enumFrom :: Rot -> [Rot]
$cenumFrom :: Rot -> [Rot]
fromEnum :: Rot -> Int
$cfromEnum :: Rot -> Int
toEnum :: Int -> Rot
$ctoEnum :: Int -> Rot
pred :: Rot -> Rot
$cpred :: Rot -> Rot
succ :: Rot -> Rot
$csucc :: Rot -> Rot
Enum)
instance PrettyPrec Rot where
prettyPrec :: forall ann. Int -> Rot -> Doc ann
prettyPrec Int
_ = \case
Rot
Rot0 -> Doc ann
"rot0"
Rot
Rot90 -> Doc ann
"rot90"
Rot
Rot180 -> Doc ann
"rot180"
Rot
Rot270 -> Doc ann
"rot270"
type Var = Text
data Axis = X | Y
deriving (Axis -> Axis -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Axis -> Axis -> Bool
$c/= :: Axis -> Axis -> Bool
== :: Axis -> Axis -> Bool
$c== :: Axis -> Axis -> Bool
Eq, Eq Axis
Axis -> Axis -> Bool
Axis -> Axis -> Ordering
Axis -> Axis -> Axis
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 :: Axis -> Axis -> Axis
$cmin :: Axis -> Axis -> Axis
max :: Axis -> Axis -> Axis
$cmax :: Axis -> Axis -> Axis
>= :: Axis -> Axis -> Bool
$c>= :: Axis -> Axis -> Bool
> :: Axis -> Axis -> Bool
$c> :: Axis -> Axis -> Bool
<= :: Axis -> Axis -> Bool
$c<= :: Axis -> Axis -> Bool
< :: Axis -> Axis -> Bool
$c< :: Axis -> Axis -> Bool
compare :: Axis -> Axis -> Ordering
$ccompare :: Axis -> Axis -> Ordering
Ord, Int -> Axis -> ShowS
[Axis] -> ShowS
Axis -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Axis] -> ShowS
$cshowList :: [Axis] -> ShowS
show :: Axis -> String
$cshow :: Axis -> String
showsPrec :: Int -> Axis -> ShowS
$cshowsPrec :: Int -> Axis -> ShowS
Show, Axis
forall a. a -> a -> Bounded a
maxBound :: Axis
$cmaxBound :: Axis
minBound :: Axis
$cminBound :: Axis
Bounded, Int -> Axis
Axis -> Int
Axis -> [Axis]
Axis -> Axis
Axis -> Axis -> [Axis]
Axis -> Axis -> Axis -> [Axis]
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 :: Axis -> Axis -> Axis -> [Axis]
$cenumFromThenTo :: Axis -> Axis -> Axis -> [Axis]
enumFromTo :: Axis -> Axis -> [Axis]
$cenumFromTo :: Axis -> Axis -> [Axis]
enumFromThen :: Axis -> Axis -> [Axis]
$cenumFromThen :: Axis -> Axis -> [Axis]
enumFrom :: Axis -> [Axis]
$cenumFrom :: Axis -> [Axis]
fromEnum :: Axis -> Int
$cfromEnum :: Axis -> Int
toEnum :: Int -> Axis
$ctoEnum :: Int -> Axis
pred :: Axis -> Axis
$cpred :: Axis -> Axis
succ :: Axis -> Axis
$csucc :: Axis -> Axis
Enum)
instance PrettyPrec Axis where
prettyPrec :: forall ann. Int -> Axis -> Doc ann
prettyPrec Int
_ = \case Axis
X -> Doc ann
"x"; Axis
Y -> Doc ann
"y"
data Op = Not | Neg | And | Or | Add | Sub | Mul | Div | Mod | Eq | Neq | Lt | Leq | Gt | Geq | If | Perlin | Reflect Axis | Rot Rot | Mask | Overlay | Abs
deriving (Op -> Op -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Op -> Op -> Bool
$c/= :: Op -> Op -> Bool
== :: Op -> Op -> Bool
$c== :: Op -> Op -> Bool
Eq, Eq Op
Op -> Op -> Bool
Op -> Op -> Ordering
Op -> Op -> Op
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 :: Op -> Op -> Op
$cmin :: Op -> Op -> Op
max :: Op -> Op -> Op
$cmax :: Op -> Op -> Op
>= :: Op -> Op -> Bool
$c>= :: Op -> Op -> Bool
> :: Op -> Op -> Bool
$c> :: Op -> Op -> Bool
<= :: Op -> Op -> Bool
$c<= :: Op -> Op -> Bool
< :: Op -> Op -> Bool
$c< :: Op -> Op -> Bool
compare :: Op -> Op -> Ordering
$ccompare :: Op -> Op -> Ordering
Ord, Int -> Op -> ShowS
[Op] -> ShowS
Op -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Op] -> ShowS
$cshowList :: [Op] -> ShowS
show :: Op -> String
$cshow :: Op -> String
showsPrec :: Int -> Op -> ShowS
$cshowsPrec :: Int -> Op -> ShowS
Show)
data WExp where
WInt :: Integer -> WExp
WFloat :: Double -> WExp
WBool :: Bool -> WExp
WCell :: RawCellVal -> WExp
WVar :: Text -> WExp
WOp :: Op -> [WExp] -> WExp
WSeed :: WExp
WCoord :: Axis -> WExp
WHash :: WExp
WLet :: [(Var, WExp)] -> WExp -> WExp
WOverlay :: NE.NonEmpty WExp -> WExp
WImport :: Text -> WExp
deriving (WExp -> WExp -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WExp -> WExp -> Bool
$c/= :: WExp -> WExp -> Bool
== :: WExp -> WExp -> Bool
$c== :: WExp -> WExp -> Bool
Eq, Int -> WExp -> ShowS
[WExp] -> ShowS
WExp -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WExp] -> ShowS
$cshowList :: [WExp] -> ShowS
show :: WExp -> String
$cshow :: WExp -> String
showsPrec :: Int -> WExp -> ShowS
$cshowsPrec :: Int -> WExp -> ShowS
Show)