{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
-- FromJSON WExp
{-# OPTIONS_GHC -Wno-orphans #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Parser for the Swarm world description DSL.
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.List.Extra (enumerate)
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.Language.Parser.Util (fully)
import Swarm.Util (failT, showT, squote)
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

------------------------------------------------------------
-- Lexing

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"
  , Text
"imap"
  ]

-- | Skip spaces and comments.
sc :: Parser ()
sc :: Parser ()
sc =
  Parser () -> Parser () -> Parser () -> Parser ()
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> m () -> m () -> m ()
L.space
    Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space1
    (Tokens Text -> Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Tokens s -> m ()
L.skipLineComment Tokens Text
"//")
    (Tokens Text -> Tokens Text -> Parser ()
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> Tokens s -> m ()
L.skipBlockComment Tokens Text
"/*" Tokens Text
"*/")

-- | In general, we follow the convention that every token parser
--   assumes no leading whitespace and consumes all trailing
--   whitespace.  Concretely, we achieve this by wrapping every token
--   parser using 'lexeme'.
lexeme :: Parser a -> Parser a
lexeme :: forall a. Parser a -> Parser a
lexeme = Parser ()
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
L.lexeme Parser ()
sc

-- | A lexeme consisting of a literal string.
symbol :: Text -> Parser Text
symbol :: Text -> Parser Text
symbol = Parser ()
-> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
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 = [Token Text] -> ParsecT Void Text Identity (Token Text)
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 = (Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme (Parser Text -> Parser Text)
-> (Parser Text -> Parser Text) -> Parser Text -> Parser Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Text -> Parser Text
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try) (Parser Text -> Parser Text) -> Parser Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Text
Tokens Text
op Parser Text -> Parser () -> Parser Text
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Char -> Parser ()
forall a. ParsecT Void Text Identity a -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy Parser Char
operatorChar

-- | A positive integer literal token.
integerOrFloat :: Parser (Either Integer Double)
integerOrFloat :: Parser (Either Integer Double)
integerOrFloat =
  [Char]
-> Parser (Either Integer Double) -> Parser (Either Integer Double)
forall a.
[Char]
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"numeric literal" (Parser (Either Integer Double) -> Parser (Either Integer Double))
-> Parser (Either Integer Double) -> Parser (Either Integer Double)
forall a b. (a -> b) -> a -> b
$
    Parser (Either Integer Double) -> Parser (Either Integer Double)
forall a. Parser a -> Parser a
lexeme (Double -> Either Integer Double
forall a b. b -> Either a b
Right (Double -> Either Integer Double)
-> ParsecT Void Text Identity Double
-> Parser (Either Integer Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Double
-> ParsecT Void Text Identity Double
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity Double
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, RealFloat a) =>
m a
L.float Parser (Either Integer Double)
-> Parser (Either Integer Double) -> Parser (Either Integer Double)
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Integer -> Either Integer Double
forall a b. a -> Either a b
Left (Integer -> Either Integer Double)
-> ParsecT Void Text Identity Integer
-> Parser (Either Integer Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
L.decimal)

-- | Parse a case-insensitive reserved word, making sure it is not a
--   prefix of a longer variable name, and allowing the parser to
--   backtrack if it fails.
reserved :: Text -> Parser ()
reserved :: Text -> Parser ()
reserved Text
w = (Parser () -> Parser ()
forall a. Parser a -> Parser a
lexeme (Parser () -> Parser ())
-> (Parser () -> Parser ()) -> Parser () -> Parser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser () -> Parser ()
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try) (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
(MonadParsec e s m, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
string' Text
Tokens Text
w ParsecT Void Text Identity (Tokens Text) -> Parser () -> Parser ()
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Char -> Parser ()
forall a. ParsecT Void Text Identity a -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy (Parser Char
ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar Parser Char -> Parser Char -> Parser Char
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'_')

-- | Parse an identifier, i.e. any non-reserved string containing
--   alphanumeric characters and underscores and not starting with a
--   number.
identifier :: Parser Var
identifier :: Parser Text
identifier = (Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme (Parser Text -> Parser Text)
-> (Parser Text -> Parser Text) -> Parser Text -> Parser Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Text -> Parser Text
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try) (ParsecT Void Text Identity [Char]
p ParsecT Void Text Identity [Char]
-> ([Char] -> Parser Text) -> Parser Text
forall a b.
ParsecT Void Text Identity a
-> (a -> ParsecT Void Text Identity b)
-> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> Parser Text
forall {source} {m :: * -> *}.
(From source Text, MonadFail m) =>
source -> m Text
check) Parser Text -> [Char] -> Parser Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"variable name"
 where
  p :: ParsecT Void Text Identity [Char]
p = (:) (Char -> [Char] -> [Char])
-> Parser Char -> ParsecT Void Text Identity ([Char] -> [Char])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Char
ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
letterChar Parser Char -> Parser Char -> Parser Char
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'_') ParsecT Void Text Identity ([Char] -> [Char])
-> ParsecT Void Text Identity [Char]
-> ParsecT Void Text Identity [Char]
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Char -> ParsecT Void Text Identity [Char]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (Parser Char
ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar Parser Char -> Parser Char -> Parser Char
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'_' Parser Char -> Parser Char -> Parser Char
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'\'')
  check :: source -> m Text
check (forall target source. From source target => source -> target
into @Text -> Text
t)
    | Text -> Text
T.toLower Text
t Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
reservedWords =
        [Text] -> m Text
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 = Text -> m Text
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
t

brackets :: Parser a -> Parser a
brackets :: forall a. Parser a -> Parser a
brackets = Parser Text
-> Parser Text
-> ParsecT Void Text Identity a
-> ParsecT Void Text Identity a
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 = Parser Text
-> Parser Text
-> ParsecT Void Text Identity a
-> ParsecT Void Text Identity a
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 = Parser Text
-> Parser Text
-> ParsecT Void Text Identity a
-> ParsecT Void Text Identity a
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 = Parser Text -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Text -> Parser ()) -> Parser Text -> Parser ()
forall a b. (a -> b) -> a -> b
$ Text -> Parser Text
symbol Text
","

------------------------------------------------------------
-- Parser

----------------------------------------------------------------------
-- NOTE: when updating the parser, be sure to update the BNF in
-- data/worlds/README.md to match!
----------------------------------------------------------------------

parseWExpAtom :: Parser WExp
parseWExpAtom :: Parser WExp
parseWExpAtom =
  (Integer -> WExp)
-> (Double -> WExp) -> Either Integer Double -> WExp
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Integer -> WExp
WInt Double -> WExp
WFloat (Either Integer Double -> WExp)
-> Parser (Either Integer Double) -> Parser WExp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Either Integer Double)
integerOrFloat
    Parser WExp -> Parser WExp -> Parser WExp
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> WExp
WBool (Bool -> WExp) -> ParsecT Void Text Identity Bool -> Parser WExp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bool
True Bool -> Parser () -> ParsecT Void Text Identity Bool
forall a b.
a -> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser ()
reserved Text
"true" ParsecT Void Text Identity Bool
-> ParsecT Void Text Identity Bool
-> ParsecT Void Text Identity Bool
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool
False Bool -> Parser () -> ParsecT Void Text Identity Bool
forall a b.
a -> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser ()
reserved Text
"false")
    Parser WExp -> Parser WExp -> Parser WExp
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser WExp
parseCell
    Parser WExp -> Parser WExp -> Parser WExp
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> WExp
WVar (Text -> WExp) -> Parser Text -> Parser WExp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
identifier
    Parser WExp -> Parser WExp -> Parser WExp
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> WExp
WSeed WExp -> Parser () -> Parser WExp
forall a b.
a -> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser ()
reserved Text
"seed"
    Parser WExp -> Parser WExp -> Parser WExp
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Axis -> WExp
WCoord (Axis -> WExp) -> ParsecT Void Text Identity Axis -> Parser WExp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Axis
X Axis -> Parser () -> ParsecT Void Text Identity Axis
forall a b.
a -> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser ()
reserved Text
"x" ParsecT Void Text Identity Axis
-> ParsecT Void Text Identity Axis
-> ParsecT Void Text Identity Axis
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Axis
Y Axis -> Parser () -> ParsecT Void Text Identity Axis
forall a b.
a -> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser ()
reserved Text
"y")
    Parser WExp -> Parser WExp -> Parser WExp
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> WExp
WHash WExp -> Parser () -> Parser WExp
forall a b.
a -> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser ()
reserved Text
"hash"
    Parser WExp -> Parser WExp -> Parser WExp
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser WExp
parseIf
    Parser WExp -> Parser WExp -> Parser WExp
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser WExp
parsePerlin
    Parser WExp -> Parser WExp -> Parser WExp
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser WExp
parseAbs
    Parser WExp -> Parser WExp -> Parser WExp
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser WExp
parseLet
    Parser WExp -> Parser WExp -> Parser WExp
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser WExp
parseOverlay
    Parser WExp -> Parser WExp -> Parser WExp
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser WExp
parseMask
    Parser WExp -> Parser WExp -> Parser WExp
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser WExp
parseImport
    Parser WExp -> Parser WExp -> Parser WExp
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser WExp
parseIMap
    -- <|> parseCat
    -- <|> parseStruct
    Parser WExp -> Parser WExp -> Parser WExp
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser WExp -> Parser WExp
forall a. Parser a -> Parser a
parens Parser WExp
parseWExp

