{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}

-- |
--
-- /Commentary/
--
-- We're optimizing for simplicity here. The language balances conventions
-- from other languages with choices to not overcomplicate things. Not
-- overloading operators, for example. Mostly we want to have "good error
-- messages" which is tough and subjective anyway. Not having multiline
-- anything, for example, might be a good choice, except that we also want to
-- be whitepsace insensitive.
module Technique.Parser
  ( -- parser for technique procedure files.
    pTechnique,
    -- everthing else is only exposed for testing purposes.
    pMagicLine,
    pSpdxLine,
    pIdentifier,
    pType,
    stringLiteral,
    numberLiteral,
    pQuantity,
    pAttribute,
    pExpression,
    pStatement,
    pBlock,
    pProcedureDeclaration,
    pProcedureCode,
  )
where

import Control.Monad
  ( unless,
    void,
  )
import Control.Monad.Combinators
  ( (<|>),
    many,
    optional,
    sepBy,
    sepBy1,
    some,
  )
import Core.Text.Rope
  ( Rope,
    appendRope,
    emptyRope,
    intoRope,
    singletonRope,
  )
import Data.Foldable
  ( foldl',
  )
import Data.Int
  ( Int64,
    Int8,
  )
import Data.Text
  ( Text,
  )
import qualified Data.Text as T (pack)
import Data.Void
  ( Void,
  )
import Technique.Language
import Technique.Quantity
import Text.Megaparsec
  ( (<?>),
    Parsec,
    getOffset,
    hidden,
    label,
    lookAhead,
    notFollowedBy,
    oneOf,
    skipMany,
    takeWhile1P,
    takeWhileP,
    try,
  )
import Text.Megaparsec.Char
  ( char,
    digitChar,
    lowerChar,
    newline,
    printChar,
    space,
    spaceChar,
    string,
    upperChar,
  )
import Text.Read
  ( readMaybe,
  )

type Parser = Parsec Void Text

__VERSION__ :: Int
__VERSION__ :: Int
__VERSION__ = Int
0

-- |
-- Skip /zero/ or more actual space characters. The __megaparsec__ function
-- @space@ etc consume all whitespace, not just ' '. That includes newlines,
-- which is very unhelpful.
skipSpace :: Parser ()
skipSpace :: Parser ()
skipSpace = ParsecT Void Text Identity [Char] -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity [Char]
-> ParsecT Void Text Identity [Char]
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden (ParsecT Void Text Identity Char
-> ParsecT Void Text Identity [Char]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (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
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
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
'\t')))

-- |
-- Skip at least /one/ actual space character.
skipSpace1 :: Parser ()
skipSpace1 :: Parser ()
skipSpace1 = ParsecT Void Text Identity [Char] -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity [Char]
-> ParsecT Void Text Identity [Char]
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden (ParsecT Void Text Identity Char
-> ParsecT Void Text Identity [Char]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (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
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
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
'\t')))

digitChar0 :: Parser Char
digitChar0 :: ParsecT Void Text Identity Char
digitChar0 = [Char]
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"a digit" (ParsecT Void Text Identity Char
 -> ParsecT Void Text Identity Char)
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar

pMagicLine :: Parser Int
pMagicLine :: Parser Int
pMagicLine = do
  ParsecT Void Text Identity Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (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 ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"first line to begin with % character"
  ParsecT Void Text Identity Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
spaceChar Parser () -> [Char] -> Parser ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"a space character"
  ParsecT Void Text Identity Text -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"technique")
  ParsecT Void Text Identity Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
spaceChar Parser () -> [Char] -> Parser ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"a space character"
  ParsecT Void Text Identity Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (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
'v') Parser () -> [Char] -> Parser ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"the character 'v' and then a number"
  Int64
v <- Parser Int64
numberLiteral Parser Int64 -> [Char] -> Parser Int64
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"the language version"
  ParsecT Void Text Identity Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline
  Int -> Parser Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
v)

pSpdxLine :: Parser (Rope, Maybe Rope)
pSpdxLine :: Parser (Rope, Maybe Rope)
pSpdxLine = do
  ParsecT Void Text Identity Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (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 ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"second line to begin with ! character"
  Parser ()
skipSpace

  -- I know we're supposed to use takeWhile1P in cases like this, but aren't
  -- we just duplicating the work of the parser combinators?
  Text
license <-
    Maybe [Char]
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P
      ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"software license description (ie an SPDX-Licence-Header value)")
      (\Token Text
c -> Bool -> Bool
not (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
'\n'))

  Maybe Text
copyright <- ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void Text Identity Text
 -> ParsecT Void Text Identity (Maybe Text))
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    ParsecT Void Text Identity Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (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 ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"a semicolon"
    Parser ()
skipSpace
    ParsecT Void Text Identity Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (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 () -> Parser () -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity Text -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"(c)")
    Parser ()
skipSpace
    Maybe [Char]
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"a copyright declaration") (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n')
  ParsecT Void Text Identity Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline
  (Rope, Maybe Rope) -> Parser (Rope, Maybe Rope)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Rope
forall α. Textual α => α -> Rope
intoRope Text
license, (Text -> Rope) -> Maybe Text -> Maybe Rope
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Rope
forall α. Textual α => α -> Rope
intoRope Maybe Text
copyright)

