module Parsing where

import RIO
  ( Bool (..),
    Char,
    Either (..),
    FilePath,
    IO,
    IORef,
    Int,
    Maybe (..),
    RIO,
    Set,
    Show,
    String,
    Text,
    Void,
    any,
    ask,
    compare,
    const,
    error,
    for,
    fromMaybe,
    isLeft,
    maybe,
    mconcat,
    mempty,
    modifyIORef,
    newIORef,
    not,
    pure,
    readFileUtf8,
    readIORef,
    runRIO,
    show,
    writeIORef,
    ($),
    ($>),
    (&),
    (*>),
    (.),
    (<$),
    (<$>),
    (<*),
    (<>),
    (==),
    (>>>),
  )
import qualified RIO.FilePath as FilePath
import qualified RIO.List as List
import qualified RIO.Set as Set
import RIO.Text (pack, unpack)
import qualified RIO.Text as Text
import System.IO (putStrLn)
import Text.Megaparsec
import Text.Megaparsec.Char
import Text.Megaparsec.Char.Lexer
import Text.Show.Pretty (pPrint)
import Types

data AppState = AppState
  { AppState -> IORef [Module]
modulesReference :: !(IORef [Module]),
    AppState -> IORef [Import]
currentImportsReference :: !(IORef [Import]),
    AppState -> IORef (Set ModuleName)
currentDeclarationNamesReference :: !(IORef (Set ModuleName)),
    AppState -> IORef [TypeDefinition]
currentDefinitionsReference :: !(IORef [TypeDefinition]),
    AppState -> IORef (Maybe DefinitionName)
currentDefinitionNameReference :: !(IORef (Maybe DefinitionName))
  }

type Parser = ParsecT Void Text (RIO AppState)

parseModules :: [FilePath] -> IO (Either [String] [Module])
parseModules :: [FilePath] -> IO (Either [FilePath] [Module])
parseModules [FilePath]
files = do
  IORef [Module]
modulesReference <- [Module] -> IO (IORef [Module])
forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef []
  IORef [TypeDefinition]
currentDefinitionsReference <- [TypeDefinition] -> IO (IORef [TypeDefinition])
forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef []
  IORef [Import]
currentImportsReference <- [Import] -> IO (IORef [Import])
forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef []
  IORef (Set ModuleName)
currentDeclarationNamesReference <- Set ModuleName -> IO (IORef (Set ModuleName))
forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef Set ModuleName
forall a. Set a
Set.empty
  IORef (Maybe DefinitionName)
currentDefinitionNameReference <- Maybe DefinitionName -> IO (IORef (Maybe DefinitionName))
forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef Maybe DefinitionName
forall a. Maybe a
Nothing
  let state :: AppState
state =
        AppState :: IORef [Module]
-> IORef [Import]
-> IORef (Set ModuleName)
-> IORef [TypeDefinition]
-> IORef (Maybe DefinitionName)
-> AppState
AppState
          { IORef [TypeDefinition]
currentDefinitionsReference :: IORef [TypeDefinition]
$sel:currentDefinitionsReference:AppState :: IORef [TypeDefinition]
currentDefinitionsReference,
            IORef (Maybe DefinitionName)
currentDefinitionNameReference :: IORef (Maybe DefinitionName)
$sel:currentDefinitionNameReference:AppState :: IORef (Maybe DefinitionName)
currentDefinitionNameReference,
            IORef [Import]
currentImportsReference :: IORef [Import]
$sel:currentImportsReference:AppState :: IORef [Import]
currentImportsReference,
            IORef (Set ModuleName)
currentDeclarationNamesReference :: IORef (Set ModuleName)
$sel:currentDeclarationNamesReference:AppState :: IORef (Set ModuleName)
currentDeclarationNamesReference,
            IORef [Module]
modulesReference :: IORef [Module]
$sel:modulesReference:AppState :: IORef [Module]
modulesReference
          }
  [Either FilePath Module]
results <- [FilePath]
-> (FilePath -> IO (Either FilePath Module))
-> IO [Either FilePath Module]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [FilePath]
files ((FilePath -> IO (Either FilePath Module))
 -> IO [Either FilePath Module])
-> (FilePath -> IO (Either FilePath Module))
-> IO [Either FilePath Module]
forall a b. (a -> b) -> a -> b
$ \FilePath
f -> do
    let moduleName :: ModuleName
moduleName = FilePath
f FilePath -> (FilePath -> FilePath) -> FilePath
forall a b. a -> (a -> b) -> b
& FilePath -> FilePath
FilePath.takeBaseName FilePath -> (FilePath -> Text) -> Text
forall a b. a -> (a -> b) -> b
& FilePath -> Text
pack Text -> (Text -> ModuleName) -> ModuleName
forall a b. a -> (a -> b) -> b
& Text -> ModuleName
ModuleName
    Text
fileContents <- FilePath -> IO Text
forall (m :: * -> *). MonadIO m => FilePath -> m Text
readFileUtf8 FilePath
f
    Either (ParseErrorBundle Text Void) Module
maybeModule <- AppState
-> Text
-> Parser Module
-> IO (Either (ParseErrorBundle Text Void) Module)
forall a.
AppState
-> Text -> Parser a -> IO (Either (ParseErrorBundle Text Void) a)
run AppState
state Text
fileContents (Parser Module -> IO (Either (ParseErrorBundle Text Void) Module))
-> Parser Module -> IO (Either (ParseErrorBundle Text Void) Module)
forall a b. (a -> b) -> a -> b
$ ModuleName -> FilePath -> Parser Module
moduleP ModuleName
moduleName FilePath
f
    case Either (ParseErrorBundle Text Void) Module
maybeModule of
      Right Module
module' -> do
        Module -> IORef [Module] -> IO ()
addModule Module
module' IORef [Module]
modulesReference
        pure $ Module -> Either FilePath Module
forall a b. b -> Either a b
Right Module
module'
      Left ParseErrorBundle Text Void
e -> Either FilePath Module -> IO (Either FilePath Module)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath Module -> IO (Either FilePath Module))
-> Either FilePath Module -> IO (Either FilePath Module)
forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath Module
forall a b. a -> Either a b
Left (FilePath -> Either FilePath Module)
-> FilePath -> Either FilePath Module
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
forall a. Monoid a => [a] -> a
mconcat [FilePath
"Error parsing module '", FilePath
f, FilePath
"': \n", ParseErrorBundle Text Void -> FilePath
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> FilePath
errorBundlePretty ParseErrorBundle Text Void
e]

  case (Either FilePath Module -> Bool)
-> [Either FilePath Module]
-> ([Either FilePath Module], [Either FilePath Module])
forall a. (a -> Bool) -> [a] -> ([a], [a])
List.partition Either FilePath Module -> Bool
forall a b. Either a b -> Bool
isLeft [Either FilePath Module]
results of
    ([], [Either FilePath Module]
maybeModules) ->
      Either [FilePath] [Module] -> IO (Either [FilePath] [Module])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either [FilePath] [Module] -> IO (Either [FilePath] [Module]))
-> Either [FilePath] [Module] -> IO (Either [FilePath] [Module])
forall a b. (a -> b) -> a -> b
$ [Module] -> Either [FilePath] [Module]
forall a b. b -> Either a b
Right ([Module] -> Either [FilePath] [Module])
-> [Module] -> Either [FilePath] [Module]
forall a b. (a -> b) -> a -> b
$ (Either FilePath Module -> Module)
-> [Either FilePath Module] -> [Module]
forall a b. (a -> b) -> [a] -> [b]
List.map Either FilePath Module -> Module
forall l r. Either l r -> r
partialFromRight [Either FilePath Module]
maybeModules
    ([Either FilePath Module]
errors, [Either FilePath Module]
_modules) ->
      Either [FilePath] [Module] -> IO (Either [FilePath] [Module])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either [FilePath] [Module] -> IO (Either [FilePath] [Module]))
-> Either [FilePath] [Module] -> IO (Either [FilePath] [Module])
forall a b. (a -> b) -> a -> b
$ [FilePath] -> Either [FilePath] [Module]
forall a b. a -> Either a b
Left ([FilePath] -> Either [FilePath] [Module])
-> [FilePath] -> Either [FilePath] [Module]
forall a b. (a -> b) -> a -> b
$ (Either FilePath Module -> FilePath)
-> [Either FilePath Module] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
List.map Either FilePath Module -> FilePath
forall l r. Either l r -> l
partialFromLeft [Either FilePath Module]
errors

run :: AppState -> Text -> Parser a -> IO (Either (ParseErrorBundle Text Void) a)
run :: AppState
-> Text -> Parser a -> IO (Either (ParseErrorBundle Text Void) a)
run AppState
state Text
text Parser a
parser = do
  let parserResult :: RIO AppState (Either (ParseErrorBundle Text Void) a)
parserResult = Parser a
-> FilePath
-> Text
-> RIO AppState (Either (ParseErrorBundle Text Void) a)
forall (m :: * -> *) e s a.
Monad m =>
ParsecT e s m a
-> FilePath -> s -> m (Either (ParseErrorBundle s e) a)
runParserT Parser a
parser FilePath
"" Text
text
  AppState
-> RIO AppState (Either (ParseErrorBundle Text Void) a)
-> IO (Either (ParseErrorBundle Text Void) a)
forall (m :: * -> *) env a. MonadIO m => env -> RIO env a -> m a
runRIO AppState
state RIO AppState (Either (ParseErrorBundle Text Void) a)
parserResult

test :: (Show a) => AppState -> Text -> Parser a -> IO ()
test :: AppState -> Text -> Parser a -> IO ()
test AppState
state Text
text Parser a
parser = do
  Either (ParseErrorBundle Text Void) a
result <- AppState
-> Text -> Parser a -> IO (Either (ParseErrorBundle Text Void) a)
forall a.
AppState
-> Text -> Parser a -> IO (Either (ParseErrorBundle Text Void) a)
run AppState
state Text
text Parser a
parser
  case Either (ParseErrorBundle Text Void) a
result of
    Right a
successValue -> a -> IO ()
forall a. Show a => a -> IO ()
pPrint a
successValue
    Left ParseErrorBundle Text Void
e -> FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle Text Void -> FilePath
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> FilePath
errorBundlePretty ParseErrorBundle Text Void
e

moduleP :: ModuleName -> FilePath -> Parser Module
moduleP :: ModuleName -> FilePath -> Parser Module
moduleP ModuleName
name FilePath
sourceFile = do
  [Import]
imports <- [Import] -> Maybe [Import] -> [Import]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [Import] -> [Import])
-> ParsecT Void Text (RIO AppState) (Maybe [Import])
-> ParsecT Void Text (RIO AppState) [Import]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text (RIO AppState) [Import]
-> ParsecT Void Text (RIO AppState) (Maybe [Import])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void Text (RIO AppState) Import
-> ParsecT Void Text (RIO AppState) Char
-> ParsecT Void Text (RIO AppState) [Import]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepEndBy1 ParsecT Void Text (RIO AppState) Import
importP ParsecT Void Text (RIO AppState) Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline ParsecT Void Text (RIO AppState) [Import]
-> ParsecT Void Text (RIO AppState) Char
-> ParsecT Void Text (RIO AppState) [Import]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text (RIO AppState) Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline)
  [Import] -> Parser ()
addImports [Import]
imports
  [TypeDefinition]
definitions <- ParsecT Void Text (RIO AppState) TypeDefinition
-> ParsecT Void Text (RIO AppState) Char
-> ParsecT Void Text (RIO AppState) [TypeDefinition]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy1 ParsecT Void Text (RIO AppState) TypeDefinition
typeDefinitionP (ParsecT Void Text (RIO AppState) Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline ParsecT Void Text (RIO AppState) Char
-> ParsecT Void Text (RIO AppState) Char
-> ParsecT Void Text (RIO AppState) Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text (RIO AppState) Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline) ParsecT Void Text (RIO AppState) [TypeDefinition]
-> Parser () -> ParsecT Void Text (RIO AppState) [TypeDefinition]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
  [ModuleName]
