{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Swarm.Game.World.Parse where
import Control.Monad (void)
import Control.Monad.Combinators.Expr (Operator (..), makeExprParser)
import Control.Monad.Combinators.NonEmpty qualified as CNE (sepBy1)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Void (Void)
import Data.Yaml (FromJSON (parseJSON), withText)
import Swarm.Game.World.Syntax
import Swarm.Util (failT, showT, squote)
import Swarm.Util.Parse (fully)
import Text.Megaparsec hiding (runParser)
import Text.Megaparsec.Char
import Text.Megaparsec.Char.Lexer qualified as L
import Witch (into)
type Parser = Parsec Void Text
type ParserError = ParseErrorBundle Text Void
reservedWords :: [Text]
reservedWords :: [Text]
reservedWords =
[ Text
"not"
, Text
"true"
, Text
"false"
, Text
"seed"
, Text
"x"
, Text
"y"
, Text
"hash"
, Text
"let"
, Text
"in"
, Text
"overlay"
, Text
"hcat"
, Text
"vcat"
, Text
"if"
, Text
"then"
, Text
"else"
, Text
"perlin"
, Text
"mask"
, Text
"empty"
, Text
"abs"
]
sc :: Parser ()
sc :: Parser ()
sc =
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> m () -> m () -> m ()
L.space
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space1
(forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Tokens s -> m ()
L.skipLineComment Tokens Text
"//")
(forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> Tokens s -> m ()
L.skipBlockComment Tokens Text
"/*" Tokens Text
"*/")
lexeme :: Parser a -> Parser a
lexeme :: forall a. Parser a -> Parser a
lexeme = forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
L.lexeme Parser ()
sc
symbol :: Text -> Parser Text
symbol :: Text -> Parser Text
symbol = forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> Tokens s -> m (Tokens s)
L.symbol Parser ()
sc
operatorChar :: Parser Char
operatorChar :: Parser Char
operatorChar = forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf ([Char]
"!@#$%^&*=+-/<>" :: String)
operator :: Text -> Parser Text
operator :: Text -> Parser Text
operator Text
op = (forall a. Parser a -> Parser a
lexeme forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try) forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Text
op forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy Parser Char
operatorChar
integerOrFloat :: Parser (Either Integer Double)
integerOrFloat :: Parser (Either Integer Double)
integerOrFloat =
forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"numeric literal" forall a b. (a -> b) -> a -> b
$
forall a. Parser a -> Parser a
lexeme (forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, RealFloat a) =>
m a
L.float forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
L.decimal)
reserved :: Text -> Parser ()
reserved :: Text -> Parser ()
reserved Text
w = (forall a. Parser a -> Parser a
lexeme forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try) forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
string' Text
w forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'_')
identifier :: Parser Var
identifier :: Parser Text
identifier = (forall a. Parser a -> Parser a
lexeme forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try) (ParsecT Void Text Identity [Token Text]
p forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {source} {m :: * -> *}.
(From source Text, MonadFail m) =>
source -> m Text
check) forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"variable name"
where
p :: ParsecT Void Text Identity [Token Text]
p = (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
letterChar forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'_') forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'_' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'\'')
check :: source -> m Text
check (forall target source. From source target => source -> target
into @Text -> Text
t)
| Text -> Text
T.toLower Text
t forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
reservedWords =
forall (m :: * -> *) a. MonadFail m => [Text] -> m a
failT [Text
"reserved word", Text -> Text
squote Text
t, Text
"cannot be used as variable name"]
| Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return Text
t
brackets :: Parser a -> Parser a
brackets :: forall a. Parser a -> Parser a
brackets = forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Text -> Parser Text
symbol Text
"[") (Text -> Parser Text
symbol Text
"]")
parens :: Parser a -> Parser a
parens :: forall a. Parser a -> Parser a
parens = forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Text -> Parser Text
symbol Text
"(") (Text -> Parser Text
symbol Text
")")
braces :: Parser a -> Parser a
braces :: forall a. Parser a -> Parser a
braces = forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Text -> Parser Text
symbol Text
"{") (Text -> Parser Text
symbol Text
"}")
comma :: Parser ()
comma :: Parser ()
comma = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Text -> Parser Text
symbol Text
","
parseWExpAtom :: Parser WExp
parseWExpAtom :: Parser WExp
parseWExpAtom =
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Integer -> WExp
WInt Double -> WExp
WFloat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Either Integer Double)
integerOrFloat
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> WExp
WBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bool
True forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser ()
reserved Text
"true" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool
False forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser ()
reserved Text
"false")
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser WExp
parseCell
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> WExp
WVar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
identifier
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> WExp
WSeed forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser ()
reserved Text
"seed"
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Axis -> WExp
WCoord forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Axis
X forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser ()
reserved Text
"x" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Axis
Y forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser ()
reserved Text
"y")
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> WExp
WHash forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser ()
reserved Text
"hash"
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser WExp
parseIf
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser WExp
parsePerlin
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser WExp
parseAbs
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser WExp
parseLet
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser WExp
parseOverlay
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser WExp
parseMask
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser WExp
parseImport
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. Parser a -> Parser a
parens Parser WExp
parseWExp
parseWExp :: Parser WExp
parseWExp :: Parser WExp
parseWExp =
forall (m :: * -> *) a.
MonadPlus m =>
m a -> [[Operator m a]] -> m a
makeExprParser
Parser WExp
parseWExpAtom
[
[ forall (m :: * -> *) a. m (a -> a) -> Operator m a
Prefix (Op -> WExp -> WExp
unary Op
Not forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser ()
reserved Text
"not")
, forall (m :: * -> *) a. m (a -> a) -> Operator m a
Prefix (Op -> WExp -> WExp
unary Op
Neg forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
operator Text
"-")
]
,
[ forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixL (Op -> WExp -> WExp -> WExp
binary Op
Mul forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
operator Text
"*")
, forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixL (Op -> WExp -> WExp -> WExp
binary Op
Div forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
operator Text
"/")
, forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixL (Op -> WExp -> WExp -> WExp
binary Op
Mod forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
operator Text
"%")
]
,
[ forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixL (Op -> WExp -> WExp -> WExp
binary Op
Add forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
operator Text
"+")
, forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixL (Op -> WExp -> WExp -> WExp
binary Op
Sub forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
operator Text
"-")
, forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixR (Op -> WExp -> WExp -> WExp
binary Op
Overlay forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
operator Text
"<>")
]
,
[ forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixN (Op -> WExp -> WExp -> WExp
binary Op
Eq forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
operator Text
"==")
, forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixN (Op -> WExp -> WExp -> WExp
binary Op
Neq forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
operator Text
"/=")
, forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixN (Op -> WExp -> WExp -> WExp
binary Op
Lt forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
operator Text
"<")
, forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixN (Op -> WExp -> WExp -> WExp
binary Op
Leq forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
operator Text
"<=")
, forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixN (Op -> WExp -> WExp -> WExp
binary Op
Gt forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
operator Text
">")
, forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixN (Op -> WExp -> WExp -> WExp
binary Op
Geq forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
operator Text
">=")
]
, [forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixR (Op -> WExp -> WExp -> WExp
binary Op
And forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
operator Text
"&&")]
, [forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixR (Op -> WExp -> WExp -> WExp
binary Op
Or forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
operator Text
"||")]
]
where
unary :: Op -> WExp -> WExp
unary Op
op WExp
x = Op -> [WExp] -> WExp
WOp Op
op [WExp
x]
binary :: Op -> WExp -> WExp -> WExp
binary Op
op WExp
x1 WExp
x2 = Op -> [WExp] -> WExp
WOp Op
op [WExp
x1, WExp
x2]
parseCell :: Parser WExp
parseCell :: Parser WExp
parseCell =
forall a. Parser a -> Parser a
braces forall a b. (a -> b) -> a -> b
$ RawCellVal -> WExp
WCell forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Maybe CellTag, Text)
parseCellItem forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepBy1` Parser ()
comma
parseCellItem :: Parser (Maybe CellTag, Text)
parseCellItem :: Parser (Maybe CellTag, Text)
parseCellItem =
(,)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity CellTag
parseCellTag forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> Parser Text
symbol Text
":"))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text
parseName
parseCellTag :: Parser CellTag
parseCellTag :: ParsecT Void Text Identity CellTag
parseCellTag = forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice (forall a b. (a -> b) -> [a] -> [b]
map forall {s} {f :: * -> *} {e} {a}.
(Tokens s ~ Text, MonadParsec e s f, FoldCase (Tokens s),
Show a) =>
a -> f a
mkCellTagParser [forall a. Bounded a => a
minBound .. forall a. Bounded a => a
maxBound :: CellTag])
where
mkCellTagParser :: a -> f a
mkCellTagParser a
ct = a
ct forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall e s (m :: * -> *).
(MonadParsec e s m, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
string' (Int -> Text -> Text
T.drop Int
4 forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> Text
showT a
ct)
parseName :: Parser Text
parseName :: Parser Text
parseName =
forall target source. From source target => source -> target
into @Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
manyTill forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy (\Token Text
c -> Token Text
c forall a. Eq a => a -> a -> Bool
== Char
',' Bool -> Bool -> Bool
|| Token Text
c forall a. Eq a => a -> a -> Bool
== Char
'}' Bool -> Bool -> Bool
|| Token Text
c forall a. Eq a => a -> a -> Bool
== Char
']')))
parseIf :: Parser WExp
parseIf :: Parser WExp
parseIf =
(\WExp
i WExp
t WExp
e -> Op -> [WExp] -> WExp
WOp Op
If [WExp
i, WExp
t, WExp
e])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Parser ()
reserved Text
"if" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser WExp
parseWExp)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> Parser ()
reserved Text
"then" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser WExp
parseWExp)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> Parser ()
reserved Text
"else" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser WExp
parseWExp)
parsePerlin :: Parser WExp
parsePerlin :: Parser WExp
parsePerlin =
(\WExp
s WExp
o WExp
k WExp
p -> Op -> [WExp] -> WExp
WOp Op
Perlin [WExp
s, WExp
o, WExp
k, WExp
p])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Parser ()
reserved Text
"perlin" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser WExp
parseWExpAtom)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser WExp
parseWExpAtom
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser WExp
parseWExpAtom
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser WExp
parseWExpAtom
parseAbs :: Parser WExp
parseAbs :: Parser WExp
parseAbs =
Op -> [WExp] -> WExp
WOp Op
Abs forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
: []) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Parser ()
reserved Text
"abs" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser WExp
parseWExpAtom)
parseLet :: Parser WExp
parseLet :: Parser WExp
parseLet =
[(Text, WExp)] -> WExp -> WExp
WLet
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( Text -> Parser ()
reserved Text
"let"
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
identifier forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> Parser Text
symbol Text
"=" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser WExp
parseWExp)) forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepBy` Parser ()
comma)
)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> Parser ()
reserved Text
"in" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser WExp
parseWExp)
parseOverlay :: Parser WExp
parseOverlay :: Parser WExp
parseOverlay = do
Text -> Parser ()
reserved Text
"overlay"
forall a. Parser a -> Parser a
brackets forall a b. (a -> b) -> a -> b
$ NonEmpty WExp -> WExp
WOverlay forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser WExp
parseWExp forall (m :: * -> *) a sep.
MonadPlus m =>
m a -> m sep -> m (NonEmpty a)
`CNE.sepBy1` Parser ()
comma
parseMask :: Parser WExp
parseMask :: Parser WExp
parseMask = do
Text -> Parser ()
reserved Text
"mask"
WExp
w1 <- Parser WExp
parseWExpAtom
WExp
w2 <- Parser WExp
parseWExpAtom
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Op -> [WExp] -> WExp
WOp Op
Mask [WExp
w1, WExp
w2]
parseImport :: Parser WExp
parseImport :: Parser WExp
parseImport = Text -> WExp
WImport forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall target source. From source target => source -> target
into @Text forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Text -> Parser Text
symbol Text
"\"") (Text -> Parser Text
symbol Text
"\"") (forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy (forall a. Eq a => a -> a -> Bool
/= Char
'"')))
runParser :: Parser a -> Text -> Either ParserError a
runParser :: forall a. Parser a -> Text -> Either ParserError a
runParser Parser a
p = forall e s a.
Parsec e s a -> [Char] -> s -> Either (ParseErrorBundle s e) a
parse (forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
fully Parser ()
sc Parser a
p) [Char]
""
instance FromJSON WExp where
parseJSON :: Value -> Parser WExp
parseJSON = forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
"World DSL program" forall a b. (a -> b) -> a -> b
$ \Text
t ->
case forall a. Parser a -> Text -> Either ParserError a
runParser Parser WExp
parseWExp Text
t of
Left ParserError
err -> forall a. HasCallStack => [Char] -> a
error (forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> [Char]
errorBundlePretty ParserError
err)
Right WExp
wexp -> forall (m :: * -> *) a. Monad m => a -> m a
return WExp
wexp