---------------------------------------------------------------------

pProcedureDeclaration :: Parser (Identifier, [Identifier], [Type], [Type])
pProcedureDeclaration :: Parser (Identifier, [Identifier], [Type], [Type])
pProcedureDeclaration = do
  Identifier
name <- Parser Identifier
pIdentifier
  Parser ()
skipSpace
  -- zero or more separated by comma
  [Identifier]
params <- Parser [Identifier]
pIdentifiers

  Parser ()
skipSpace
  ParsecT Void Text Identity Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (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 ()
skipSpace

  [Type]
ins <- Parser [Type]
pTypes1

  Parser ()
skipSpace
  ParsecT Void Text Identity Text -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"->")
  Parser ()
skipSpace

  [Type]
out <- Parser [Type]
pTypes1
  (Identifier, [Identifier], [Type], [Type])
-> Parser (Identifier, [Identifier], [Type], [Type])
forall (m :: * -> *) a. Monad m => a -> m a
return (Identifier
name, [Identifier]
params, [Type]
ins, [Type]
out)

identifierChar :: Parser Char
identifierChar :: ParsecT Void Text Identity Char
identifierChar = ParsecT Void Text Identity Char -> ParsecT Void Text Identity Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden (ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
lowerChar ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity Char
digitChar0 ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
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
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
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
'\'')

-- these do NOT consume trailing space. That's for pExpression to do.
pIdentifier :: Parser Identifier
pIdentifier :: Parser Identifier
pIdentifier = [Char] -> Parser Identifier -> Parser Identifier
forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"a valid identifier" (Parser Identifier -> Parser Identifier)
-> Parser Identifier -> Parser Identifier
forall a b. (a -> b) -> a -> b
$ do
  Char
first <- ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
lowerChar
  [Char]
remainder <- ParsecT Void Text Identity Char
-> ParsecT Void Text Identity [Char]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT Void Text Identity Char
identifierChar
  Identifier -> Parser Identifier
forall (m :: * -> *) a. Monad m => a -> m a
return (Rope -> Identifier
Identifier (Char -> Rope
singletonRope Char
first Rope -> Rope -> Rope
forall a. Semigroup a => a -> a -> a
<> [Char] -> Rope
forall α. Textual α => α -> Rope
intoRope [Char]
remainder))

pIdentifiers :: Parser [Identifier]
pIdentifiers :: Parser [Identifier]
pIdentifiers = Parser Identifier
-> ParsecT Void Text Identity Char -> Parser [Identifier]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy (Parser Identifier
pIdentifier Parser Identifier -> Parser () -> Parser Identifier
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipSpace) (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
-> Parser () -> ParsecT Void Text Identity Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipSpace)

pIdentifiers1 :: Parser [Identifier]
pIdentifiers1 :: Parser [Identifier]
pIdentifiers1 = Parser Identifier
-> ParsecT Void Text Identity Char -> Parser [Identifier]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy1 (Parser Identifier
pIdentifier Parser Identifier -> Parser () -> Parser Identifier
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipSpace) (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
-> Parser () -> ParsecT Void Text Identity Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipSpace)

typeChar :: Parser Char
typeChar :: ParsecT Void Text Identity Char
typeChar = ParsecT Void Text Identity Char -> ParsecT Void Text Identity Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden (ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
upperChar ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
lowerChar ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity Char
digitChar0)

pType :: Parser Type
pType :: Parser Type
pType =
  [Char] -> Parser Type -> Parser Type
forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"a valid type" (Parser Type -> Parser Type) -> Parser Type -> Parser Type
forall a b. (a -> b) -> a -> b
$
    Parser Type -> Parser Type
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try
      ( do
          ParsecT Void Text Identity Text -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"()")
          Type -> Parser Type
forall (m :: * -> *) a. Monad m => a -> m a
return (Rope -> Type
Type Rope
"()")
      )
      Parser Type -> Parser Type -> Parser Type
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ( do
              Char
first <- ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
upperChar
              [Char]
remainder <- ParsecT Void Text Identity Char
-> ParsecT Void Text Identity [Char]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT Void Text Identity Char
typeChar
              Type -> Parser Type
forall (m :: * -> *) a. Monad m => a -> m a
return (Rope -> Type
Type (Char -> Rope
singletonRope Char
first Rope -> Rope -> Rope
forall a. Semigroup a => a -> a -> a
<> [Char] -> Rope
forall α. Textual α => α -> Rope
intoRope [Char]
remainder))
          )

pTypes1 :: Parser [Type]
pTypes1 :: Parser [Type]
pTypes1 = Parser Type -> ParsecT Void Text Identity Char -> Parser [Type]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy1 (Parser Type
pType Parser Type -> Parser () -> Parser Type
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipSpace) (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
-> Parser () -> ParsecT Void Text Identity Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipSpace)

---------------------------------------------------------------------

stringLiteral :: Parser Text
stringLiteral :: ParsecT Void Text Identity Text
stringLiteral = [Char]
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"a string literal" (ParsecT Void Text Identity Text
 -> ParsecT Void Text Identity Text)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a b. (a -> b) -> a -> b