declarationNames <- Set ModuleName -> [ModuleName]
forall a. Set a -> [a]
Set.toList (Set ModuleName -> [ModuleName])
-> ParsecT Void Text (RIO AppState) (Set ModuleName)
-> ParsecT Void Text (RIO AppState) [ModuleName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text (RIO AppState) (Set ModuleName)
getDeclarationNames
  Parser ()
clearDeclarationNames
  Parser ()
clearDefinitions
  pure Module :: ModuleName
-> [Import]
-> [ModuleName]
-> [TypeDefinition]
-> FilePath
-> Module
Module {ModuleName
$sel:name:Module :: ModuleName
name :: ModuleName
name, [Import]
$sel:imports:Module :: [Import]
imports :: [Import]
imports, [TypeDefinition]
$sel:definitions:Module :: [TypeDefinition]
definitions :: [TypeDefinition]
definitions, FilePath
$sel:sourceFile:Module :: FilePath
sourceFile :: FilePath
sourceFile, [ModuleName]
$sel:declarationNames:Module :: [ModuleName]
declarationNames :: [ModuleName]
declarationNames}

addImports :: [Import] -> Parser ()
addImports :: [Import] -> Parser ()
addImports [Import]
imports = do
  AppState {IORef [Import]
currentImportsReference :: IORef [Import]
$sel:currentImportsReference:AppState :: AppState -> IORef [Import]
currentImportsReference} <- ParsecT Void Text (RIO AppState) AppState
forall r (m :: * -> *). MonadReader r m => m r
ask
  IORef [Import] -> [Import] -> Parser ()
forall (m :: * -> *) a. MonadIO m => IORef a -> a -> m ()
writeIORef IORef [Import]
currentImportsReference [Import]
imports

addDeclarationName :: ModuleName -> Parser ()
addDeclarationName :: ModuleName -> Parser ()
addDeclarationName ModuleName
moduleName = do
  AppState {IORef (Set ModuleName)
currentDeclarationNamesReference :: IORef (Set ModuleName)
$sel:currentDeclarationNamesReference:AppState :: AppState -> IORef (Set ModuleName)
currentDeclarationNamesReference} <- ParsecT Void Text (RIO AppState) AppState
forall r (m :: * -> *). MonadReader r m => m r
ask
  IORef (Set ModuleName)
-> (Set ModuleName -> Set ModuleName) -> Parser ()
forall (m :: * -> *) a. MonadIO m => IORef a -> (a -> a) -> m ()
modifyIORef IORef (Set ModuleName)
currentDeclarationNamesReference (ModuleName -> Set ModuleName -> Set ModuleName
forall a. Ord a => a -> Set a -> Set a
Set.insert ModuleName
moduleName)

getDeclarationNames :: Parser (Set ModuleName)
getDeclarationNames :: ParsecT Void Text (RIO AppState) (Set ModuleName)
getDeclarationNames = do
  AppState {IORef (Set ModuleName)
currentDeclarationNamesReference :: IORef (Set ModuleName)
$sel:currentDeclarationNamesReference:AppState :: AppState -> IORef (Set ModuleName)
currentDeclarationNamesReference} <- ParsecT Void Text (RIO AppState) AppState
forall r (m :: * -> *). MonadReader r m => m r
ask
  IORef (Set ModuleName)
-> ParsecT Void Text (RIO AppState) (Set ModuleName)
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef IORef (Set ModuleName)
currentDeclarationNamesReference

clearDeclarationNames :: Parser ()
clearDeclarationNames :: Parser ()
clearDeclarationNames = do
  AppState {IORef (Set ModuleName)
currentDeclarationNamesReference :: IORef (Set ModuleName)
$sel:currentDeclarationNamesReference:AppState :: AppState -> IORef (Set ModuleName)
currentDeclarationNamesReference} <- ParsecT Void Text (RIO AppState) AppState
forall r (m :: * -> *). MonadReader r m => m r
ask
  IORef (Set ModuleName) -> Set ModuleName -> Parser ()
forall (m :: * -> *) a. MonadIO m => IORef a -> a -> m ()
writeIORef IORef (Set ModuleName)
currentDeclarationNamesReference Set ModuleName
forall a. Set a
Set.empty

importP :: Parser Import
importP :: ParsecT Void Text (RIO AppState) Import
importP = do
  Tokens Text -> ParsecT Void Text (RIO AppState) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"import "
  FilePath
importName <- ParsecT Void Text (RIO AppState) Char
-> ParsecT Void Text (RIO AppState) FilePath
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (ParsecT Void Text (RIO AppState) Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar ParsecT Void Text (RIO AppState) Char
-> ParsecT Void Text (RIO AppState) Char
-> ParsecT Void Text (RIO AppState) Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token Text -> ParsecT Void Text (RIO AppState) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'_')
  Maybe Module
maybeModule <- FilePath -> Parser (Maybe Module)
getModule FilePath
importName
  case Maybe Module
maybeModule of
    Just Module
module' -> do
      Import -> ParsecT Void Text (RIO AppState) Import
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Import -> ParsecT Void Text (RIO AppState) Import)
-> Import -> ParsecT Void Text (RIO AppState) Import
forall a b. (a -> b) -> a -> b
$ Module -> Import
Import Module
module'
    Maybe Module
Nothing ->
      FilePath -> ParsecT Void Text (RIO AppState) Import
forall a. FilePath -> Parser a
reportError (FilePath -> ParsecT Void Text (RIO AppState) Import)
-> FilePath -> ParsecT Void Text (RIO AppState) Import
forall a b. (a -> b) -> a -> b
$ FilePath
"Unknown module referenced: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
importName

getModule :: String -> Parser (Maybe Module)
getModule :: FilePath -> Parser (Maybe Module)
getModule FilePath
importName = do
  AppState {IORef [Module]
modulesReference :: IORef [Module]
$sel:modulesReference:AppState :: AppState -> IORef [Module]
modulesReference} <- ParsecT Void Text (RIO AppState) AppState
forall r (m :: * -> *). MonadReader r m => m r
ask
  [Module]
modules <- IORef [Module] -> ParsecT Void Text (RIO AppState) [Module]
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef IORef [Module]
modulesReference
  pure $ (Module -> Bool) -> [Module] -> Maybe Module
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find (\Module {$sel:name:Module :: Module -> ModuleName
name = ModuleName Text
name} -> Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath -> Text
pack FilePath
importName) [Module]
modules

addModule :: Module -> IORef [Module] -> IO ()
addModule :: Module -> IORef [Module] -> IO ()
addModule Module
module' IORef [Module]
modulesReference = do
  IORef [Module] -> ([Module] -> [Module]) -> IO ()
forall (m :: * -> *) a. MonadIO m => IORef a -> (a -> a) -> m ()
modifyIORef IORef [Module]
modulesReference (Module
module' Module -> [Module] -> [Module]
forall a. a -> [a] -> [a]
:)

typeDefinitionP :: Parser TypeDefinition
typeDefinitionP :: ParsecT Void Text (RIO AppState) TypeDefinition
typeDefinitionP = do
  Text
keyword <- [ParsecT Void Text (RIO AppState) Text]
-> ParsecT Void Text (RIO AppState) Text
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([ParsecT Void Text (RIO AppState) Text]
 -> ParsecT Void Text (RIO AppState) Text)
-> [ParsecT Void Text (RIO AppState) Text]
-> ParsecT Void Text (RIO AppState) Text
forall a b. (a -> b) -> a -> b
$ (Text -> ParsecT Void Text (RIO AppState) Text)
-> [Text] -> [ParsecT Void Text (RIO AppState) Text]
forall a b. (a -> b) -> [a] -> [b]
List.map Text -> ParsecT Void Text (RIO AppState) Text
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string [Text
"struct", Text
"untagged union", Text
"union", Text
"enum", Text
"declare"]
  TypeDefinition
definition <- case Text
keyword of
    Text
"struct" ->
      Token Text -> ParsecT Void Text (RIO AppState) (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 (RIO AppState) Char
-> ParsecT Void Text (RIO AppState) TypeDefinition
-> ParsecT Void Text (RIO AppState) TypeDefinition
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text (RIO AppState) TypeDefinition
structP
    Text
"union" -> do
      Maybe TagType
maybeTagType <- ParsecT Void Text (RIO AppState) TagType
-> ParsecT Void Text (RIO AppState) (Maybe TagType)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void Text (RIO AppState) TagType
 -> ParsecT Void Text (RIO AppState) (Maybe TagType))
-> ParsecT Void Text (RIO AppState) TagType
-> ParsecT Void Text (RIO AppState) (Maybe TagType)
forall a b. (a -> b) -> a -> b
$ do
        Char