parseWExp :: Parser WExp
parseWExp :: Parser WExp
parseWExp =
  Parser WExp
-> [[Operator (ParsecT Void Text Identity) WExp]] -> Parser WExp
forall (m :: * -> *) a.
MonadPlus m =>
m a -> [[Operator m a]] -> m a
makeExprParser
    Parser WExp
parseWExpAtom
    [
      [ ParsecT Void Text Identity (WExp -> WExp)
-> Operator (ParsecT Void Text Identity) WExp
forall (m :: * -> *) a. m (a -> a) -> Operator m a
Prefix (Op -> WExp -> WExp
unary Op
Not (WExp -> WExp)
-> Parser () -> ParsecT Void Text Identity (WExp -> WExp)
forall a b.
a -> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser ()
reserved Text
"not")
      , ParsecT Void Text Identity (WExp -> WExp)
-> Operator (ParsecT Void Text Identity) WExp
forall (m :: * -> *) a. m (a -> a) -> Operator m a
Prefix (Op -> WExp -> WExp
unary Op
Neg (WExp -> WExp)
-> Parser Text -> ParsecT Void Text Identity (WExp -> WExp)
forall a b.
a -> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
operator Text
"-")
      ]
    ,
      [ ParsecT Void Text Identity (WExp -> WExp -> WExp)
-> Operator (ParsecT Void Text Identity) WExp
forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixL (Op -> WExp -> WExp -> WExp
binary Op
Mul (WExp -> WExp -> WExp)
-> Parser Text -> ParsecT Void Text Identity (WExp -> WExp -> WExp)
forall a b.
a -> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
operator Text
"*")
      , ParsecT Void Text Identity (WExp -> WExp -> WExp)
-> Operator (ParsecT Void Text Identity) WExp
forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixL (Op -> WExp -> WExp -> WExp
binary Op
Div (WExp -> WExp -> WExp)
-> Parser Text -> ParsecT Void Text Identity (WExp -> WExp -> WExp)
forall a b.
a -> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
operator Text
"/")
      , ParsecT Void Text Identity (WExp -> WExp -> WExp)
-> Operator (ParsecT Void Text Identity) WExp
forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixL (Op -> WExp -> WExp -> WExp
binary Op
Mod (WExp -> WExp -> WExp)
-> Parser Text -> ParsecT Void Text Identity (WExp -> WExp -> WExp)
forall a b.
a -> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
operator Text
"%")
      ]
    ,
      [ ParsecT Void Text Identity (WExp -> WExp -> WExp)
-> Operator (ParsecT Void Text Identity) WExp
forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixL (Op -> WExp -> WExp -> WExp
binary Op
Add (WExp -> WExp -> WExp)
-> Parser Text -> ParsecT Void Text Identity (WExp -> WExp -> WExp)
forall a b.
a -> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
operator Text
"+")
      , ParsecT Void Text Identity (WExp -> WExp -> WExp)
-> Operator (ParsecT Void Text Identity) WExp
forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixL (Op -> WExp -> WExp -> WExp
binary Op
Sub (WExp -> WExp -> WExp)
-> Parser Text -> ParsecT Void Text Identity (WExp -> WExp -> WExp)
forall a b.
a -> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
operator Text
"-")
      , ParsecT Void Text Identity (WExp -> WExp -> WExp)
-> Operator (ParsecT Void Text Identity) WExp
forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixR (Op -> WExp -> WExp -> WExp
binary Op
Overlay (WExp -> WExp -> WExp)
-> Parser Text -> ParsecT Void Text Identity (WExp -> WExp -> WExp)
forall a b.
a -> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
operator Text
"<>")
      ]
    ,
      [ ParsecT Void Text Identity (WExp -> WExp -> WExp)
-> Operator (ParsecT Void Text Identity) WExp
forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixN (Op -> WExp -> WExp -> WExp
binary Op
Eq (WExp -> WExp -> WExp)
-> Parser Text -> ParsecT Void Text Identity (WExp -> WExp -> WExp)
forall a b.
a -> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
operator Text
"==")
      , ParsecT Void Text Identity (WExp -> WExp -> WExp)
-> Operator (ParsecT Void Text Identity) WExp
forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixN (Op -> WExp -> WExp -> WExp
binary Op
Neq (WExp -> WExp -> WExp)
-> Parser Text -> ParsecT Void Text Identity (WExp -> WExp -> WExp)
forall a b.
a -> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
operator Text
"/=")
      , ParsecT Void Text Identity (WExp -> WExp -> WExp)
-> Operator (ParsecT Void Text Identity) WExp
forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixN (Op -> WExp -> WExp -> WExp
binary Op
Lt (WExp -> WExp -> WExp)
-> Parser Text -> ParsecT Void Text Identity (WExp -> WExp -> WExp)
forall a b.
a -> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
operator Text
"<")
      , ParsecT Void Text Identity (WExp -> WExp -> WExp)
-> Operator (ParsecT Void Text Identity) WExp
forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixN (Op -> WExp -> WExp -> WExp
binary Op
Leq (WExp -> WExp -> WExp)
-> Parser Text -> ParsecT Void Text Identity (WExp -> WExp -> WExp)
forall a b.
a -> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
operator Text
"<=")
      , ParsecT Void Text Identity (WExp -> WExp -> WExp)
-> Operator (ParsecT Void Text Identity) WExp
forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixN (Op -> WExp -> WExp -> WExp
binary Op
Gt (WExp -> WExp -> WExp)
-> Parser Text -> ParsecT Void Text Identity (WExp -> WExp -> WExp)
forall a b.
a -> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
operator Text
">")
      , ParsecT Void Text Identity (WExp -> WExp -> WExp)
-> Operator (ParsecT Void Text Identity) WExp
forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixN (Op -> WExp -> WExp -> WExp
binary Op
Geq (WExp -> WExp -> WExp)
-> Parser Text -> ParsecT Void Text Identity (WExp -> WExp -> WExp)
forall a b.
a -> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
operator Text
">=")
      ]
    , [ParsecT Void Text Identity (WExp -> WExp -> WExp)
-> Operator (ParsecT Void Text Identity) WExp
forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixR (Op -> WExp -> WExp -> WExp
binary Op
And (WExp -> WExp -> WExp)
-> Parser Text -> ParsecT Void Text Identity (WExp -> WExp -> WExp)
forall a b.
a -> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
operator Text
"&&")]
    , [ParsecT Void Text Identity (WExp -> WExp -> WExp)
-> Operator (ParsecT Void Text Identity) WExp
forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixR (Op -> WExp -> WExp -> WExp
binary Op
Or (WExp -> WExp -> WExp)
-> Parser Text -> ParsecT Void Text Identity (WExp -> WExp -> WExp)
forall a b.
a -> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
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 =
  Parser WExp -> Parser WExp
forall a. Parser a -> Parser a
braces (Parser WExp -> Parser WExp) -> Parser WExp -> Parser WExp
forall a b. (a -> b) -> a -> b
$ RawCellVal -> WExp
WCell (RawCellVal -> WExp)
-> ParsecT Void Text Identity RawCellVal -> Parser WExp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Maybe CellTag, Text)
parseCellItem Parser (Maybe CellTag, Text)
-> Parser () -> ParsecT Void Text Identity RawCellVal
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 =
  (,)
    (Maybe CellTag -> Text -> (Maybe CellTag, Text))
-> ParsecT Void Text Identity (Maybe CellTag)
-> ParsecT Void Text Identity (Text -> (Maybe CellTag, Text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity CellTag
-> ParsecT Void Text Identity (Maybe CellTag)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void Text Identity CellTag
-> ParsecT Void Text Identity CellTag
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity CellTag
parseCellTag ParsecT Void Text Identity CellTag
-> Parser Text -> ParsecT Void Text Identity CellTag
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> Parser Text
symbol Text
":"))
    ParsecT Void Text Identity (Text -> (Maybe CellTag, Text))
-> Parser Text -> Parser (Maybe CellTag, Text)
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
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 = [ParsecT Void Text Identity CellTag]
-> ParsecT Void Text Identity CellTag
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ((CellTag -> ParsecT Void Text Identity CellTag)
-> [CellTag] -> [ParsecT Void Text Identity CellTag]
forall a b. (a -> b) -> [a] -> [b]
map CellTag -> ParsecT Void Text Identity CellTag
forall {s} {f :: * -> *} {e} {a}.
(Tokens s ~ Text, MonadParsec e s f, Show a) =>
a -> f a
mkCellTagParser (forall a. (Enum a, Bounded a) => [a]
enumerate @CellTag))
 where
  mkCellTagParser :: a -> f a
mkCellTagParser a
ct = a
ct a -> f (Tokens s) -> f a
forall a b. a -> f b -> f a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens s -> f (Tokens s)
forall e s (m :: * -> *).
(MonadParsec e s m, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
string' (Int -> Text -> Text
T.drop Int
4 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ a -> Text
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
    ([Token Text] -> Text)
-> ParsecT Void Text Identity [Token Text] -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity (Token Text)
-> ParsecT Void Text Identity (Token Text)
-> ParsecT Void Text Identity [Token Text]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
manyTill ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle (ParsecT Void Text Identity (Token Text)
-> ParsecT Void Text Identity (Token Text)
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead ((Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy (\Token Text
c -> Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',' Bool -> Bool -> Bool
|| Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'}' Bool -> Bool -> Bool
|| Char
Token Text
c Char -> Char -> Bool
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])
    (WExp -> WExp -> WExp -> WExp)
-> Parser WExp -> ParsecT Void Text Identity (WExp -> WExp -> WExp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Parser ()
reserved Text
"if" Parser () -> Parser WExp -> Parser WExp
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser WExp
parseWExp)
    ParsecT Void Text Identity (WExp -> WExp -> WExp)
-> Parser WExp -> ParsecT Void Text Identity (WExp -> WExp)
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> Parser ()
reserved Text
"then" Parser () -> Parser WExp -> Parser WExp
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser WExp
parseWExp)
    ParsecT Void Text Identity (WExp -> WExp)
-> Parser WExp -> Parser WExp
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> Parser ()
reserved Text
"else" Parser () -> Parser WExp -> Parser WExp
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
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])
    (WExp -> WExp -> WExp -> WExp -> WExp)
-> Parser WExp
-> ParsecT Void Text Identity (WExp -> WExp -> WExp -> WExp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Parser ()
reserved Text
"perlin" Parser () -> Parser WExp -> Parser WExp
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser WExp
parseWExpAtom)
    ParsecT Void Text Identity (WExp -> WExp -> WExp -> WExp)
-> Parser WExp -> ParsecT Void Text Identity (WExp -> WExp -> WExp)
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser WExp
parseWExpAtom
    ParsecT Void Text Identity (WExp -> WExp -> WExp)
-> Parser WExp -> ParsecT Void Text Identity (WExp -> WExp)
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser WExp
parseWExpAtom
    ParsecT Void Text Identity (WExp -> WExp)
-> Parser WExp -> Parser WExp
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
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 ([WExp] -> WExp) -> (WExp -> [WExp]) -> WExp -> WExp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WExp -> [WExp] -> [WExp]
forall a. a -> [a] -> [a]
: []) (WExp -> WExp) -> Parser WExp -> Parser WExp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Parser ()
reserved Text
"abs" Parser () -> Parser WExp -> Parser WExp
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
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
    ([(Text, WExp)] -> WExp -> WExp)
-> ParsecT Void Text Identity [(Text, WExp)]
-> ParsecT Void Text Identity (WExp -> WExp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( Text -> Parser ()
reserved Text
"let"
            Parser ()
-> ParsecT Void Text Identity [(Text, WExp)]
-> ParsecT Void Text Identity [(Text, WExp)]
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (((,) (Text -> WExp -> (Text, WExp))
-> Parser Text -> ParsecT Void Text Identity (WExp -> (Text, WExp))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
identifier ParsecT Void Text Identity (WExp -> (Text, WExp))
-> Parser WExp -> ParsecT Void Text Identity (Text, WExp)
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> Parser Text
symbol Text
"=" Parser Text -> Parser WExp -> Parser WExp
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser WExp
parseWExp)) ParsecT Void Text Identity (Text, WExp)
-> Parser () -> ParsecT Void Text Identity [(Text, WExp)]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepBy` Parser ()
comma)
        )
    ParsecT Void Text Identity (WExp -> WExp)
-> Parser WExp -> Parser WExp
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> Parser ()
reserved Text
"in" Parser () -> Parser WExp -> Parser WExp
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
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"
  Parser WExp -> Parser WExp
forall a. Parser a -> Parser a
brackets (Parser WExp -> Parser WExp) -> Parser WExp -> Parser WExp
forall a b. (a -> b) -> a -> b
$ NonEmpty WExp -> WExp
WOverlay (NonEmpty WExp -> WExp)
-> ParsecT Void Text Identity (NonEmpty WExp) -> Parser WExp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser WExp
parseWExp Parser WExp
-> Parser () -> ParsecT Void Text Identity (NonEmpty WExp)
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
  WExp -> Parser WExp
forall a. a -> ParsecT Void Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (WExp -> Parser WExp) -> WExp -> Parser WExp
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 (Text -> WExp) -> ([Token Text] -> Text) -> [Token Text] -> WExp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall target source. From source target => source -> target
into @Text ([Token Text] -> WExp)
-> ParsecT Void Text Identity [Token Text] -> Parser WExp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
-> Parser Text
-> ParsecT Void Text Identity [Token Text]
-> ParsecT Void Text Identity [Token Text]
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
"\"") (ParsecT Void Text Identity (Token Text)
-> ParsecT Void Text Identity [Token Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ((Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy (Token Text -> Token Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
Token Text
'"')))

parseIMap :: Parser WExp
parseIMap :: Parser WExp
parseIMap = do
  Text -> Parser ()
reserved Text
"imap"
  WExp
wx <- Parser WExp
parseWExpAtom
  WExp
wy <- Parser WExp
parseWExpAtom
  WExp
wa <- Parser WExp
parseWExpAtom
  WExp -> Parser WExp
forall a. a -> ParsecT Void Text Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (WExp -> Parser WExp) -> WExp -> Parser WExp
forall a b. (a -> b) -> a -> b
$ Op -> [WExp] -> WExp
WOp Op
IMap [WExp
wx, WExp
wy, WExp
wa]

-- parseCat :: Parser WExp
-- parseCat =
--   WCat
--     <$> (X <$ reserved "hcat" <|> Y <$ reserved "vcat")
--     <*> brackets (parseWExp `sepBy` comma)

-- parseStruct :: Parser WExp
-- parseStruct = reserved "struct" *> fail "struct not implemented"

------------------------------------------------------------
-- Utility

runParser :: Parser a -> Text -> Either ParserError a
runParser :: forall a. Parser a -> Text -> Either ParserError a
runParser Parser a
p = Parser a -> [Char] -> Text -> Either ParserError a
forall e s a.
Parsec e s a -> [Char] -> s -> Either (ParseErrorBundle s e) a
parse (Parser () -> Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
fully Parser ()
sc Parser a
p) [Char]
""

------------------------------------------------------------
-- JSON instance

instance FromJSON WExp where
  parseJSON :: Value -> Parser WExp
parseJSON = [Char] -> (Text -> Parser WExp) -> Value -> Parser WExp
forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
"World DSL program" ((Text -> Parser WExp) -> Value -> Parser WExp)
-> (Text -> Parser WExp) -> Value -> Parser WExp
forall a b. (a -> b) -> a -> b
$ \Text
t ->
    case Parser WExp -> Text -> Either ParserError WExp
forall a. Parser a -> Text -> Either ParserError a
runParser Parser WExp
parseWExp Text
t of
      Left ParserError
err -> [Char] -> Parser WExp
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail (ParserError -> [Char]
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> [Char]
errorBundlePretty ParserError
err)
      Right WExp
wexp -> WExp -> Parser WExp
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return WExp
wexp