$ do
  ParsecT Void Text Identity Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (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
'\"')
  [Char]
str <-
    ParsecT Void Text Identity Char
-> ParsecT Void Text Identity [Char]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many
      ( do
          ParsecT Void Text Identity Char -> ParsecT Void Text Identity Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try
            ( do
                ParsecT Void Text Identity Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (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 -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (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
'"')
                Char -> ParsecT Void Text Identity Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'"'
            )
          ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ( do
                  ParsecT Void Text Identity Char -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy (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
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
printChar
              )
      )
  ParsecT Void Text Identity Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (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
'\"')
  Text -> ParsecT Void Text Identity Text
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Text
T.pack [Char]
str)

unitChar :: Parser Char
unitChar :: ParsecT Void Text Identity Char
unitChar = ParsecT Void Text Identity Char -> ParsecT Void Text Identity Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden (ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
upperChar ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
lowerChar ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
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
'°')

unitLiteral :: Parser Rope
unitLiteral :: Parser Rope
unitLiteral = [Char] -> Parser Rope -> Parser Rope
forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"a units symbol" (Parser Rope -> Parser Rope) -> Parser Rope -> Parser Rope
forall a b. (a -> b) -> a -> b
$ do
  [Char]
str <- ParsecT Void Text Identity Char
-> ParsecT Void Text Identity [Char]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT Void Text Identity Char
unitChar
  Rope -> Parser Rope
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Rope
forall α. Textual α => α -> Rope
intoRope [Char]
str)

numberLiteral :: Parser Int64
numberLiteral :: Parser Int64
numberLiteral = [Char] -> Parser Int64 -> Parser Int64
forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"a number literal" (Parser Int64 -> Parser Int64) -> Parser Int64 -> Parser Int64
forall a b. (a -> b) -> a -> b
$ do
  [Char]
digits <- ParsecT Void Text Identity Char
-> ParsecT Void Text Identity [Char]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT Void Text Identity Char
digitChar0
  let result :: Maybe Int64
result = [Char] -> Maybe Int64
forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
digits
  case Maybe Int64
result of
    Just Int64
number -> Int64 -> Parser Int64
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
number
    Maybe Int64
Nothing -> [Char] -> Parser Int64
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"expected a number but couldn't parse"

decimalLiteral :: Parser Decimal
decimalLiteral :: Parser Decimal
decimalLiteral = [Char] -> Parser Decimal -> Parser Decimal
forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"a decimal literal" (Parser Decimal -> Parser Decimal)
-> Parser Decimal -> Parser Decimal
forall a b. (a -> b) -> a -> b
$ do
  [Char]
digits1 <- ParsecT Void Text Identity Char
-> ParsecT Void Text Identity [Char]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT Void Text Identity Char
digitChar0
  Maybe [Char]
fraction <-
    ParsecT Void Text Identity [Char]
-> ParsecT Void Text Identity (Maybe [Char])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
      ( do
          ParsecT Void Text Identity Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (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
-> ParsecT Void Text Identity [Char]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT Void Text Identity Char
digitChar0
      )

  Decimal -> Parser Decimal
forall (m :: * -> *) a. Monad m => a -> m a
return
    ( case Maybe [Char]
fraction of
        Maybe [Char]
Nothing ->
          let number :: Int64
number = [Char] -> Int64
forall a. Read a => [Char] -> a
read [Char]
digits1
           in Int64 -> Int8 -> Decimal
Decimal Int64
number Int8
0
        Just [Char]
digits2 ->
          let e :: Int8
e = Int -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Char] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
digits2)
              decimal :: Int64
decimal = [Char] -> Int64
forall a. Read a => [Char] -> a
read [Char]
digits1 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
10 Int64 -> Int8 -> Int64
forall a b. (Num a, Integral b) => a -> b -> a
^ Int8
e Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ [Char] -> Int64
forall a. Read a => [Char] -> a
read [Char]
digits2
           in Int64 -> Int8 -> Decimal
Decimal Int64
decimal Int8
e
    )

superscriptLiteral :: Parser Int8
superscriptLiteral :: Parser Int8
superscriptLiteral = [Char] -> Parser Int8 -> Parser Int8
forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"a superscript literal" (Parser Int8 -> Parser Int8) -> Parser Int8 -> Parser Int8
forall a b. (a -> b) -> a -> b
$ do
  Maybe Char