_ <- Token Text -> ParsecT Void Text (RIO AppState) (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 (RIO AppState) TagType
tagTypeP ParsecT Void Text (RIO AppState) TagType
-> ParsecT Void Text (RIO AppState) Char
-> ParsecT Void Text (RIO AppState) TagType
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token Text -> ParsecT Void Text (RIO AppState) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
')'
      let tagType :: TagType
tagType = TagType -> Maybe TagType -> TagType
forall a. a -> Maybe a -> a
fromMaybe (FieldName -> TagType
StandardTypeTag (FieldName -> TagType) -> FieldName -> TagType
forall a b. (a -> b) -> a -> b
$ Text -> FieldName
FieldName Text
"type") Maybe TagType
maybeTagType
      Token Text -> ParsecT Void Text (RIO AppState) (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 (RIO AppState) Char
-> ParsecT Void Text (RIO AppState) TypeDefinition
-> ParsecT Void Text (RIO AppState) TypeDefinition
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> case TagType
tagType of
        StandardTypeTag FieldName
fieldName ->
          FieldName -> ParsecT Void Text (RIO AppState) TypeDefinition
unionP FieldName
fieldName
        EmbeddedTypeTag FieldName
fieldName ->
          FieldName -> ParsecT Void Text (RIO AppState) TypeDefinition
embeddedUnionP FieldName
fieldName
    Text
"untagged union" ->
      Token Text -> ParsecT Void Text (RIO AppState) (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 (RIO AppState) Char
-> ParsecT Void Text (RIO AppState) TypeDefinition
-> ParsecT Void Text (RIO AppState) TypeDefinition
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text (RIO AppState) TypeDefinition
untaggedUnionP
    Text
"enum" ->
      Token Text -> ParsecT Void Text (RIO AppState) (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 (RIO AppState) Char
-> ParsecT Void Text (RIO AppState) TypeDefinition
-> ParsecT Void Text (RIO AppState) TypeDefinition
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text (RIO AppState) TypeDefinition
enumerationP
    Text
"declare" ->
      Token Text -> ParsecT Void Text (RIO AppState) (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 (RIO AppState) Char
-> ParsecT Void Text (RIO AppState) TypeDefinition
-> ParsecT Void Text (RIO AppState) TypeDefinition
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text (RIO AppState) TypeDefinition
declarationP
    Text
other ->
      FilePath -> ParsecT Void Text (RIO AppState) TypeDefinition
forall a. FilePath -> Parser a
reportError (FilePath -> ParsecT Void Text (RIO AppState) TypeDefinition)
-> FilePath -> ParsecT Void Text (RIO AppState) TypeDefinition
forall a b. (a -> b) -> a -> b
$ FilePath
"Unknown type definition keyword: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
unpack Text
other
  TypeDefinition -> Parser ()
addDefinition TypeDefinition
definition
  pure TypeDefinition
definition

declarationP :: Parser TypeDefinition
declarationP :: ParsecT Void Text (RIO AppState) TypeDefinition
declarationP = do
  ModuleName
externalModule <- (FilePath -> Text
pack (FilePath -> Text)
-> (Text -> ModuleName) -> FilePath -> ModuleName
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Text -> ModuleName
ModuleName) (FilePath -> ModuleName)
-> ParsecT Void Text (RIO AppState) FilePath
-> ParsecT Void Text (RIO AppState) ModuleName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text (RIO AppState) Char
-> ParsecT Void Text (RIO AppState) FilePath
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (ParsecT Void Text (RIO AppState) Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar ParsecT Void Text (RIO AppState) Char
-> ParsecT Void Text (RIO AppState) Char
-> ParsecT Void Text (RIO AppState) Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token Text -> ParsecT Void Text (RIO AppState) (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 (RIO AppState) ModuleName
-> ParsecT Void Text (RIO AppState) Char
-> ParsecT Void Text (RIO AppState) ModuleName
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token Text -> ParsecT Void Text (RIO AppState) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'.'
  DefinitionName
name <- Parser DefinitionName
readCurrentDefinitionName
  [TypeVariable]
typeVariables <-
    ([Text] -> Maybe [Text] -> [Text]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [Text] -> [Text])
-> ([Text] -> [TypeVariable]) -> Maybe [Text] -> [TypeVariable]
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Text -> TypeVariable) -> [Text] -> [TypeVariable]
forall a b. (a -> b) -> [a] -> [b]
List.map Text -> TypeVariable
TypeVariable)
      (Maybe [Text] -> [TypeVariable])
-> ParsecT Void Text (RIO AppState) (Maybe [Text])
-> ParsecT Void Text (RIO AppState) [TypeVariable]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text (RIO AppState) [Text]
-> ParsecT Void Text (RIO AppState) (Maybe [Text])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void Text (RIO AppState) Char
-> ParsecT Void Text (RIO AppState) Char
-> ParsecT Void Text (RIO AppState) [Text]
-> ParsecT Void Text (RIO AppState) [Text]
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token Text -> ParsecT Void Text (RIO AppState) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'<') (Token Text -> ParsecT Void Text (RIO AppState) (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 (RIO AppState) [Text]
typeVariablesP)
  ModuleName -> Parser ()
addDeclarationName ModuleName
externalModule
  pure $ DefinitionName -> TypeData -> TypeDefinition
TypeDefinition DefinitionName
name (TypeData -> TypeDefinition) -> TypeData -> TypeDefinition
forall a b. (a -> b) -> a -> b
$ ModuleName -> [TypeVariable] -> TypeData
DeclaredType ModuleName
externalModule [TypeVariable]
typeVariables

untaggedUnionP :: Parser TypeDefinition
untaggedUnionP :: ParsecT Void Text (RIO AppState) TypeDefinition
untaggedUnionP = do
  DefinitionName
name <- Parser DefinitionName
readCurrentDefinitionName Parser DefinitionName
-> ParsecT Void Text (RIO AppState) Text -> Parser DefinitionName
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Tokens Text -> ParsecT Void Text (RIO AppState) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
" {\n"
  [FieldType]
cases <- Parser [FieldType]
untaggedUnionCasesP
  Token Text -> ParsecT Void Text (RIO AppState) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'}'
  pure $ DefinitionName -> TypeData -> TypeDefinition
TypeDefinition DefinitionName
name (TypeData -> TypeDefinition) -> TypeData -> TypeDefinition
forall a b. (a -> b) -> a -> b
$ [FieldType] -> TypeData
UntaggedUnion [FieldType]
cases

untaggedUnionCasesP :: Parser [FieldType]
untaggedUnionCasesP :: Parser [FieldType]
untaggedUnionCasesP = do
  ParsecT Void Text (RIO AppState) FieldType -> Parser [FieldType]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT Void Text (RIO AppState) FieldType
untaggedUnionCaseP

untaggedUnionCaseP :: Parser FieldType
untaggedUnionCaseP :: ParsecT Void Text (RIO AppState) FieldType
untaggedUnionCaseP =
  Tokens Text -> ParsecT Void Text (RIO AppState) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"    " ParsecT Void Text (RIO AppState) Text
-> ParsecT Void Text (RIO AppState) FieldType
-> ParsecT Void Text (RIO AppState) FieldType
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [TypeVariable] -> ParsecT Void Text (RIO AppState) FieldType
fieldTypeP [] ParsecT Void Text (RIO AppState) FieldType
-> ParsecT Void Text (RIO AppState) Char
-> ParsecT Void Text (RIO AppState) FieldType
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text (RIO AppState) Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline

tagTypeP :: Parser TagType
tagTypeP :: ParsecT Void Text (RIO AppState) TagType
tagTypeP = do
  Maybe FieldName
maybeTagName <- ParsecT Void Text (RIO AppState) FieldName
-> ParsecT Void Text (RIO AppState) (Maybe FieldName)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void Text (RIO AppState) FieldName
 -> ParsecT Void Text (RIO AppState) (Maybe FieldName))
-> ParsecT Void Text (RIO AppState) FieldName
-> ParsecT Void Text (RIO AppState) (Maybe FieldName)
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT Void Text (RIO AppState) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"tag = " ParsecT Void Text (RIO AppState) Text
-> ParsecT Void Text (RIO AppState) FieldName
-> ParsecT Void Text (RIO AppState) FieldName
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text (RIO AppState) FieldName
fieldNameP
  ParsecT Void Text (RIO AppState) Text
-> ParsecT Void Text (RIO AppState) [Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT Void Text (RIO AppState) Text
 -> ParsecT Void Text (RIO AppState) [Text])
-> ParsecT Void Text (RIO AppState) Text
-> ParsecT Void Text (RIO AppState) [Text]
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT Void Text (RIO AppState) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
", "
  Maybe TypeTag
maybeEmbedded <- ParsecT Void Text (RIO AppState) TypeTag
-> ParsecT Void Text (RIO AppState) (Maybe TypeTag)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void Text (RIO AppState) TypeTag
 -> ParsecT Void Text (RIO AppState) (Maybe TypeTag))
-> ParsecT Void Text (RIO AppState) TypeTag
-> ParsecT Void Text (RIO AppState) (Maybe TypeTag)
forall a b. (a -> b) -> a -> b
$ Text -> TypeTag
TypeTag (Text -> TypeTag)
-> ParsecT Void Text (RIO AppState) Text
-> ParsecT Void Text (RIO AppState) TypeTag
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tokens Text -> ParsecT Void Text (RIO AppState) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"embedded"
  let tagField :: FieldName
tagField = FieldName -> Maybe FieldName -> FieldName
forall a. a -> Maybe a -> a
fromMaybe (Text -> FieldName
FieldName Text
"type") Maybe FieldName
maybeTagName
  pure $ TagType -> (TypeTag -> TagType) -> Maybe TypeTag -> TagType
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FieldName -> TagType
StandardTypeTag FieldName
tagField) (TagType -> TypeTag -> TagType
forall a b. a -> b -> a
const (TagType -> TypeTag -> TagType) -> TagType -> TypeTag -> TagType
forall a b. (a -> b) -> a -> b
$ FieldName -> TagType
EmbeddedTypeTag FieldName
tagField) Maybe TypeTag
maybeEmbedded

readCurrentDefinitionName :: Parser DefinitionName
readCurrentDefinitionName :: Parser DefinitionName
readCurrentDefinitionName = do
  DefinitionName
name <- Parser DefinitionName
definitionNameP
  DefinitionName -> Parser ()
setCurrentDefinitionName DefinitionName
name
  pure DefinitionName
name

structP :: Parser TypeDefinition
structP :: ParsecT Void Text (RIO AppState) TypeDefinition
structP = do
  DefinitionName
name <- Parser DefinitionName
readCurrentDefinitionName Parser DefinitionName
-> ParsecT Void Text (RIO AppState) Char -> Parser DefinitionName
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token Text -> ParsecT Void Text (RIO AppState) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
' '
  Maybe [Text]
maybeTypeVariables <- ParsecT Void Text (RIO AppState) [Text]
-> ParsecT Void Text (RIO AppState) (Maybe [Text])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void Text (RIO AppState) [Text]
 -> ParsecT Void Text (RIO AppState) (Maybe [Text]))
-> ParsecT Void Text (RIO AppState) [Text]
-> ParsecT Void Text (RIO AppState) (Maybe [Text])
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text (RIO AppState) Char
-> ParsecT Void Text (RIO AppState) Char
-> ParsecT Void Text (RIO AppState) [Text]
-> ParsecT Void Text (RIO AppState) [Text]
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token Text -> ParsecT Void Text (RIO AppState) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'<') (Token Text -> ParsecT Void Text (RIO AppState) (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 (RIO AppState) [Text]
typeVariablesP
  Tokens Text -> ParsecT Void Text (RIO AppState) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"{\n"
  case Maybe [Text]
maybeTypeVariables of
    Just [Text]
typeVariables -> DefinitionName
-> [TypeVariable]
-> ParsecT Void Text (RIO AppState) TypeDefinition
genericStructP DefinitionName
name ([TypeVariable] -> ParsecT Void Text (RIO AppState) TypeDefinition)
-> [TypeVariable]
-> ParsecT Void Text (RIO AppState) TypeDefinition
forall a b. (a -> b) -> a -> b
$ (Text -> TypeVariable) -> [Text] -> [TypeVariable]
forall a b. (a -> b) -> [a] -> [b]
List.map Text -> TypeVariable
TypeVariable [Text]
typeVariables
    Maybe [Text]
Nothing -> DefinitionName -> ParsecT Void Text (RIO AppState) TypeDefinition
plainStructP DefinitionName
name

genericStructP :: DefinitionName -> [TypeVariable] -> Parser TypeDefinition
genericStructP :: DefinitionName
-> [TypeVariable]
-> ParsecT Void Text (RIO AppState) TypeDefinition
genericStructP DefinitionName
name [TypeVariable]
typeVariables = do
  [StructField]
fields <- [TypeVariable] -> Parser [StructField]
fieldsP [TypeVariable]
typeVariables
  Token Text -> ParsecT Void Text (RIO AppState) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'}'
  pure $ DefinitionName -> TypeData -> TypeDefinition
TypeDefinition DefinitionName
name (TypeData -> TypeDefinition) -> TypeData -> TypeDefinition
forall a b. (a -> b) -> a -> b
$ StructType -> TypeData
Struct (StructType -> TypeData) -> StructType -> TypeData
forall a b. (a -> b) -> a -> b
$ [TypeVariable] -> [StructField] -> StructType
GenericStruct [TypeVariable]
typeVariables [StructField]
fields

plainStructP :: DefinitionName -> Parser TypeDefinition
plainStructP :: DefinitionName -> ParsecT Void Text (RIO AppState) TypeDefinition
plainStructP DefinitionName
name = do
  [StructField]
fields <- [TypeVariable] -> Parser [StructField]
fieldsP []
  Token Text -> ParsecT Void Text (RIO AppState) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'}'
  pure $ DefinitionName -> TypeData -> TypeDefinition
TypeDefinition DefinitionName
name (TypeData -> TypeDefinition) -> TypeData -> TypeDefinition
forall a b. (a -> b) -> a -> b
$ StructType -> TypeData
Struct (StructType -> TypeData) -> StructType -> TypeData
forall a b. (a -> b) -> a -> b
$ [StructField] -> StructType
PlainStruct [StructField]
fields

constructorsP :: [TypeVariable] -> Parser [Constructor]
constructorsP :: [TypeVariable] -> Parser [Constructor]
constructorsP = ParsecT Void Text (RIO AppState) Constructor
-> Parser [Constructor]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (ParsecT Void Text (RIO AppState) Constructor
 -> Parser [Constructor])
-> ([TypeVariable] -> ParsecT Void Text (RIO AppState) Constructor)
-> [TypeVariable]
-> Parser [Constructor]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TypeVariable] -> ParsecT Void Text (RIO AppState) Constructor
constructorP

constructorP :: [TypeVariable] -> Parser Constructor
constructorP :: [TypeVariable] -> ParsecT Void Text (RIO AppState) Constructor
constructorP [TypeVariable]
typeVariables = do
  Tokens Text -> ParsecT Void Text (RIO AppState) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"    "
  Text
name <- ParsecT Void Text (RIO AppState) Text
constructorNameP
  Maybe Text
maybeColon <- ParsecT Void Text (RIO AppState) Text
-> ParsecT Void Text (RIO AppState) (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void Text (RIO AppState) Text
 -> ParsecT Void Text (RIO AppState) (Maybe Text))
-> ParsecT Void Text (RIO AppState) Text
-> ParsecT Void Text (RIO AppState) (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT Void Text (RIO AppState) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
": "
  Maybe FieldType
payload <- case Maybe Text
maybeColon of
    Just Text
_ -> FieldType -> Maybe FieldType
forall a. a -> Maybe a
Just (FieldType -> Maybe FieldType)
-> ParsecT Void Text (RIO AppState) FieldType
-> ParsecT Void Text (RIO AppState) (Maybe FieldType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeVariable] -> ParsecT Void Text (RIO AppState) FieldType
fieldTypeP [TypeVariable]
typeVariables
    Maybe Text
Nothing -> Maybe FieldType
-> ParsecT Void Text (RIO AppState) (Maybe FieldType)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FieldType
forall a. Maybe a
Nothing
  ParsecT Void Text (RIO AppState) Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline
  pure $ ConstructorName -> Maybe FieldType -> Constructor
Constructor (Text -> ConstructorName
ConstructorName Text
name) Maybe FieldType
payload

constructorNameP :: Parser Text
constructorNameP :: ParsecT Void Text (RIO AppState) Text
constructorNameP = do
  Char
firstLetter <- ParsecT Void Text (RIO AppState) Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar
  FilePath
rest <- ParsecT Void Text (RIO AppState) Char
-> ParsecT Void Text (RIO AppState) FilePath
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT Void Text (RIO AppState) Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar
  pure $ FilePath -> Text
pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ Char
firstLetter Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath
rest

unionP :: FieldName -> Parser TypeDefinition
unionP :: FieldName -> ParsecT Void Text (RIO AppState) TypeDefinition
unionP FieldName
typeTag = do
  DefinitionName
name <- Parser DefinitionName
readCurrentDefinitionName Parser DefinitionName
-> ParsecT Void Text (RIO AppState) Char -> Parser DefinitionName
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token Text -> ParsecT Void Text (RIO AppState) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
' '
  Maybe [Text]
maybeTypeVariables <- ParsecT Void Text (RIO AppState) [Text]
-> ParsecT Void Text (RIO AppState) (Maybe [Text])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void Text (RIO AppState) [Text]
 -> ParsecT Void Text (RIO AppState) (Maybe [Text]))
-> ParsecT Void Text (RIO AppState) [Text]
-> ParsecT Void Text (RIO AppState) (Maybe [Text])
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text (RIO AppState) Char
-> ParsecT Void Text (RIO AppState) Char
-> ParsecT Void Text (RIO AppState) [Text]
-> ParsecT Void Text (RIO AppState) [Text]
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token Text -> ParsecT Void Text (RIO AppState) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'<') (Token Text -> ParsecT Void Text (RIO AppState) (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 (RIO AppState) [Text]
typeVariablesP
  Tokens Text -> ParsecT Void Text (RIO AppState) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"{\n"
  case Maybe [Text]
maybeTypeVariables of
    Just [Text]
typeVariables -> FieldName
-> DefinitionName
-> [TypeVariable]
-> ParsecT Void Text (RIO AppState) TypeDefinition
genericUnionP FieldName
typeTag DefinitionName
name ([TypeVariable] -> ParsecT Void Text (RIO AppState) TypeDefinition)
-> [TypeVariable]
-> ParsecT Void Text (RIO AppState) TypeDefinition
forall a b. (a -> b) -> a -> b
$ (Text -> TypeVariable) -> [Text] -> [TypeVariable]
forall a b. (a -> b) -> [a] -> [b]
List.map Text -> TypeVariable
TypeVariable [Text]
typeVariables
    Maybe [Text]
Nothing -> FieldName
-> DefinitionName
-> ParsecT Void Text (RIO AppState) TypeDefinition
plainUnionP FieldName
typeTag DefinitionName
name

embeddedUnionP :: FieldName -> Parser TypeDefinition
embeddedUnionP :: FieldName -> ParsecT Void Text (RIO AppState) TypeDefinition
embeddedUnionP FieldName
typeTag = do
  DefinitionName
name <- Parser DefinitionName
readCurrentDefinitionName Parser DefinitionName
-> ParsecT Void Text (RIO AppState) Text -> Parser DefinitionName
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Tokens Text -> ParsecT Void Text (RIO AppState) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
" {\n"
  [EmbeddedConstructor]
constructors <- [TypeVariable] -> Parser [EmbeddedConstructor]
embeddedUnionStructConstructorsP []
  Char
_ <- Token Text -> ParsecT Void Text (RIO AppState) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'}'
  pure $ DefinitionName -> TypeData -> TypeDefinition
TypeDefinition DefinitionName
name (FieldName -> [EmbeddedConstructor] -> TypeData
EmbeddedUnion FieldName
typeTag [EmbeddedConstructor]
constructors)

genericUnionP :: FieldName -> DefinitionName -> [TypeVariable] -> Parser TypeDefinition
genericUnionP :: FieldName
-> DefinitionName
-> [TypeVariable]
-> ParsecT Void Text (RIO AppState) TypeDefinition
genericUnionP FieldName
typeTag DefinitionName
name [TypeVariable]
typeVariables = do
  [Constructor]
constructors <- [TypeVariable] -> Parser [Constructor]
constructorsP [TypeVariable]
typeVariables
  Char
_ <- Token Text -> ParsecT Void Text (RIO AppState) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'}'
  let union :: TypeData
union = FieldName -> UnionType -> TypeData
Union FieldName
typeTag UnionType
unionType
      unionType :: UnionType
unionType = [TypeVariable] -> [Constructor] -> UnionType
GenericUnion [TypeVariable]
typeVariables [Constructor]
constructors
  TypeDefinition -> ParsecT Void Text (RIO AppState) TypeDefinition
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TypeDefinition -> ParsecT Void Text (RIO AppState) TypeDefinition)
-> TypeDefinition
-> ParsecT Void Text (RIO AppState) TypeDefinition
forall a b. (a -> b) -> a -> b
$ DefinitionName -> TypeData -> TypeDefinition
TypeDefinition DefinitionName
name TypeData
union

embeddedUnionStructConstructorsP :: [TypeVariable] -> Parser [EmbeddedConstructor]
embeddedUnionStructConstructorsP :: [TypeVariable] -> Parser [EmbeddedConstructor]
embeddedUnionStructConstructorsP [TypeVariable]
typeVariables =
  ParsecT Void Text (RIO AppState) EmbeddedConstructor
-> Parser [EmbeddedConstructor]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (ParsecT Void Text (RIO AppState) EmbeddedConstructor
 -> Parser [EmbeddedConstructor])
-> ParsecT Void Text (RIO AppState) EmbeddedConstructor
-> Parser [EmbeddedConstructor]
forall a b. (a -> b) -> a -> b
$ [TypeVariable]
-> ParsecT Void Text (RIO AppState) EmbeddedConstructor
embeddedUnionStructConstructorP [TypeVariable]
typeVariables

embeddedUnionStructConstructorP :: [TypeVariable] -> Parser EmbeddedConstructor
embeddedUnionStructConstructorP :: [TypeVariable]
-> ParsecT Void Text (RIO AppState) EmbeddedConstructor
embeddedUnionStructConstructorP [TypeVariable]
typeVariables = do
  Text
constructorName <- Tokens Text -> ParsecT Void Text (RIO AppState) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"    " ParsecT Void Text (RIO AppState) Text
-> ParsecT Void Text (RIO AppState) Text
-> ParsecT Void Text (RIO AppState) Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text (RIO AppState) Text
embeddedConstructorNameP
  Maybe DefinitionReference
maybeDefinition <-
    [ParsecT Void Text (RIO AppState) (Maybe DefinitionReference)]
-> ParsecT Void Text (RIO AppState) (Maybe DefinitionReference)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
      [ Maybe DefinitionReference
forall a. Maybe a
Nothing Maybe DefinitionReference
-> ParsecT Void Text (RIO AppState) Char
-> ParsecT Void Text (RIO AppState) (Maybe DefinitionReference)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Void Text (RIO AppState) Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline,
        DefinitionReference -> Maybe DefinitionReference
forall a. a -> Maybe a
Just (DefinitionReference -> Maybe DefinitionReference)
-> ParsecT Void Text (RIO AppState) DefinitionReference
-> ParsecT Void Text (RIO AppState) (Maybe DefinitionReference)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Tokens Text -> ParsecT Void Text (RIO AppState) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
": " ParsecT Void Text (RIO AppState) Text
-> ParsecT Void Text (RIO AppState) DefinitionReference
-> ParsecT Void Text (RIO AppState) DefinitionReference
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [TypeVariable]
-> ParsecT Void Text (RIO AppState) DefinitionReference
structReferenceP [TypeVariable]
typeVariables ParsecT Void Text (RIO AppState) DefinitionReference
-> ParsecT Void Text (RIO AppState) Char
-> ParsecT Void Text (RIO AppState) DefinitionReference
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text (RIO AppState) Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline)
      ]
  pure $ ConstructorName -> Maybe DefinitionReference -> EmbeddedConstructor
