{-# LANGUAGE OverloadedStrings #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Abstract syntax for the Swarm world description DSL.
module Swarm.Game.World.Syntax (
  -- | Various component types
  World,
  RawCellVal,
  CellTag (..),
  CellVal (..),
  Rot (..),
  Var,
  Axis (..),
  Op (..),
  -- | The main AST type
  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

------------------------------------------------------------
-- Bits and bobs

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)

------------------------------------------------------------
-- Main AST

data WExp where
  WInt :: Integer -> WExp
  WFloat :: Double -> WExp
  WBool :: Bool -> WExp
  WCell :: RawCellVal -> WExp
  WVar :: Text -> WExp
  -- Require all operators to be fully saturated.  Just embedding
  -- operators as constants and including function application would
  -- be a more elegant encoding, but it requires being more clever
  -- with type inference.
  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)

-- We don't have an explicit Empty case because we can't infer its
-- type.  It could be done but it would require a lot more care with
-- inference vs checking mode.

-- TODO (#1394): Add hcat and vcat operations
-- WCat :: Axis -> [WExp] -> WExp

-- TODO (#1394): Add support for structures
-- WStruct :: WorldPalette Text -> [Text] -> WExp