sign <- ParsecT Void Text Identity Char
-> ParsecT Void Text Identity (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (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
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
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
'¯') -- honestly not sure what the second of those is
  [Char]
digits <- ParsecT Void Text Identity Char
-> ParsecT Void Text Identity [Char]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ([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
'⁰', Char
'¹', Char
'²', Char
'³', Char
'⁴', Char
'⁵', Char
'⁶', Char
'⁷', Char
'⁸', Char
'⁹'])
  let number :: Int8
number = [Char] -> Int8
forall a. Read a => [Char] -> a
read ((Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toNumbers [Char]
digits)
  Int8 -> Parser Int8
forall (m :: * -> *) a. Monad m => a -> m a
return
    ( case Maybe Char
sign of
        Just Char
_ -> Int8 -> Int8
forall a. Num a => a -> a
negate Int8
number
        Maybe Char
Nothing -> Int8
number
    )

toNumbers :: Char -> Char
toNumbers :: Char -> Char
toNumbers Char
c = case Char
c of
  Char
'⁰' -> Char
'0'
  Char
'¹' -> Char
'1'
  Char
'²' -> Char
'2'
  Char
'³' -> Char
'3'
  Char
'⁴' -> Char
'4'
  Char
'⁵' -> Char
'5'
  Char
'⁶' -> Char
'6'
  Char
'⁷' -> Char
'7'
  Char
'⁸' -> Char
'8'
  Char
'⁹' -> Char
'9'
  Char
_ -> [Char] -> Char
forall a. HasCallStack => [Char] -> a
error [Char]
"Invalid, superscript expected"

pQuantity :: Parser Quantity
pQuantity :: Parser Quantity
pQuantity =
  ( do
      -- look ahead far enough to commit to this branch:  the pieces of a
      -- decimal, a space, and then one of the characters that starts an
      -- uncertainty, magnitude, or symbol.
      Parser () -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead
        ( Parser () -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try
            ( do
                ParsecT Void Text Identity Char -> Parser ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany (ParsecT Void Text Identity Char
digitChar0 ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
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
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
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
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
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 -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (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
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
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
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
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
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
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
'x' ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity Char
unitChar)
            )
        )

      Decimal
n <- Parser Decimal
pMantissa
      Decimal
u <- Parser Decimal
pUncertainty Parser Decimal -> Parser Decimal -> Parser Decimal
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Decimal -> Parser Decimal
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int64 -> Int8 -> Decimal
Decimal Int64
0 Int8
0)
      Int8
m <- Parser Int8
pMagnitude Parser Int8 -> Parser Int8 -> Parser Int8
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int8 -> Parser Int8
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int8
0
      Rope
s <- Parser Rope
pSymbol
      Quantity -> Parser Quantity
forall (m :: * -> *) a. Monad m => a -> m a
return (Decimal -> Decimal -> Int8 -> Rope -> Quantity
Quantity Decimal
n Decimal
u Int8
m Rope
s)
  )
    Parser Quantity -> Parser Quantity -> Parser Quantity
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ( do
            Int64
n <- Parser Int64
pNumber
            Quantity -> Parser Quantity
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> Quantity
Number Int64
n)
        )
  where
    pNumber :: Parser Int64
pNumber = do
      Maybe Char
sign <- ParsecT Void Text Identity Char
-> ParsecT Void Text Identity (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (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
'-')
      Int64
number <- Parser Int64
numberLiteral
      Int64 -> Parser Int64
forall (m :: * -> *) a. Monad m => a -> m a
return
        ( case Maybe Char
sign of
            Just Char
_ -> Int64 -> Int64
forall a. Num a => a -> a
negate Int64
number
            Maybe Char
Nothing -> Int64
number
        )
    pMantissa :: Parser Decimal
pMantissa = do
      Maybe Char
sign <- ParsecT Void Text Identity Char
-> ParsecT Void Text Identity (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (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
'-')
      Decimal
decimal <- Parser Decimal -> Parser Decimal
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser Decimal
decimalLiteral
      Parser ()
skipSpace
      Decimal -> Parser Decimal
forall (m :: * -> *) a. Monad m => a -> m a
return
        ( case Maybe Char
sign of
            Just Char
_ -> Decimal -> Decimal
negateDecimal Decimal
decimal
            Maybe Char
Nothing -> Decimal
decimal
        )
    pUncertainty :: Parser Decimal
pUncertainty = do
      ParsecT Void Text Identity Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (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 () -> Parser () -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity Text -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"+/-")
      Parser ()
skipSpace
      Decimal
decimal <- Parser Decimal
decimalLiteral
      Parser ()
skipSpace
      Decimal -> Parser Decimal
forall (m :: * -> *) a. Monad m => a -> m a
return Decimal
decimal
    pMagnitude :: Parser Int8
pMagnitude = do
      ParsecT Void Text Identity Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (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 () -> Parser () -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (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
'x') Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser () -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden (ParsecT Void Text Identity Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (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 ()
skipSpace
      ParsecT Void Text Identity Text -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"10")
      Int8
number <-
        ( do
            ParsecT Void Text Identity Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (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
'^')
            Maybe Char
sign <- ParsecT Void Text Identity Char
-> ParsecT Void Text Identity (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (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
'-')
            Int64
e <- Parser Int64
numberLiteral
            Int8 -> Parser Int8
forall (f :: * -> *) a. Applicative f => a -> f a
pure
              ( Int64 -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral
                  ( case Maybe Char
sign of
                      Just Char
_ -> Int64 -> Int64
forall a. Num a => a -> a
negate Int64
e
                      Maybe Char
Nothing -> Int64
e
                  )
              )
            Parser Int8 -> Parser Int8 -> Parser Int8
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Int8
superscriptLiteral
          )
      Parser ()
skipSpace
      Int8 -> Parser Int8
forall (m :: * -> *) a. Monad m => a -> m a
return Int8
number
    pSymbol :: Parser Rope
pSymbol = do
      Rope
symbol <- Parser Rope
unitLiteral
      Parser ()
skipSpace
      Rope -> Parser Rope
forall (m :: * -> *) a. Monad m => a -> m a
return Rope
symbol

pOperator :: Parser Operator
pOperator :: Parser Operator
pOperator =
  (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
-> Parser Operator -> Parser Operator
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Operator -> Parser Operator
forall (m :: * -> *) a. Monad m => a -> m a
return Operator
WaitBoth)
    Parser Operator -> Parser Operator -> Parser Operator
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
-> Parser Operator -> Parser Operator
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Operator -> Parser Operator
forall (m :: * -> *) a. Monad m => a -> m a
return Operator
WaitEither)
    Parser Operator -> Parser Operator -> Parser Operator
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
-> Parser Operator -> Parser Operator
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Operator -> Parser Operator
forall (m :: * -> *) a. Monad m => a -> m a
return Operator
Combine)

-- |
-- Parse a Tablet. This consumes trailing space around initial delimiter and
-- removes blank lines within the table (they're not syntactically meaningful)
-- but only cosnsumes a single newline after trailing delimeter, leaving
-- further consumption to pStatement.
--
-- TODO this doesn't preserve alternate syntax if employed by user
pTablet :: Parser Tablet
pTablet :: Parser Tablet
pTablet = do
  ParsecT Void Text Identity Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (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
-> Parser () -> ParsecT Void Text Identity Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser () -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space)

  [Binding]
bindings <-
    ParsecT Void Text Identity Binding
-> ParsecT Void Text Identity [Binding]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many
      (ParsecT Void Text Identity Binding
pBinding ParsecT Void Text Identity Binding
-> Parser () -> ParsecT Void Text Identity Binding
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser () -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space)

  ParsecT Void Text Identity Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (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
-> Parser () -> ParsecT Void Text Identity Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipSpace)

  Tablet -> Parser Tablet
forall (m :: * -> *) a. Monad m => a -> m a
return ([Binding] -> Tablet
Tablet [Binding]
bindings)
  where
    pBinding :: ParsecT Void Text Identity Binding
pBinding = do
      Text
name <- ParsecT Void Text Identity Text
stringLiteral
      Parser ()
skipSpace
      ParsecT Void Text Identity Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (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 ()
skipSpace
      Expression
subexpr <- Parser Expression
pExpression

      -- handle alternate syntax here
      {-
              -- FIXME this is not working
              void (optional (char ','))
      -}
      Binding -> ParsecT Void Text Identity Binding
forall (m :: * -> *) a. Monad m => a -> m a
return (Label -> Expression -> Binding
Binding (Rope -> Label
Label (Text -> Rope
forall α. Textual α => α -> Rope
intoRope Text
name)) Expression
subexpr)

pAttribute :: Parser Attribute
pAttribute :: Parser Attribute
pAttribute =
  ( do
      ParsecT Void Text Identity Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (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
'@')
      Identifier
role <- Parser Identifier
pIdentifier Parser Identifier -> Parser Identifier -> Parser Identifier
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Identifier
pAny
      Attribute -> Parser Attribute
forall (m :: * -> *) a. Monad m => a -> m a
return (Identifier -> Attribute
Role Identifier
role)
  )
    Parser Attribute -> Parser Attribute -> Parser Attribute
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ( do
            ParsecT Void Text Identity Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (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
'#')
            Identifier
place <- Parser Identifier
pIdentifier Parser Identifier -> Parser Identifier -> Parser Identifier
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Identifier
pAny
            Attribute -> Parser Attribute
forall (m :: * -> *) a. Monad m => a -> m a
return (Identifier -> Attribute
Place Identifier
place)
        )
  where
    pAny :: Parser Identifier
pAny = do
      ParsecT Void Text Identity Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (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
'*')
      Identifier -> Parser Identifier
forall (m :: * -> *) a. Monad m => a -> m a
return (Rope -> Identifier
Identifier (Char -> Rope
singletonRope Char
'*'))

pExpression :: Parser Expression
pExpression :: Parser Expression
pExpression = do
  Int
o <- Parser Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
  Expression
expr1 <- Int -> Parser Expression
pTerm Int
o
  Parser ()
skipSpace
  Maybe (Operator, Expression)
rest <- (ParsecT Void Text Identity (Operator, Expression)
-> ParsecT Void Text Identity (Maybe (Operator, Expression))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void Text Identity (Operator, Expression)
-> ParsecT Void Text Identity (Operator, Expression)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity (Operator, Expression)
pOperation2))
  Parser ()
skipSpace
  case Maybe (Operator, Expression)
rest of
    Just (Operator
oper, Expression
expr2) -> Expression -> Parser Expression
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Operator -> Expression -> Expression -> Expression
Operation Int
o Operator
oper Expression
expr1 Expression
expr2)
    Maybe (Operator, Expression)
Nothing -> Expression -> Parser Expression
forall (m :: * -> *) a. Monad m => a -> m a
return Expression
expr1
  where
    pTerm :: Int -> Parser Expression
pTerm Int
o =
      Int -> Parser Expression
pNone Int
o
        Parser Expression -> Parser Expression -> Parser Expression
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Parser Expression
forall (m :: * -> *) e s.
(MonadParsec e s m, Token s ~ Char) =>
Int -> m Expression
pUndefined Int
o
        Parser Expression -> Parser Expression -> Parser Expression
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Parser Expression
pRestriction Int
o
        Parser Expression -> Parser Expression -> Parser Expression
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Parser Expression
pGrouping Int
o
        Parser Expression -> Parser Expression -> Parser Expression
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Parser Expression
pObject Int
o
        Parser Expression -> Parser Expression -> Parser Expression
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Parser Expression
pApplication Int
o
        Parser Expression -> Parser Expression -> Parser Expression
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Parser Expression
pLiteral Int
o
        Parser Expression -> Parser Expression -> Parser Expression
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Parser Expression
pVariable Int
o
    pNone :: Offset -> Parser Expression
    pNone :: Int -> Parser Expression
pNone Int
o = do
      ParsecT Void Text Identity Text -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"()")
      Expression -> Parser Expression
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Expression
None Int
o)
    pUndefined :: Int -> m Expression
pUndefined Int
o = do
      m Char -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Token s -> m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token s
'?')
      Expression -> m Expression
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Expression
Undefined Int
o)
    pOperation2 :: ParsecT Void Text Identity (Operator, Expression)