EmbeddedConstructor (Text -> ConstructorName
ConstructorName Text
constructorName) Maybe DefinitionReference
maybeDefinition

structReferenceP :: [TypeVariable] -> Parser DefinitionReference
structReferenceP :: [TypeVariable]
-> ParsecT Void Text (RIO AppState) DefinitionReference
structReferenceP [TypeVariable]
typeVariables = do
  DefinitionReference
definition <- [TypeVariable]
-> ParsecT Void Text (RIO AppState) DefinitionReference
definitionReferenceP [TypeVariable]
typeVariables
  case DefinitionReference
definition of
    (DefinitionReference (TypeDefinition DefinitionName
_name (Struct (PlainStruct [StructField]
_)))) ->
      DefinitionReference
-> ParsecT Void Text (RIO AppState) DefinitionReference
forall (f :: * -> *) a. Applicative f => a -> f a
pure DefinitionReference
definition
    (ImportedDefinitionReference ModuleName
_moduleName (TypeDefinition DefinitionName
_name (Struct (PlainStruct [StructField]
_)))) ->
      DefinitionReference
-> ParsecT Void Text (RIO AppState) DefinitionReference
forall (f :: * -> *) a. Applicative f => a -> f a
pure DefinitionReference
definition
    (AppliedGenericReference [FieldType]
_appliedTypes (TypeDefinition DefinitionName
_name (Struct (PlainStruct [StructField]
_)))) ->
      DefinitionReference
-> ParsecT Void Text (RIO AppState) DefinitionReference
forall (f :: * -> *) a. Applicative f => a -> f a
pure DefinitionReference
definition
    ( AppliedImportedGenericReference
        ModuleName
_moduleName
        AppliedTypes
_appliedTypes
        (TypeDefinition DefinitionName
_name (Struct (PlainStruct [StructField]
_)))
      ) -> DefinitionReference
-> ParsecT Void Text (RIO AppState) DefinitionReference
forall (f :: * -> *) a. Applicative f => a -> f a
pure DefinitionReference
definition
    DefinitionReference
other -> FilePath -> ParsecT Void Text (RIO AppState) DefinitionReference
forall a. FilePath -> Parser a
reportError (FilePath -> ParsecT Void Text (RIO AppState) DefinitionReference)
-> FilePath -> ParsecT Void Text (RIO AppState) DefinitionReference
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
forall a. Monoid a => [a] -> a
mconcat [FilePath
"Expected plain struct reference, got: ", DefinitionReference -> FilePath
forall a. Show a => a -> FilePath
show DefinitionReference
other]

embeddedConstructorNameP :: Parser Text
embeddedConstructorNameP :: ParsecT Void Text (RIO AppState) Text
embeddedConstructorNameP = FilePath -> Text
pack (FilePath -> Text)
-> ParsecT Void Text (RIO AppState) FilePath
-> ParsecT Void Text (RIO AppState) Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text (RIO AppState) Char
-> ParsecT Void Text (RIO AppState) FilePath
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT Void Text (RIO AppState) Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar

enumerationP :: Parser TypeDefinition
enumerationP :: ParsecT Void Text (RIO AppState) TypeDefinition
enumerationP = do
  DefinitionName
name <- Parser DefinitionName
definitionNameP
  DefinitionName -> Parser ()
setCurrentDefinitionName DefinitionName
name
  Tokens Text -> ParsecT Void Text (RIO AppState) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
" {\n"
  [EnumerationValue]
values <- Parser [EnumerationValue]
enumerationValuesP
  Token Text -> ParsecT Void Text (RIO AppState) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'}'
  pure $ DefinitionName -> TypeData -> TypeDefinition
TypeDefinition DefinitionName
name (TypeData -> TypeDefinition) -> TypeData -> TypeDefinition
forall a b. (a -> b) -> a -> b
$ [EnumerationValue] -> TypeData
Enumeration [EnumerationValue]
values

enumerationValuesP :: Parser [EnumerationValue]
enumerationValuesP :: Parser [EnumerationValue]
enumerationValuesP = ParsecT Void Text (RIO AppState) EnumerationValue
-> Parser [EnumerationValue]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT Void Text (RIO AppState) EnumerationValue
enumerationValueP

enumerationValueP :: Parser EnumerationValue
enumerationValueP :: ParsecT Void Text (RIO AppState) EnumerationValue
enumerationValueP = do
  Tokens Text -> ParsecT Void Text (RIO AppState) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"    "
  EnumerationIdentifier
identifier <- (FilePath -> Text
pack (FilePath -> Text)
-> (Text -> EnumerationIdentifier)
-> FilePath
-> EnumerationIdentifier
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Text -> EnumerationIdentifier
EnumerationIdentifier) (FilePath -> EnumerationIdentifier)
-> ParsecT Void Text (RIO AppState) FilePath
-> ParsecT Void Text (RIO AppState) EnumerationIdentifier
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text (RIO AppState) Char
-> ParsecT Void Text (RIO AppState) Text
-> ParsecT Void Text (RIO AppState) FilePath
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
someTill ParsecT Void Text (RIO AppState) Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar (Tokens Text -> ParsecT Void Text (RIO AppState) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
" = ")
  LiteralTypeValue
value <- Parser LiteralTypeValue
literalP Parser LiteralTypeValue
-> ParsecT Void Text (RIO AppState) Char -> Parser LiteralTypeValue
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text (RIO AppState) Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline
  pure $ EnumerationIdentifier -> LiteralTypeValue -> EnumerationValue
EnumerationValue EnumerationIdentifier
identifier LiteralTypeValue
value

plainUnionP :: FieldName -> DefinitionName -> Parser TypeDefinition
plainUnionP :: FieldName
-> DefinitionName
-> ParsecT Void Text (RIO AppState) TypeDefinition
plainUnionP FieldName
typeTag DefinitionName
name = do
  [Constructor]
constructors <- [TypeVariable] -> Parser [Constructor]
constructorsP []
  Char
_ <- Token Text -> ParsecT Void Text (RIO AppState) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'}'
  pure $ DefinitionName -> TypeData -> TypeDefinition
TypeDefinition DefinitionName
name (TypeData -> TypeDefinition) -> TypeData -> TypeDefinition
forall a b. (a -> b) -> a -> b
$ FieldName -> UnionType -> TypeData
Union FieldName
typeTag ([Constructor] -> UnionType
PlainUnion [Constructor]
constructors)

typeVariablesP :: Parser [Text]
typeVariablesP :: ParsecT Void Text (RIO AppState) [Text]
typeVariablesP = ParsecT Void Text (RIO AppState) Text
-> ParsecT Void Text (RIO AppState) Text
-> ParsecT Void Text (RIO AppState) [Text]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy1 ParsecT Void Text (RIO AppState) Text
pascalWordP (Tokens Text -> ParsecT Void Text (RIO AppState) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
", ")

pascalWordP :: Parser Text
pascalWordP :: ParsecT Void Text (RIO AppState) Text
pascalWordP = do
  Char
initialUppercaseCharacter <- ParsecT Void Text (RIO AppState) Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
upperChar
  ((Char
initialUppercaseCharacter Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:) (FilePath -> FilePath) -> (FilePath -> Text) -> FilePath -> Text
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> FilePath -> Text
pack) (FilePath -> Text)
-> ParsecT Void Text (RIO AppState) FilePath
-> ParsecT Void Text (RIO AppState) Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text (RIO AppState) Char
-> ParsecT Void Text (RIO AppState) FilePath
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT Void Text (RIO AppState) Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar

fieldsP :: [TypeVariable] -> Parser [StructField]
fieldsP :: [TypeVariable] -> Parser [StructField]
fieldsP = ParsecT Void Text (RIO AppState) StructField
-> Parser [StructField]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (ParsecT Void Text (RIO AppState) StructField
 -> Parser [StructField])
-> ([TypeVariable] -> ParsecT Void Text (RIO AppState) StructField)
-> [TypeVariable]
-> Parser [StructField]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TypeVariable] -> ParsecT Void Text (RIO AppState) StructField
fieldP

fieldP :: [TypeVariable] -> Parser StructField
fieldP :: [TypeVariable] -> ParsecT Void Text (RIO AppState) StructField
fieldP [TypeVariable]
typeVariables = do
  Tokens Text -> ParsecT Void Text (RIO AppState) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"    "
  FieldName
name <- ParsecT Void Text (RIO AppState) FieldName
fieldNameP
  Tokens Text -> ParsecT Void Text (RIO AppState) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
": "
  FieldType
fieldType <- [TypeVariable] -> ParsecT Void Text (RIO AppState) FieldType
fieldTypeP [TypeVariable]
typeVariables
  ParsecT Void Text (RIO AppState) Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline
  pure $ FieldName -> FieldType -> StructField
StructField FieldName
name FieldType
fieldType

fieldNameP :: Parser FieldName
fieldNameP :: ParsecT Void Text (RIO AppState) FieldName
fieldNameP = do
  Char
initialAlphaChar <- ParsecT Void Text (RIO AppState) Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
lowerChar ParsecT Void Text (RIO AppState) Char
-> ParsecT Void Text (RIO AppState) Char
-> ParsecT Void Text (RIO AppState) Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text (RIO AppState) Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
upperChar
  ((Char
initialAlphaChar Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:) (FilePath -> FilePath)
-> (FilePath -> FieldName) -> FilePath -> FieldName
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> FilePath -> Text
pack (FilePath -> Text) -> (Text -> FieldName) -> FilePath -> FieldName
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Text -> FieldName
FieldName) (FilePath -> FieldName)
-> ParsecT Void Text (RIO AppState) FilePath
-> ParsecT Void Text (RIO AppState) FieldName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text (RIO AppState) Char
-> ParsecT Void Text (RIO AppState) FilePath
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (ParsecT Void Text (RIO AppState) Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar ParsecT Void Text (RIO AppState) Char
-> ParsecT Void Text (RIO AppState) Char
-> ParsecT Void Text (RIO AppState) Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token Text -> ParsecT Void Text (RIO AppState) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'_')

definitionNameP :: Parser DefinitionName
definitionNameP :: Parser DefinitionName
definitionNameP = do
  Char
initialTitleCaseCharacter <- ParsecT Void Text (RIO AppState) Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
upperChar
  ((Char
initialTitleCaseCharacter Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:) (FilePath -> FilePath)
-> (FilePath -> DefinitionName) -> FilePath -> DefinitionName
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> FilePath -> Text
pack (FilePath -> Text)
-> (Text -> DefinitionName) -> FilePath -> DefinitionName
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Text -> DefinitionName
DefinitionName) (FilePath -> DefinitionName)
-> ParsecT Void Text (RIO AppState) FilePath
-> Parser DefinitionName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text (RIO AppState) Char
-> ParsecT Void Text (RIO AppState) FilePath
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT Void Text (RIO AppState) Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar

setCurrentDefinitionName :: DefinitionName -> Parser ()
setCurrentDefinitionName :: DefinitionName -> Parser ()
setCurrentDefinitionName DefinitionName
name = do
  AppState {IORef (Maybe DefinitionName)
currentDefinitionNameReference :: IORef (Maybe DefinitionName)
$sel:currentDefinitionNameReference:AppState :: AppState -> IORef (Maybe DefinitionName)
currentDefinitionNameReference} <- ParsecT Void Text (RIO AppState) AppState
forall r (m :: * -> *). MonadReader r m => m r
ask
  IORef (Maybe DefinitionName) -> Maybe DefinitionName -> Parser ()
forall (m :: * -> *) a. MonadIO m => IORef a -> a -> m ()
writeIORef IORef (Maybe DefinitionName)
currentDefinitionNameReference (DefinitionName -> Maybe DefinitionName
forall a. a -> Maybe a
Just DefinitionName
name)

recursiveReferenceP :: Parser DefinitionName
recursiveReferenceP :: Parser DefinitionName
recursiveReferenceP = do
  AppState {IORef (Maybe DefinitionName)
currentDefinitionNameReference :: IORef (Maybe DefinitionName)
$sel:currentDefinitionNameReference:AppState :: AppState -> IORef (Maybe DefinitionName)
currentDefinitionNameReference} <- ParsecT Void Text (RIO AppState) AppState
forall r (m :: * -> *). MonadReader r m => m r
ask
  Maybe DefinitionName
maybeCurrentDefinitionName <- IORef (Maybe DefinitionName)
-> ParsecT Void Text (RIO AppState) (Maybe DefinitionName)
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef IORef (Maybe DefinitionName)
currentDefinitionNameReference
  case Maybe DefinitionName
maybeCurrentDefinitionName of
    Just currentDefinitionName :: DefinitionName
currentDefinitionName@(DefinitionName Text
n) -> do
      Text
_ <- Tokens Text -> ParsecT Void Text (RIO AppState) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Text
Tokens Text
n
      pure DefinitionName
currentDefinitionName
    Maybe DefinitionName
Nothing ->
      FilePath -> Parser DefinitionName
forall a. FilePath -> Parser a
reportError FilePath
"Recursive reference not valid when we have no current definition name"

definitionReferenceP :: [TypeVariable] -> Parser DefinitionReference
definitionReferenceP :: [TypeVariable]
-> ParsecT Void Text (RIO AppState) DefinitionReference
definitionReferenceP [TypeVariable]
typeVariables = do
  [TypeDefinition]
definitions <- ParsecT Void Text (RIO AppState) [TypeDefinition]
getDefinitions
  let definitionNames :: [Text]
definitionNames =
        [TypeDefinition]
definitions
          [TypeDefinition] -> ([TypeDefinition] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (TypeDefinition -> Text) -> [TypeDefinition] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
List.map (\(TypeDefinition (DefinitionName Text
n) TypeData
_typeData) -> Text
n)
          [Text] -> ([Text] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (Text -> Text -> Ordering) -> [Text] -> [Text]
forall a. (a -> a -> Ordering) -> [a] -> [a]
List.sortBy (\Text
n1 Text
n2 -> Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Text -> Int
Text.length Text
n2) (Text -> Int
Text.length Text
n1))
  soughtName :: DefinitionName
soughtName@(DefinitionName Text
n) <- Text -> DefinitionName
DefinitionName (Text -> DefinitionName)
-> ParsecT Void Text (RIO AppState) Text -> Parser DefinitionName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ParsecT Void Text (RIO AppState) Text]
-> ParsecT Void Text (RIO AppState) Text
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ((Text -> ParsecT Void Text (RIO AppState) Text)
-> [Text] -> [ParsecT Void Text (RIO AppState) Text]
forall a b. (a -> b) -> [a] -> [b]
List.map Text -> ParsecT Void Text (RIO AppState) Text
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string [Text]
definitionNames)
  Maybe TypeDefinition
maybeDefinition <- DefinitionName -> Parser (Maybe TypeDefinition)
getDefinition DefinitionName
soughtName
  Maybe [FieldType]
maybeTypeVariables <-
    Parser [FieldType]
-> ParsecT Void Text (RIO AppState) (Maybe [FieldType])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser [FieldType]
 -> ParsecT Void Text (RIO AppState) (Maybe [FieldType]))
-> Parser [FieldType]
-> ParsecT Void Text (RIO AppState) (Maybe [FieldType])
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text (RIO AppState) Char
-> ParsecT Void Text (RIO AppState) Char
-> Parser [FieldType]
-> Parser [FieldType]
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token Text -> ParsecT Void Text (RIO AppState) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'<') (Token Text -> ParsecT Void Text (RIO AppState) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'>') (Parser [FieldType] -> Parser [FieldType])
-> Parser [FieldType] -> Parser [FieldType]
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text (RIO AppState) FieldType
-> ParsecT Void Text (RIO AppState) Text -> Parser [FieldType]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy1 ([TypeVariable] -> ParsecT Void Text (RIO AppState) FieldType
fieldTypeP [TypeVariable]
typeVariables) (Tokens Text -> ParsecT Void Text (RIO AppState) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
", ")
  case Maybe TypeDefinition
maybeDefinition of
    Just (TypeDefinition DefinitionName
name' (DeclaredType ModuleName
moduleName [TypeVariable]
_typeVariables)) ->
      case Maybe [FieldType]
maybeTypeVariables of
        Maybe [FieldType]
Nothing ->
          DefinitionReference
-> ParsecT Void Text (RIO AppState) DefinitionReference
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DefinitionReference
 -> ParsecT Void Text (RIO AppState) DefinitionReference)
-> DefinitionReference
-> ParsecT Void Text (RIO AppState) DefinitionReference
forall a b. (a -> b) -> a -> b
$ ModuleName -> DefinitionName -> DefinitionReference
DeclarationReference ModuleName
moduleName DefinitionName
name'
        Just [FieldType]
appliedTypes ->
          DefinitionReference
-> ParsecT Void Text (RIO AppState) DefinitionReference
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DefinitionReference
 -> ParsecT Void Text (RIO AppState) DefinitionReference)
-> DefinitionReference
-> ParsecT Void Text (RIO AppState) DefinitionReference
forall a b. (a -> b) -> a -> b
$ ModuleName -> DefinitionName -> AppliedTypes -> DefinitionReference
GenericDeclarationReference ModuleName
moduleName DefinitionName
name' ([FieldType] -> AppliedTypes
AppliedTypes [FieldType]
appliedTypes)
    Just TypeDefinition
definition -> do
      case Maybe [FieldType]
maybeTypeVariables of
        Just [FieldType]
appliedTypeVariables ->
          DefinitionReference
-> ParsecT Void Text (RIO AppState) DefinitionReference
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DefinitionReference
 -> ParsecT Void Text (RIO AppState) DefinitionReference)
-> DefinitionReference
-> ParsecT Void Text (RIO AppState) DefinitionReference
forall a b. (a -> b) -> a -> b
$ [FieldType] -> TypeDefinition -> DefinitionReference
AppliedGenericReference [FieldType]
appliedTypeVariables TypeDefinition
definition
        Maybe [FieldType]
Nothing ->
          DefinitionReference
-> ParsecT Void Text (RIO AppState) DefinitionReference
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DefinitionReference
 -> ParsecT Void Text (RIO AppState) DefinitionReference)
-> DefinitionReference
-> ParsecT Void Text (RIO AppState) DefinitionReference
forall a b. (a -> b) -> a -> b
$ TypeDefinition -> DefinitionReference
DefinitionReference TypeDefinition
definition
    Maybe TypeDefinition
Nothing -> FilePath -> ParsecT Void Text (RIO AppState) DefinitionReference
forall a. FilePath -> Parser a
reportError (FilePath -> ParsecT Void Text (RIO AppState) DefinitionReference)
-> FilePath -> ParsecT Void Text (RIO AppState) DefinitionReference
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
forall a. Monoid a => [a] -> a
mconcat [FilePath
"Unknown type reference: ", Text -> FilePath
unpack Text
n]

getDefinitions :: Parser [TypeDefinition]
getDefinitions :: ParsecT Void Text (RIO AppState) [TypeDefinition]
getDefinitions = do
  AppState {IORef [TypeDefinition]
currentDefinitionsReference :: IORef [TypeDefinition]
$sel:currentDefinitionsReference:AppState :: AppState -> IORef [TypeDefinition]
currentDefinitionsReference} <- ParsecT Void Text (RIO AppState) AppState
forall r (m :: * -> *). MonadReader r m => m r
ask
  IORef [TypeDefinition]
-> ParsecT Void Text (RIO AppState) [TypeDefinition]
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef IORef [TypeDefinition]
currentDefinitionsReference

getDefinition :: DefinitionName -> Parser (Maybe TypeDefinition)
getDefinition :: DefinitionName -> Parser (Maybe TypeDefinition)
getDefinition DefinitionName
name = do
  AppState {IORef [TypeDefinition]
currentDefinitionsReference :: IORef [TypeDefinition]
$sel:currentDefinitionsReference:AppState :: AppState -> IORef [TypeDefinition]
currentDefinitionsReference} <- ParsecT Void Text (RIO AppState) AppState
forall r (m :: * -> *). MonadReader r m => m r
ask
  [TypeDefinition]
definitions <- IORef [TypeDefinition]
-> ParsecT Void Text (RIO AppState) [TypeDefinition]
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef IORef [TypeDefinition]
currentDefinitionsReference
  pure $
    (TypeDefinition -> Bool)
-> [TypeDefinition] -> Maybe TypeDefinition
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find (\(TypeDefinition DefinitionName
definitionName TypeData
_typeData) -> DefinitionName
name DefinitionName -> DefinitionName -> Bool
forall a. Eq a => a -> a -> Bool
== DefinitionName
definitionName) [TypeDefinition]
definitions

addDefinition :: TypeDefinition -> Parser ()
addDefinition :: TypeDefinition -> Parser ()
addDefinition definition :: TypeDefinition
definition@(TypeDefinition (DefinitionName Text
definitionName) TypeData
_typeData) = do
  AppState {IORef [TypeDefinition]
currentDefinitionsReference :: IORef [TypeDefinition]
$sel:currentDefinitionsReference:AppState :: AppState -> IORef [TypeDefinition]
currentDefinitionsReference} <- ParsecT Void Text (RIO AppState) AppState
forall r (m :: * -> *). MonadReader r m => m r
ask
  [TypeDefinition]
definitions <- IORef [TypeDefinition]
-> ParsecT Void Text (RIO AppState) [TypeDefinition]
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef IORef [TypeDefinition]
currentDefinitionsReference
  if Bool -> Bool
not (TypeDefinition -> [TypeDefinition] -> Bool
hasDefinition TypeDefinition
definition [TypeDefinition]
definitions)
    then IORef [TypeDefinition]
-> ([TypeDefinition] -> [TypeDefinition]) -> Parser ()
forall (m :: * -> *) a. MonadIO m => IORef a -> (a -> a) -> m ()
modifyIORef IORef [TypeDefinition]
currentDefinitionsReference (TypeDefinition
definition TypeDefinition -> [TypeDefinition] -> [TypeDefinition]
forall a. a -> [a] -> [a]
:)
    else FilePath -> Parser ()
forall a. FilePath -> Parser a
reportError (FilePath -> Parser ()) -> FilePath -> Parser ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Duplicate definition with name '" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
unpack Text
definitionName FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"'"

clearDefinitions :: Parser ()
clearDefinitions :: Parser ()
clearDefinitions = do
  AppState {IORef [TypeDefinition]
currentDefinitionsReference :: IORef [TypeDefinition]
$sel:currentDefinitionsReference:AppState :: AppState -> IORef [TypeDefinition]
currentDefinitionsReference} <- ParsecT Void Text (RIO AppState) AppState
forall r (m :: * -> *). MonadReader r m => m r
ask
  IORef [TypeDefinition] -> [TypeDefinition] -> Parser ()
forall (m :: * -> *) a. MonadIO m => IORef a -> a -> m ()
writeIORef IORef [TypeDefinition]
currentDefinitionsReference [TypeDefinition]
forall a. Monoid a => a
mempty

hasDefinition :: TypeDefinition -> [TypeDefinition] -> Bool
hasDefinition :: TypeDefinition -> [TypeDefinition] -> Bool
hasDefinition (TypeDefinition DefinitionName
name TypeData
_typeData) =
  (TypeDefinition -> Bool) -> [TypeDefinition] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(TypeDefinition DefinitionName
name' TypeData
_typeData) -> DefinitionName
name DefinitionName -> DefinitionName -> Bool
forall a. Eq a => a -> a -> Bool
== DefinitionName
name')

fieldTypeP :: [TypeVariable] -> Parser FieldType
fieldTypeP :: [TypeVariable] -> ParsecT Void Text (RIO AppState) FieldType
fieldTypeP [TypeVariable]
typeVariables =
  [ParsecT Void Text (RIO AppState) FieldType]
-> ParsecT Void Text (RIO AppState) FieldType
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ LiteralTypeValue -> FieldType
LiteralType (LiteralTypeValue -> FieldType)
-> Parser LiteralTypeValue
-> ParsecT Void Text (RIO AppState) FieldType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser LiteralTypeValue
literalP,
      ComplexTypeValue -> FieldType
ComplexType (ComplexTypeValue -> FieldType)
-> ParsecT Void Text (RIO AppState) ComplexTypeValue
-> ParsecT Void Text (RIO AppState) FieldType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeVariable] -> ParsecT Void Text (RIO AppState) ComplexTypeValue
complexTypeP [TypeVariable]
typeVariables,
      TypeVariable -> FieldType
TypeVariableReferenceType (TypeVariable -> FieldType)
-> ParsecT Void Text (RIO AppState) TypeVariable
-> ParsecT Void Text (RIO AppState) FieldType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeVariable] -> ParsecT Void Text (RIO AppState) TypeVariable
typeVariableReferenceP [TypeVariable]
typeVariables,
      DefinitionReference -> FieldType
DefinitionReferenceType (DefinitionReference -> FieldType)
-> ParsecT Void Text (RIO AppState) DefinitionReference
-> ParsecT Void Text (RIO AppState) FieldType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeVariable]
-> ParsecT Void Text (RIO AppState) DefinitionReference
definitionReferenceP [TypeVariable]
typeVariables,
      BasicTypeValue -> FieldType
BasicType (BasicTypeValue -> FieldType)
-> ParsecT Void Text (RIO AppState) BasicTypeValue
-> ParsecT Void Text (RIO AppState) FieldType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text (RIO AppState) BasicTypeValue
basicTypeValueP,
      DefinitionReference -> FieldType
DefinitionReferenceType (DefinitionReference -> FieldType)
-> ParsecT Void Text (RIO AppState) DefinitionReference
-> ParsecT Void Text (RIO AppState) FieldType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeVariable]
-> ParsecT Void Text (RIO AppState) DefinitionReference
importedReferenceP [TypeVariable]
typeVariables,
      DefinitionName -> FieldType
RecursiveReferenceType (DefinitionName -> FieldType)
-> Parser DefinitionName
-> ParsecT Void Text (RIO AppState) FieldType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser DefinitionName
recursiveReferenceP
    ]

typeVariableReferenceP :: [TypeVariable] -> Parser TypeVariable
typeVariableReferenceP :: [TypeVariable] -> ParsecT Void Text (RIO AppState) TypeVariable
typeVariableReferenceP [TypeVariable]
typeVariables =
  Text -> TypeVariable
TypeVariable (Text -> TypeVariable)
-> ParsecT Void Text (RIO AppState) Text
-> ParsecT Void Text (RIO AppState) TypeVariable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ParsecT Void Text (RIO AppState) Text]
-> ParsecT Void Text (RIO AppState) Text
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ((TypeVariable -> ParsecT Void Text (RIO AppState) Text)
-> [TypeVariable] -> [ParsecT Void Text (RIO AppState) Text]
forall a b. (a -> b) -> [a] -> [b]
List.map (\(TypeVariable Text
t) -> Tokens Text -> ParsecT Void Text (RIO AppState) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Text
Tokens Text
t) [TypeVariable]
typeVariables)