pOperation2 = do
      -- 2 as in 2nd half
      Operator
operator <- Parser Operator
pOperator
      Parser ()
skipSpace
      Expression
subexpr2 <- Parser Expression
pExpression
      (Operator, Expression)
-> ParsecT Void Text Identity (Operator, Expression)
forall (m :: * -> *) a. Monad m => a -> m a
return (Operator
operator, Expression
subexpr2)
    pRestriction :: Int -> Parser Expression
pRestriction Int
o = do
      Attribute
attr <- Parser Attribute
pAttribute
      Parser () -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
      Block
block <- Parser Block
pBlock
      Expression -> Parser Expression
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Attribute -> Block -> Expression
Restriction Int
o Attribute
attr Block
block)
    pGrouping :: Int -> Parser Expression
pGrouping Int
o = do
      ParsecT Void Text Identity Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (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 ()
skipSpace

      Expression
subexpr <- Parser Expression
pExpression

      ParsecT Void Text Identity Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (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 ()
skipSpace

      Expression -> Parser Expression
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Expression -> Expression
Grouping Int
o Expression
subexpr)
    pObject :: Int -> Parser Expression
pObject Int
o = do
      Tablet
tablet <- Parser Tablet
pTablet
      Expression -> Parser Expression
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Tablet -> Expression
Object Int
o Tablet
tablet)
    pApplication :: Int -> Parser Expression