importedReferenceP :: [TypeVariable] -> Parser DefinitionReference
importedReferenceP :: [TypeVariable]
-> ParsecT Void Text (RIO AppState) DefinitionReference
importedReferenceP [TypeVariable]
typeVariables = do
  [Import]
imports <- ParsecT Void Text (RIO AppState) [Import]
getImports
  Text
moduleName <-
    [ParsecT Void Text (RIO AppState) Text]
-> ParsecT Void Text (RIO AppState) Text
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ((Import -> ParsecT Void Text (RIO AppState) Text)
-> [Import] -> [ParsecT Void Text (RIO AppState) Text]
forall a b. (a -> b) -> [a] -> [b]
List.map (\(Import Module {$sel:name:Module :: Module -> ModuleName
name = ModuleName Text
name}) -> Tokens Text -> ParsecT Void Text (RIO AppState) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Text
Tokens Text
name) [Import]
imports) ParsecT Void Text (RIO AppState) Text
-> ParsecT Void Text (RIO AppState) Char
-> ParsecT Void Text (RIO AppState) Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token Text -> ParsecT Void Text (RIO AppState) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'.'
  definitionName :: DefinitionName
definitionName@(DefinitionName Text
n) <- Parser DefinitionName
definitionNameP
  Maybe Import
maybeModule <- Text -> Parser (Maybe Import)
getImport Text
moduleName
  case Maybe Import
maybeModule of
    Just (Import Module {$sel:name:Module :: Module -> ModuleName
name = ModuleName
sourceModule, [TypeDefinition]
definitions :: [TypeDefinition]
$sel:definitions:Module :: Module -> [TypeDefinition]
definitions}) -> do
      case (TypeDefinition -> Bool)
-> [TypeDefinition] -> Maybe TypeDefinition
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find (\(TypeDefinition DefinitionName
name TypeData
_typeData) -> DefinitionName
name DefinitionName -> DefinitionName -> Bool
forall a. Eq a => a -> a -> Bool
== DefinitionName
definitionName) [TypeDefinition]
definitions of
        Just definition :: TypeDefinition
definition@(TypeDefinition DefinitionName
foundDefinitionName TypeData
typeData) -> do
          Maybe [FieldType]
maybeTypeVariables <-
            Parser [FieldType]
-> ParsecT Void Text (RIO AppState) (Maybe [FieldType])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser [FieldType]
 -> ParsecT Void Text (RIO AppState) (Maybe [FieldType]))
-> Parser [FieldType]
-> ParsecT Void Text (RIO AppState) (Maybe [FieldType])
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text (RIO AppState) Char
-> ParsecT Void Text (RIO AppState) Char
-> Parser [FieldType]
-> Parser [FieldType]
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token Text -> ParsecT Void Text (RIO AppState) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'<') (Token Text -> ParsecT Void Text (RIO AppState) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'>') (Parser [FieldType] -> Parser [FieldType])
-> Parser [FieldType] -> Parser [FieldType]
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text (RIO AppState) FieldType
-> ParsecT Void Text (RIO AppState) Text -> Parser [FieldType]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy1 ([TypeVariable] -> ParsecT Void Text (RIO AppState) FieldType
fieldTypeP [TypeVariable]
typeVariables) (Tokens Text -> ParsecT Void Text (RIO AppState) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
", ")
          pure $ case Maybe [FieldType]
maybeTypeVariables of
            Just [FieldType]
appliedTypeVariables ->
              ModuleName -> AppliedTypes -> TypeDefinition -> DefinitionReference
AppliedImportedGenericReference
                (Text -> ModuleName
ModuleName Text
moduleName)
                ([FieldType] -> AppliedTypes
AppliedTypes [FieldType]
appliedTypeVariables)
                TypeDefinition
definition
            Maybe [FieldType]
Nothing ->
              ModuleName -> TypeDefinition -> DefinitionReference
ImportedDefinitionReference ModuleName
sourceModule (TypeDefinition -> DefinitionReference)
-> TypeDefinition -> DefinitionReference
forall a b. (a -> b) -> a -> b
$ DefinitionName -> TypeData -> TypeDefinition
TypeDefinition DefinitionName
foundDefinitionName TypeData
typeData
        Maybe TypeDefinition
Nothing ->
          FilePath -> ParsecT Void Text (RIO AppState) DefinitionReference
forall a. FilePath -> Parser a
reportError (FilePath -> ParsecT Void Text (RIO AppState) DefinitionReference)
-> FilePath -> ParsecT Void Text (RIO AppState) DefinitionReference
forall a b. (a -> b) -> a -> b
$
            [FilePath] -> FilePath
forall a. Monoid a => [a] -> a
mconcat
              [ FilePath
"Unknown definition in module '",
                Text -> FilePath
unpack Text
moduleName,
                FilePath
"': ",
                Text -> FilePath
unpack Text
n
              ]
    Maybe Import
Nothing ->
      FilePath -> ParsecT Void Text (RIO AppState) DefinitionReference
forall a. FilePath -> Parser a
reportError (FilePath -> ParsecT Void Text (RIO AppState) DefinitionReference)
-> FilePath -> ParsecT Void Text (RIO AppState) DefinitionReference
forall a b. (a -> b) -> a -> b
$ FilePath
"Unknown module referenced, not in imports: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
unpack Text
moduleName

getImports :: Parser [Import]
getImports :: ParsecT Void Text (RIO AppState) [Import]
getImports = do
  AppState {IORef [Import]
currentImportsReference :: IORef [Import]
$sel:currentImportsReference:AppState :: AppState -> IORef [Import]
currentImportsReference} <- ParsecT Void Text (RIO AppState) AppState
forall r (m :: * -> *). MonadReader r m => m r
ask
  IORef [Import] -> ParsecT Void Text (RIO AppState) [Import]
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef IORef [Import]
currentImportsReference

getImport :: Text -> Parser (Maybe Import)
getImport :: Text -> Parser (Maybe Import)
getImport Text
soughtName = do
  AppState {IORef [Import]
currentImportsReference :: IORef [Import]
$sel:currentImportsReference:AppState :: AppState -> IORef [Import]
currentImportsReference} <- ParsecT Void Text (RIO AppState) AppState
forall r (m :: * -> *). MonadReader r m => m r
ask
  [Import]
imports <- IORef [Import] -> ParsecT Void Text (RIO AppState) [Import]
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef IORef [Import]
currentImportsReference
  pure $ (Import -> Bool) -> [Import] -> Maybe Import
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find (\(Import Module {$sel:name:Module :: Module -> ModuleName
name = ModuleName Text
name}) -> Text
soughtName Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
name) [Import]
imports

reportError :: String -> Parser a
reportError :: FilePath -> Parser a
reportError = FilePath -> ErrorFancy Void
forall e. FilePath -> ErrorFancy e
ErrorFail (FilePath -> ErrorFancy Void)
-> (ErrorFancy Void -> Parser a) -> FilePath -> Parser a
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ErrorFancy Void -> Set (ErrorFancy Void)
forall a. a -> Set a
Set.singleton (ErrorFancy Void -> Set (ErrorFancy Void))
-> (Set (ErrorFancy Void) -> Parser a)
-> ErrorFancy Void
-> Parser a
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Set (ErrorFancy Void) -> Parser a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
Set (ErrorFancy e) -> m a
fancyFailure

basicTypeValueP :: Parser BasicTypeValue
basicTypeValueP :: ParsecT Void Text (RIO AppState) BasicTypeValue
basicTypeValueP = [ParsecT Void Text (RIO AppState) BasicTypeValue]
-> ParsecT Void Text (RIO AppState) BasicTypeValue
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [ParsecT Void Text (RIO AppState) BasicTypeValue
uintP, ParsecT Void Text (RIO AppState) BasicTypeValue
intP, ParsecT Void Text (RIO AppState) BasicTypeValue
floatP, ParsecT Void Text (RIO AppState) BasicTypeValue
booleanP, ParsecT Void Text (RIO AppState) BasicTypeValue
basicStringP]

complexTypeP :: [TypeVariable] -> Parser ComplexTypeValue
complexTypeP :: [TypeVariable] -> ParsecT Void Text (RIO AppState) ComplexTypeValue
complexTypeP [TypeVariable]
typeVariables =
  [ParsecT Void Text (RIO AppState) ComplexTypeValue]
-> ParsecT Void Text (RIO AppState) ComplexTypeValue
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ [TypeVariable] -> ParsecT Void Text (RIO AppState) ComplexTypeValue
sliceTypeP [TypeVariable]
typeVariables,
      [TypeVariable] -> ParsecT Void Text (RIO AppState) ComplexTypeValue
arrayTypeP [TypeVariable]
typeVariables,
      [TypeVariable] -> ParsecT Void Text (RIO AppState) ComplexTypeValue
optionalTypeP [TypeVariable]
typeVariables,
      [TypeVariable] -> ParsecT Void Text (RIO AppState) ComplexTypeValue
pointerTypeP [TypeVariable]
typeVariables
    ]

sliceTypeP :: [TypeVariable] -> Parser ComplexTypeValue
sliceTypeP :: [TypeVariable] -> ParsecT Void Text (RIO AppState) ComplexTypeValue
sliceTypeP [TypeVariable]
typeVariables = FieldType -> ComplexTypeValue
SliceType (FieldType -> ComplexTypeValue)
-> ParsecT Void Text (RIO AppState) FieldType
-> ParsecT Void Text (RIO AppState) ComplexTypeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text (RIO AppState) Text
-> ParsecT Void Text (RIO AppState) FieldType
-> ParsecT Void Text (RIO AppState) FieldType
forall ignored a. Parser ignored -> Parser a -> Parser a
precededBy (Tokens Text -> ParsecT Void Text (RIO AppState) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[]") ([TypeVariable] -> ParsecT Void Text (RIO AppState) FieldType
fieldTypeP [TypeVariable]
typeVariables)

arrayTypeP :: [TypeVariable] -> Parser ComplexTypeValue
arrayTypeP :: [TypeVariable] -> ParsecT Void Text (RIO AppState) ComplexTypeValue
arrayTypeP [TypeVariable]
typeVariables = do
  Integer
size <- ParsecT Void Text (RIO AppState) Char
-> ParsecT Void Text (RIO AppState) Char
-> ParsecT Void Text (RIO AppState) Integer
-> ParsecT Void Text (RIO AppState) Integer
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token Text -> ParsecT Void Text (RIO AppState) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'[') (Token Text -> ParsecT Void Text (RIO AppState) (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 (RIO AppState) Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal
  Integer -> FieldType -> ComplexTypeValue
ArrayType Integer
size (FieldType -> ComplexTypeValue)
-> ParsecT Void Text (RIO AppState) FieldType
-> ParsecT Void Text (RIO AppState) ComplexTypeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeVariable] -> ParsecT Void Text (RIO AppState) FieldType
fieldTypeP [TypeVariable]
typeVariables

optionalTypeP :: [TypeVariable] -> Parser ComplexTypeValue
optionalTypeP :: [TypeVariable] -> ParsecT Void Text (RIO AppState) ComplexTypeValue
optionalTypeP [TypeVariable]
typeVariables = FieldType -> ComplexTypeValue
OptionalType (FieldType -> ComplexTypeValue)
-> ParsecT Void Text (RIO AppState) FieldType
-> ParsecT Void Text (RIO AppState) ComplexTypeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text (RIO AppState) Char
-> ParsecT Void Text (RIO AppState) FieldType
-> ParsecT Void Text (RIO AppState) FieldType
forall ignored a. Parser ignored -> Parser a -> Parser a
precededBy (Token Text -> ParsecT Void Text (RIO AppState) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'?') ([TypeVariable] -> ParsecT Void Text (RIO AppState) FieldType
fieldTypeP [TypeVariable]
typeVariables)

pointerTypeP :: [TypeVariable] -> Parser ComplexTypeValue
pointerTypeP :: [TypeVariable] -> ParsecT Void Text (RIO AppState) ComplexTypeValue
pointerTypeP [TypeVariable]
typeVariables = FieldType -> ComplexTypeValue
PointerType (FieldType -> ComplexTypeValue)
-> ParsecT Void Text (RIO AppState) FieldType
-> ParsecT Void Text (RIO AppState) ComplexTypeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text (RIO AppState) Char
-> ParsecT Void Text (RIO AppState) FieldType
-> ParsecT Void Text (RIO AppState) FieldType
forall ignored a. Parser ignored -> Parser a -> Parser a
precededBy (Token Text -> ParsecT Void Text (RIO AppState) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'*') ([TypeVariable] -> ParsecT Void Text (RIO AppState) FieldType
fieldTypeP [TypeVariable]
typeVariables)

precededBy :: Parser ignored -> Parser a -> Parser a
precededBy :: Parser ignored -> Parser a -> Parser a
precededBy Parser ignored
precededParser Parser a
parser = do
  ignored
_ <- Parser ignored
precededParser
  Parser a
parser

integerSizes :: [Int]
integerSizes :: [Int]
integerSizes = [Int
8, Int
16, Int
32, Int
64, Int
128]

integerTypeParsers :: Text -> [Parser Text]
integerTypeParsers :: Text -> [ParsecT Void Text (RIO AppState) Text]
integerTypeParsers Text
prefix = (Int -> ParsecT Void Text (RIO AppState) Text)
-> [Int] -> [ParsecT Void Text (RIO AppState) Text]
forall a b. (a -> b) -> [a] -> [b]
List.map (Int -> FilePath
forall a. Show a => a -> FilePath
show (Int -> FilePath)
-> (FilePath -> ParsecT Void Text (RIO AppState) Text)
-> Int
-> ParsecT Void Text (RIO AppState) Text
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> FilePath -> Text
pack (FilePath -> Text)
-> (Text -> ParsecT Void Text (RIO AppState) Text)
-> FilePath
-> ParsecT Void Text (RIO AppState) Text
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text)
-> (Text -> ParsecT Void Text (RIO AppState) Text)
-> Text
-> ParsecT Void Text (RIO AppState) Text
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Text -> ParsecT Void Text (RIO AppState) Text
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string) [Int]
integerSizes

uintP :: Parser BasicTypeValue
uintP :: ParsecT Void Text (RIO AppState) BasicTypeValue
uintP = do
  Text
uint <- [ParsecT Void Text (RIO AppState) Text]
-> ParsecT Void Text (RIO AppState) Text
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([ParsecT Void Text (RIO AppState) Text]
 -> ParsecT Void Text (RIO AppState) Text)
-> [ParsecT Void Text (RIO AppState) Text]
-> ParsecT Void Text (RIO AppState) Text
forall a b. (a -> b) -> a -> b
$ Text -> [ParsecT Void Text (RIO AppState) Text]
integerTypeParsers Text
"U"
  case Text
uint of
    Text
"U8" -> BasicTypeValue -> ParsecT Void Text (RIO AppState) BasicTypeValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure BasicTypeValue
U8
    Text
"U16" -> BasicTypeValue -> ParsecT Void Text (RIO AppState) BasicTypeValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure BasicTypeValue
U16
    Text
"U32" -> BasicTypeValue -> ParsecT Void Text (RIO AppState) BasicTypeValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure BasicTypeValue
U32
    Text
"U64" -> BasicTypeValue -> ParsecT Void Text (RIO AppState) BasicTypeValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure BasicTypeValue
U64
    Text
"U128" -> BasicTypeValue -> ParsecT Void Text (RIO AppState) BasicTypeValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure BasicTypeValue
U128
    Text
other -> FilePath -> ParsecT Void Text (RIO AppState) BasicTypeValue
forall a. FilePath -> Parser a
reportError (FilePath -> ParsecT Void Text (RIO AppState) BasicTypeValue)
-> FilePath -> ParsecT Void Text (RIO AppState) BasicTypeValue
forall a b. (a -> b) -> a -> b
$ FilePath
"Invalid size for Ux: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
unpack Text
other

intP :: Parser BasicTypeValue
intP :: ParsecT Void Text (RIO AppState) BasicTypeValue
intP = do
  Text
int <- [ParsecT Void Text (RIO AppState) Text]
-> ParsecT Void Text (RIO AppState) Text
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([ParsecT Void Text (RIO AppState) Text]
 -> ParsecT Void Text (RIO AppState) Text)
-> [ParsecT Void Text (RIO AppState) Text]
-> ParsecT Void Text (RIO AppState) Text
forall a b. (a -> b) -> a -> b
$ Text -> [ParsecT Void Text (RIO AppState) Text]
integerTypeParsers Text
"I"
  case Text
int of
    Text
"I8" -> BasicTypeValue -> ParsecT Void Text (RIO AppState) BasicTypeValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure BasicTypeValue
I8
    Text
"I16" -> BasicTypeValue -> ParsecT Void Text (RIO AppState) BasicTypeValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure BasicTypeValue
I16
    Text
"I32" -> BasicTypeValue -> ParsecT Void Text (RIO AppState) BasicTypeValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure BasicTypeValue
I32
    Text
"I64" -> BasicTypeValue -> ParsecT Void Text (RIO AppState) BasicTypeValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure BasicTypeValue
I64
    Text
"I128" -> BasicTypeValue -> ParsecT Void Text (RIO AppState) BasicTypeValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure BasicTypeValue
I128
    Text
other -> FilePath -> ParsecT Void Text (RIO AppState) BasicTypeValue
forall a. FilePath -> Parser a
reportError (FilePath -> ParsecT Void Text (RIO AppState) BasicTypeValue)
-> FilePath -> ParsecT Void Text (RIO AppState) BasicTypeValue
forall a b. (a -> b) -> a -> b
$ FilePath
"Invalid size for Ix: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
unpack Text
other

floatP :: Parser BasicTypeValue
floatP :: ParsecT Void Text (RIO AppState) BasicTypeValue
floatP = do
  Text
int <- [ParsecT Void Text (RIO AppState) Text]
-> ParsecT Void Text (RIO AppState) Text
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [Tokens Text -> ParsecT Void Text (RIO AppState) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"F32", ParsecT Void Text (RIO AppState) Text
"F64"]
  case Text
int of
    Text
"F32" -> BasicTypeValue -> ParsecT Void Text (RIO AppState) BasicTypeValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure BasicTypeValue
F32
    Text
"F64" -> BasicTypeValue -> ParsecT Void Text (RIO AppState) BasicTypeValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure BasicTypeValue
F64
    Text
other -> FilePath -> ParsecT Void Text (RIO AppState) BasicTypeValue
forall a. FilePath -> Parser a
reportError (FilePath -> ParsecT Void Text (RIO AppState) BasicTypeValue)
-> FilePath -> ParsecT Void Text (RIO AppState) BasicTypeValue
forall a b. (a -> b) -> a -> b
$ FilePath
"Invalid size for Fx: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
unpack Text
other

booleanP :: Parser BasicTypeValue
booleanP :: ParsecT Void Text (RIO AppState) BasicTypeValue
booleanP = Tokens Text -> ParsecT Void Text (RIO AppState) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"Boolean" ParsecT Void Text (RIO AppState) Text
-> BasicTypeValue
-> ParsecT Void Text (RIO AppState) BasicTypeValue
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> BasicTypeValue
Boolean

basicStringP :: Parser BasicTypeValue
basicStringP :: ParsecT Void Text (RIO AppState) BasicTypeValue
basicStringP = Tokens Text -> ParsecT Void Text (RIO AppState) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"String" ParsecT Void Text (RIO AppState) Text
-> BasicTypeValue
-> ParsecT Void Text (RIO AppState) BasicTypeValue
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> BasicTypeValue
BasicString

literalP :: Parser LiteralTypeValue
literalP :: Parser LiteralTypeValue
literalP = [Parser LiteralTypeValue] -> Parser LiteralTypeValue
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [Parser LiteralTypeValue
literalStringP, Parser LiteralTypeValue
literalIntegerP, Parser LiteralTypeValue
literalFloatP, Parser LiteralTypeValue
literalBooleanP]

literalStringP :: Parser LiteralTypeValue
literalStringP :: Parser LiteralTypeValue
literalStringP = (FilePath -> Text
pack (FilePath -> Text)
-> (Text -> LiteralTypeValue) -> FilePath -> LiteralTypeValue
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Text -> LiteralTypeValue
LiteralString) (FilePath -> LiteralTypeValue)
-> ParsecT Void Text (RIO AppState) FilePath
-> Parser LiteralTypeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text (RIO AppState) Char
-> ParsecT Void Text (RIO AppState) Char
-> ParsecT Void Text (RIO AppState) FilePath
-> ParsecT Void Text (RIO AppState) FilePath
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token Text -> ParsecT Void Text (RIO AppState) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'"') (Token Text -> ParsecT Void Text (RIO AppState) (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 (RIO AppState) Char
-> ParsecT Void Text (RIO AppState) FilePath
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT Void Text (RIO AppState) Char
stringCharacterP)

stringCharacterP :: Parser Char
stringCharacterP :: ParsecT Void Text (RIO AppState) Char
stringCharacterP = ParsecT Void Text (RIO AppState) Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar ParsecT Void Text (RIO AppState) Char
-> ParsecT Void Text (RIO AppState) Char
-> ParsecT Void Text (RIO AppState) Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text (RIO AppState) Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
spaceChar

literalIntegerP :: Parser LiteralTypeValue
literalIntegerP :: Parser LiteralTypeValue
literalIntegerP = Integer -> LiteralTypeValue
LiteralInteger (Integer -> LiteralTypeValue)
-> ParsecT Void Text (RIO AppState) Integer
-> Parser LiteralTypeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text (RIO AppState) Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal

literalFloatP :: Parser LiteralTypeValue
literalFloatP :: Parser LiteralTypeValue
literalFloatP = Float -> LiteralTypeValue
LiteralFloat (Float -> LiteralTypeValue)
-> ParsecT Void Text (RIO AppState) Float
-> Parser LiteralTypeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text (RIO AppState) Float
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, RealFloat a) =>
m a
float

literalBooleanP :: Parser LiteralTypeValue
literalBooleanP :: Parser LiteralTypeValue
literalBooleanP = Bool -> LiteralTypeValue
LiteralBoolean (Bool -> LiteralTypeValue)
-> ParsecT Void Text (RIO AppState) Bool -> Parser LiteralTypeValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ParsecT Void Text (RIO AppState) Bool]
-> ParsecT Void Text (RIO AppState) Bool
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [ParsecT Void Text (RIO AppState) Bool
trueP, ParsecT Void Text (RIO AppState) Bool
falseP]

trueP :: Parser Bool
trueP :: ParsecT Void Text (RIO AppState) Bool
trueP = Tokens Text -> ParsecT Void Text (RIO AppState) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"true" ParsecT Void Text (RIO AppState) Text
-> Bool -> ParsecT Void Text (RIO AppState) Bool
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
True

falseP :: Parser Bool
falseP :: ParsecT Void Text (RIO AppState) Bool
falseP = Tokens Text -> ParsecT Void Text (RIO AppState) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"false" ParsecT Void Text (RIO AppState) Text
-> Bool -> ParsecT Void Text (RIO AppState) Bool
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
False

partialFromRight :: Either l r -> r
partialFromRight :: Either l r -> r
partialFromRight (Right r
r) = r
r
partialFromRight (Left l
_l) = FilePath -> r
forall a. HasCallStack => FilePath -> a
error FilePath
"Unable to get `Right` from `Left`"

partialFromLeft :: Either l r -> l
partialFromLeft :: Either l r -> l
partialFromLeft (Left l
l) = l
l
partialFromLeft (Right r
_r) = FilePath -> l
forall a. HasCallStack => FilePath -> a
error FilePath
"Unable to get `Left` from `Right`"