pApplication Int
o = do
      Parser () -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead
        ( Parser () -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try
            ( do
                ParsecT Void Text Identity Char -> Parser ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT Void Text Identity Char
identifierChar
                Parser ()
skipSpace1
                ParsecT Void Text Identity Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity Char
identifierChar ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity Char
digitChar0 ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
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
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
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
'\"')
            )
        )

      Identifier
name <- Parser Identifier
pIdentifier
      -- ie at least one space
      Parser ()
skipSpace1
      -- FIXME better do this manually, not all valid
      Expression
subexpr <- Parser Expression
pExpression
      Expression -> Parser Expression
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Identifier -> Expression -> Expression
Application Int
o Identifier
name Expression
subexpr)
    pLiteral :: Int -> Parser Expression
pLiteral Int
o =
      ( do
          Text
str <- ParsecT Void Text Identity Text
stringLiteral
          Expression -> Parser Expression
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Rope -> Expression
Text Int
o (Text -> Rope
forall α. Textual α => α -> Rope
intoRope Text
str))
      )
        Parser Expression -> Parser Expression -> Parser Expression
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ( do
                Quantity
qty <- Parser Quantity
pQuantity
                Expression -> Parser Expression
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Quantity -> Expression
Amount Int
o Quantity
qty)
            )
    pVariable :: Int -> Parser Expression
pVariable Int
o = do
      [Identifier]
names <- Parser [Identifier]
pIdentifiers1

      Expression -> Parser Expression
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> [Identifier] -> Expression
Variable Int
o [Identifier]
names)

pStatement :: Parser Statement
pStatement :: Parser Statement
pStatement = do
  Int
o <- Parser Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
  Statement
statement <-
    Int -> Parser Statement
pAssignment Int
o
      Parser Statement -> Parser Statement -> Parser Statement
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Parser Statement
pDeclaration Int
o
      Parser Statement -> Parser Statement -> Parser Statement
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Parser Statement
pExecute Int
o
      Parser Statement -> Parser Statement -> Parser Statement
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Parser Statement
forall (m :: * -> *) e s.
(MonadParsec e s m, Token s ~ Char) =>
Int -> m Statement
pBlank Int
o
      Parser Statement -> Parser Statement -> Parser Statement
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Parser Statement
forall (m :: * -> *) e s.
(MonadParsec e s m, Token s ~ Char) =>
Int -> m Statement
pSeries Int
o
  Statement -> Parser Statement
forall (m :: * -> *) a. Monad m => a -> m a
return Statement
statement
  where
    pAssignment :: Int -> Parser Statement
pAssignment Int
o = [Char] -> Parser Statement -> Parser Statement
forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"an assignment" (Parser Statement -> Parser Statement)
-> Parser Statement -> Parser Statement
forall a b. (a -> b) -> a -> b
$ do
      Parser () -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead
        ( Parser () -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try
            ( do
                ParsecT Void Text Identity Char -> Parser ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany (ParsecT Void Text Identity Char
identifierChar ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
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
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
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 -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (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
'=')
            )
        )
      [Identifier]
names <- Parser [Identifier]
pIdentifiers1
      Parser ()
skipSpace
      ParsecT Void Text Identity Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (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 () -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
      Expression
expr <- Parser Expression
pExpression
      Statement -> Parser Statement
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> [Identifier] -> Expression -> Statement
Assignment Int
o [Identifier]
names Expression
expr)
    pDeclaration :: Int -> Parser Statement
pDeclaration Int
o = [Char] -> Parser Statement -> Parser Statement
forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"a declaration" (Parser Statement -> Parser Statement)
-> Parser Statement -> Parser Statement
forall a b. (a -> b) -> a -> b
$ do
      Parser () -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead
        ( Parser () -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try
            ( do
                ParsecT Void Text Identity Char -> Parser ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany (ParsecT Void Text Identity Char
identifierChar ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
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
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
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 -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (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
':')
            )
        )

      Procedure
proc <- Parser Procedure
pProcedureCode
      Statement -> Parser Statement
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Procedure -> Statement
Declaration Int
o Procedure
proc)
    pExecute :: Int -> Parser Statement
pExecute Int
o = [Char] -> Parser Statement -> Parser Statement
forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"a value to execute" (Parser Statement -> Parser Statement)
-> Parser Statement -> Parser Statement
forall a b. (a -> b) -> a -> b
$ do
      Expression
expr <- Parser Expression
pExpression
      Statement -> Parser Statement
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Expression -> Statement
Execute Int
o Expression
expr)
    pBlank :: Int -> m Statement
pBlank Int
o = m Statement -> m Statement
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden (m Statement -> m Statement) -> m Statement -> m Statement
forall a b. (a -> b) -> a -> b
$ do
      -- label "a blank line"
      m Char -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void m Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline
      Statement -> m Statement
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Statement
Blank Int
o)
    pSeries :: Int -> m Statement
pSeries Int
o = do
      m Char -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Token s -> m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token s
';')
      Statement -> m Statement
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Statement
Series Int
o)

---------------------------------------------------------------------

pBlock :: Parser Block
pBlock :: Parser Block
pBlock = do
  -- open block, absorb whitespace
  ParsecT Void Text Identity Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (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
-> Parser () -> ParsecT Void Text Identity Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser () -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space)

  -- process statements, but only single newline at a time
  [Statement]
statements <-
    Parser Statement -> ParsecT Void Text Identity [Statement]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many
      (Parser Statement
pStatement Parser Statement -> Parser () -> Parser Statement
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipSpace Parser Statement
-> ParsecT Void Text Identity (Maybe Char) -> Parser Statement
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity Char
-> ParsecT Void Text Identity (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline Parser Statement -> Parser () -> Parser Statement
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipSpace)

  -- close block, and wipe out any trailing whitespace
  ParsecT Void Text Identity Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (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
-> Parser () -> ParsecT Void Text Identity Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipSpace ParsecT Void Text Identity Char
-> ParsecT Void Text Identity (Maybe Char)
-> ParsecT Void Text Identity Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity Char
-> ParsecT Void Text Identity (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline)

  Block -> Parser Block
forall (m :: * -> *) a. Monad m => a -> m a
return ([Statement] -> Block
Block [Statement]
statements)

-- Frankly, this parser looks ridiculous. Someone who knows what they are
-- doing *please* help refactor this. It seems unavoidlable to run the
-- pProcedureDeclaration parser twice, unless we can combine the successful
-- parse and the consumtion of description lines into one function. Maybe
-- this would be better done scanning ahead to count characters until a
-- declaration shows up, then explicitly taking that many?

fourSpaces :: Parser ()
fourSpaces :: Parser ()
fourSpaces =
  -- label "a code block indented by four spaces" $
  ParsecT Void Text Identity Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (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
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> 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
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> 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
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> 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 () -> Parser () -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Parser ()
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"code blocks must be indented by four spaces"

pMarkdown :: Parser Markdown
pMarkdown :: Parser Markdown
pMarkdown = do
  -- gobble blank newlines before a heading
  ParsecT Void Text Identity [()] -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
    ( Parser () -> ParsecT Void Text Identity [()]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many
        ( do
            Parser () -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy Parser ()
fourSpaces
            Parser (Identifier, [Identifier], [Type], [Type]) -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy Parser (Identifier, [Identifier], [Type], [Type])
pProcedureDeclaration
            ParsecT Void Text Identity Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser ()
skipSpace Parser ()
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Char -> ParsecT Void Text Identity Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline)
        )
    )

  -- TODO heading

  [Text]
results <-
    ParsecT Void Text Identity Text
-> ParsecT Void Text Identity [Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some
      ( do
          Parser () -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy Parser ()
fourSpaces
          Parser (Identifier, [Identifier], [Type], [Type]) -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy Parser (Identifier, [Identifier], [Type], [Type])
pProcedureDeclaration
          Text
line <- Maybe [Char]
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhileP ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"another line of description text") (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n')
          ParsecT Void Text Identity Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity Char -> ParsecT Void Text Identity Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline)
          Text -> ParsecT Void Text Identity Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
line
      )

  let description :: Rope
description = (Rope -> Text -> Rope) -> Rope -> [Text] -> Rope
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Rope
acc Text
text -> Text -> Rope -> Rope
forall α. Textual α => α -> Rope -> Rope
appendRope Text
text Rope
acc Rope -> Rope -> Rope
forall a. Semigroup a => a -> a -> a
<> Rope
"\n") Rope
emptyRope [Text]
results
  Markdown -> Parser Markdown
forall (m :: * -> *) a. Monad m => a -> m a
return (Rope -> Markdown
Markdown Rope
description)

pProcedureCode :: Parser Procedure
pProcedureCode :: Parser Procedure
pProcedureCode = do
  Int
o <- Parser Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
  (Identifier
name, [Identifier]
params, [Type]
ins, [Type]
out) <- Parser (Identifier, [Identifier], [Type], [Type])
pProcedureDeclaration Parser (Identifier, [Identifier], [Type], [Type])
-> Parser () -> Parser (Identifier, [Identifier], [Type], [Type])
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipSpace Parser (Identifier, [Identifier], [Type], [Type])
-> ParsecT Void Text Identity (Maybe Char)
-> Parser (Identifier, [Identifier], [Type], [Type])
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity Char
-> ParsecT Void Text Identity (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline Parser (Identifier, [Identifier], [Type], [Type])
-> Parser () -> Parser (Identifier, [Identifier], [Type], [Type])
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipSpace

  Block
block <- Parser Block
pBlock Parser Block -> Parser () -> Parser Block
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipSpace Parser Block
-> ParsecT Void Text Identity (Maybe Char) -> Parser Block
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity Char
-> ParsecT Void Text Identity (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline

  Procedure -> Parser Procedure
forall (m :: * -> *) a. Monad m => a -> m a
return
    ( Procedure :: Int
-> Identifier
-> [Identifier]
-> [Type]
-> [Type]
-> Maybe Markdown
-> Maybe Markdown
-> Block
-> Procedure
Procedure
        { procedureOffset :: Int
procedureOffset = Int
o,
          procedureName :: Identifier
procedureName = Identifier
name,
          procedureParams :: [Identifier]
procedureParams = [Identifier]
params,
          procedureInput :: [Type]
procedureInput = [Type]
ins,
          procedureOutput :: [Type]
procedureOutput = [Type]
out,
          procedureTitle :: Maybe Markdown
procedureTitle = Maybe Markdown
forall a. Maybe a
Nothing, -- FIXME
          procedureDescription :: Maybe Markdown
procedureDescription = Maybe Markdown
forall a. Maybe a
Nothing,
          procedureBlock :: Block
procedureBlock = Block
block
        }
    )

pProcedure :: Parser Procedure
pProcedure :: Parser Procedure
pProcedure = do
  Maybe Markdown
description <- Parser Markdown -> ParsecT Void Text Identity (Maybe Markdown)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Markdown
pMarkdown
  Parser ()
fourSpaces
  Procedure
proc <- Parser Procedure
pProcedureCode

  Procedure -> Parser Procedure
forall (m :: * -> *) a. Monad m => a -> m a
return
    ( Procedure
proc
        { procedureTitle :: Maybe Markdown
procedureTitle = Maybe Markdown
forall a. Maybe a
Nothing, -- FIXME
          procedureDescription :: Maybe Markdown
procedureDescription = Maybe Markdown
description
        }
    )

---------------------------------------------------------------------

pTechnique :: Parser Technique
pTechnique :: Parser Technique
pTechnique = do
  Int
version <- Parser Int
pMagicLine
  Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
version Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
__VERSION__) ([Char] -> Parser ()
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"currently the only recognized language version is v" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
__VERSION__))
  (Rope
license, Maybe Rope
copyright) <- Parser (Rope, Maybe Rope)
pSpdxLine
  ParsecT Void Text Identity [Char] -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity Char
-> ParsecT Void Text Identity [Char]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline)

  [Procedure]
body <- Parser Procedure -> ParsecT Void Text Identity [Procedure]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many Parser Procedure
pProcedure

  Technique -> Parser Technique
forall (m :: * -> *) a. Monad m => a -> m a
return (Technique -> Parser Technique) -> Technique -> Parser Technique
forall a b. (a -> b) -> a -> b
$
    Technique :: Int -> Rope -> Maybe Rope -> [Procedure] -> Technique
Technique
      { techniqueVersion :: Int
techniqueVersion = Int
version,
        techniqueLicense :: Rope
techniqueLicense = Rope -> Rope
forall α. Textual α => α -> Rope
intoRope Rope
license,
        techniqueCopyright :: Maybe Rope
techniqueCopyright = (Rope -> Rope) -> Maybe Rope -> Maybe Rope
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rope -> Rope
forall α. Textual α => α -> Rope
intoRope Maybe Rope
copyright,
        techniqueBody :: [Procedure]
techniqueBody = [Procedure]
body
      }