module Parsing (parseModules, test) where

import qualified CodeGeneration.Utilities as Utilities
import RIO
  ( Bool (..),
    Char,
    Either (..),
    FilePath,
    IO,
    IORef,
    Int,
    Maybe (..),
    RIO,
    Set,
    Show,
    String,
    Text,
    Void,
    any,
    ask,
    compare,
    const,
    error,
    for,
    fromMaybe,
    isLeft,
    length,
    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 hiding (lexeme, symbol)
import qualified Text.Megaparsec.Char.Lexer as 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
    IORef [TypeDefinition] -> [TypeDefinition] -> IO ()
forall (m :: * -> *) a. MonadIO m => IORef a -> a -> m ()
writeIORef IORef [TypeDefinition]
currentDefinitionsReference [TypeDefinition]
forall a. Monoid a => a
mempty
    IORef (Set ModuleName) -> Set ModuleName -> IO ()
forall (m :: * -> *) a. MonadIO m => IORef a -> a -> m ()
writeIORef IORef (Set ModuleName)
currentDeclarationNamesReference Set ModuleName
forall a. Monoid a => a
mempty
    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) FilePath
-> ParsecT Void Text (RIO AppState) [TypeDefinition]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepEndBy1 ParsecT Void Text (RIO AppState) TypeDefinition
typeDefinitionP (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)
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
  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

importP :: Parser Import
importP :: ParsecT Void Text (RIO AppState) Import
importP = do
  Text -> Parser Text
symbol 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 <- [Parser Text] -> Parser Text
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([Parser Text] -> Parser Text) -> [Parser Text] -> Parser Text
forall a b. (a -> b) -> a -> b
$ (Text -> Parser Text) -> [Text] -> [Parser Text]
forall a b. (a -> b) -> [a] -> [b]
List.map Text -> Parser 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" ->
      ParsecT Void Text (RIO AppState) Char
-> ParsecT Void Text (RIO AppState) FilePath
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (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) FilePath
-> 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
        Text
_ <- Text -> Parser Text
symbol 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
      ParsecT Void Text (RIO AppState) Char
-> ParsecT Void Text (RIO AppState) FilePath
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (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) FilePath
-> 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" ->
      ParsecT Void Text (RIO AppState) Char
-> ParsecT Void Text (RIO AppState) FilePath
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (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) FilePath
-> 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" ->
      ParsecT Void Text (RIO AppState) Char
-> ParsecT Void Text (RIO AppState) FilePath
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (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) FilePath
-> 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" ->
      ParsecT Void Text (RIO AppState) Char
-> ParsecT Void Text (RIO AppState) FilePath
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (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) FilePath
-> 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 -> Parser 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
"    " Parser 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 = " Parser 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
  Parser Text -> ParsecT Void Text (RIO AppState) [Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (Parser Text -> ParsecT Void Text (RIO AppState) [Text])
-> Parser 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)
-> Parser 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 -> Parser DefinitionName
forall a. Parser a -> Parser a
lexeme Parser DefinitionName
readCurrentDefinitionName
  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 [TypeVariable]
typeVariables = 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])
-> ParsecT Void Text (RIO AppState) Constructor
-> Parser [Constructor]
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text (RIO AppState) Char
-> ParsecT Void Text (RIO AppState) FilePath
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (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) FilePath
-> ParsecT Void Text (RIO AppState) Constructor
-> ParsecT Void Text (RIO AppState) Constructor
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [TypeVariable] -> ParsecT Void Text (RIO AppState) Constructor
constructorP [TypeVariable]
typeVariables

constructorP :: [TypeVariable] -> Parser Constructor
constructorP :: [TypeVariable] -> ParsecT Void Text (RIO AppState) Constructor
constructorP [TypeVariable]
typeVariables = do
  Text
name <- Parser Text
constructorNameP
  Maybe Text
maybeColon <- Parser Text -> ParsecT Void Text (RIO AppState) (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Text -> ParsecT Void Text (RIO AppState) (Maybe Text))
-> Parser Text -> ParsecT Void Text (RIO AppState) (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Parser Text
symbol 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
-> ParsecT Void Text (RIO AppState) FilePath
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (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) FilePath
-> ParsecT Void Text (RIO AppState) Char
-> ParsecT Void Text (RIO AppState) Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> 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 :: Parser 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 -> Parser DefinitionName
forall a. Parser a -> Parser a
lexeme Parser DefinitionName
readCurrentDefinitionName
  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 -> Parser DefinitionName
forall a. Parser a -> Parser a
lexeme Parser DefinitionName
readCurrentDefinitionName Parser DefinitionName -> Parser 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 <- ParsecT Void Text (RIO AppState) Char
-> ParsecT Void Text (RIO AppState) FilePath
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (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) FilePath
-> Parser Text -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser 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) FilePath
-> ParsecT Void Text (RIO AppState) (Maybe DefinitionReference)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Void Text (RIO AppState) Char
-> ParsecT Void Text (RIO AppState) FilePath
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (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) (Maybe DefinitionReference)
-> ParsecT Void Text (RIO AppState) Char
-> ParsecT Void Text (RIO AppState) (Maybe 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,
        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
<$> (Text -> Parser Text
symbol Text
": " Parser 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) FilePath
-> ParsecT Void Text (RIO AppState) DefinitionReference
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text (RIO AppState) Char
-> ParsecT Void Text (RIO AppState) FilePath
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (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) 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 :: Parser Text
embeddedConstructorNameP = FilePath -> Text
pack (FilePath -> Text)
-> ParsecT Void Text (RIO AppState) FilePath -> Parser 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 -> Parser DefinitionName
forall a. Parser a -> Parser a
lexeme Parser DefinitionName
readCurrentDefinitionName Parser DefinitionName -> Parser Text -> Parser DefinitionName
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser 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
  ParsecT Void Text (RIO AppState) Char
-> ParsecT Void Text (RIO AppState) FilePath
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (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
' ')
  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
-> Parser 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 (Text -> Parser Text
symbol Text
" = ")
  LiteralTypeValue
value <- Parser LiteralTypeValue
literalP Parser LiteralTypeValue
-> ParsecT Void Text (RIO AppState) FilePath
-> Parser LiteralTypeValue
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text (RIO AppState) Char
-> ParsecT Void Text (RIO AppState) FilePath
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (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 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 = Parser Text
-> Parser Text -> ParsecT Void Text (RIO AppState) [Text]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy1 Parser 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 :: Parser 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 -> Parser 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
  FilePath
_ <- 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
 -> ParsecT Void Text (RIO AppState) FilePath)
-> ParsecT Void Text (RIO AppState) Char
-> ParsecT Void Text (RIO AppState) FilePath
forall a b. (a -> b) -> a -> b
$ 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
' '
  FieldName
name <- ParsecT Void Text (RIO AppState) FieldName
fieldNameP
  Text -> Parser Text
symbol 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) -> Parser Text -> Parser DefinitionName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Parser Text] -> Parser Text
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ((Text -> Parser Text) -> [Text] -> [Parser Text]
forall a b. (a -> b) -> [a] -> [b]
List.map Text -> Parser 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
-> Parser 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
", ")
  Maybe TypeDefinition -> Maybe [FieldType] -> Parser ()
ensureMatchingGenericity Maybe TypeDefinition
maybeDefinition Maybe [FieldType]
maybeTypeVariables
  case Maybe TypeDefinition
maybeDefinition of
    Just definition :: TypeDefinition
definition@(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 ->
          if TypeDefinition -> Bool
isGenericType TypeDefinition
definition
            then 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)
            else
              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
"Trying to apply type as generic, but ", Text -> FilePath
unpack Text
n, FilePath
" is not generic"]
    Just TypeDefinition
definition -> do
      case Maybe [FieldType]
maybeTypeVariables of
        Just [FieldType]
appliedTypeVariables ->
          if TypeDefinition -> Bool
isGenericType TypeDefinition
definition
            then 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
            else
              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
"Trying to apply type as generic, but ", Text -> FilePath
unpack Text
n, FilePath
" is not generic"]
        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]

ensureMatchingGenericity :: Maybe TypeDefinition -> Maybe [FieldType] -> Parser ()
ensureMatchingGenericity :: Maybe TypeDefinition -> Maybe [FieldType] -> Parser ()
ensureMatchingGenericity Maybe TypeDefinition
Nothing Maybe [FieldType]
_maybeTypeParameters = () -> Parser ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
ensureMatchingGenericity (Just TypeDefinition
definition) Maybe [FieldType]
maybeTypeParameters = do
  let expectedTypeParameters :: Int
expectedTypeParameters =
        TypeDefinition
definition
          TypeDefinition
-> (TypeDefinition -> Maybe [TypeVariable]) -> Maybe [TypeVariable]
forall a b. a -> (a -> b) -> b
& TypeDefinition -> Maybe [TypeVariable]
Utilities.typeVariablesFromDefinition
          Maybe [TypeVariable]
-> (Maybe [TypeVariable] -> [TypeVariable]) -> [TypeVariable]
forall a b. a -> (a -> b) -> b
& [TypeVariable] -> Maybe [TypeVariable] -> [TypeVariable]
forall a. a -> Maybe a -> a
fromMaybe []
          [TypeVariable] -> ([TypeVariable] -> Int) -> Int
forall a b. a -> (a -> b) -> b
& [TypeVariable] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length
      name :: FilePath
name = TypeDefinition
definition TypeDefinition
-> (TypeDefinition -> DefinitionName) -> DefinitionName
forall a b. a -> (a -> b) -> b
& TypeDefinition -> DefinitionName
typeDefinitionName DefinitionName -> (DefinitionName -> Text) -> Text
forall a b. a -> (a -> b) -> b
& DefinitionName -> Text
unDefinitionName Text -> (Text -> FilePath) -> FilePath
forall a b. a -> (a -> b) -> b
& Text -> FilePath
unpack
      appliedTypeParameters :: Int
appliedTypeParameters = Maybe [FieldType]
maybeTypeParameters Maybe [FieldType]
-> (Maybe [FieldType] -> [FieldType]) -> [FieldType]
forall a b. a -> (a -> b) -> b
& [FieldType] -> Maybe [FieldType] -> [FieldType]
forall a. a -> Maybe a -> a
fromMaybe [] [FieldType] -> ([FieldType] -> Int) -> Int
forall a b. a -> (a -> b) -> b
& [FieldType] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length
  if Int
expectedTypeParameters Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
appliedTypeParameters
    then
      FilePath -> Parser ()
forall a. FilePath -> Parser a
reportError (FilePath -> Parser ()) -> FilePath -> Parser ()
forall a b. (a -> b) -> a -> b
$
        [FilePath] -> FilePath
forall a. Monoid a => [a] -> a
mconcat
          [ FilePath
"Type ",
            FilePath
name,
            FilePath
" expects ",
            Int -> FilePath
forall a. Show a => a -> FilePath
show Int
expectedTypeParameters,
            FilePath
" type parameters, ",
            Int -> FilePath
forall a. Show a => a -> FilePath
show Int
appliedTypeParameters,
            FilePath
" applied"
          ]
    else () -> Parser ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

isGenericType :: TypeDefinition -> Bool
isGenericType :: TypeDefinition -> Bool
isGenericType (TypeDefinition DefinitionName
_name (Struct (GenericStruct [TypeVariable]
_typeVariables [StructField]
_fields))) = Bool
True
isGenericType (TypeDefinition DefinitionName
_name (Union FieldName
_tag (GenericUnion [TypeVariable]
_typeVariables [Constructor]
_constructors))) = Bool
True
isGenericType (TypeDefinition DefinitionName
_name (Struct (PlainStruct [StructField]
_fields))) = Bool
False
isGenericType (TypeDefinition DefinitionName
_name (Union FieldName
_tag (PlainUnion [Constructor]
_constructors))) = Bool
False
isGenericType (TypeDefinition DefinitionName
_name (DeclaredType ModuleName
_moduleName [TypeVariable]
typeVariables)) =
  Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [TypeVariable] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
List.null [TypeVariable]
typeVariables
isGenericType (TypeDefinition DefinitionName
_name (EmbeddedUnion FieldName
_tag [EmbeddedConstructor]
_constructors)) = Bool
False
isGenericType (TypeDefinition DefinitionName
_name (UntaggedUnion [FieldType]
_cases)) = Bool
False
isGenericType (TypeDefinition DefinitionName
_name (Enumeration [EnumerationValue]
_values)) = Bool
False

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
"'"

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
    ]
    ParsecT Void Text (RIO AppState) FieldType
-> ParsecT Void Text (RIO AppState) FilePath
-> ParsecT Void Text (RIO AppState) FieldType
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text (RIO AppState) Char
-> ParsecT Void Text (RIO AppState) FilePath
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (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
' ')

typeVariableReferenceP :: [TypeVariable] -> Parser TypeVariable
typeVariableReferenceP :: [TypeVariable] -> ParsecT Void Text (RIO AppState) TypeVariable
typeVariableReferenceP [TypeVariable]
typeVariables =
  Text -> TypeVariable
TypeVariable (Text -> TypeVariable)
-> Parser Text -> ParsecT Void Text (RIO AppState) TypeVariable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Parser Text] -> Parser Text
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ((TypeVariable -> Parser Text) -> [TypeVariable] -> [Parser 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 <-
    [Parser Text] -> Parser Text
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ((Import -> Parser Text) -> [Import] -> [Parser 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) Parser Text -> ParsecT Void Text (RIO AppState) Char -> Parser 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
-> Parser 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
<$> Parser 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 -> [Parser Text]
integerTypeParsers Text
prefix = (Int -> Parser Text) -> [Int] -> [Parser Text]
forall a b. (a -> b) -> [a] -> [b]
List.map (Int -> FilePath
forall a. Show a => a -> FilePath
show (Int -> FilePath)
-> (FilePath -> Parser Text) -> Int -> Parser 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 -> Parser Text) -> FilePath -> Parser 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 -> Parser Text) -> Text -> Parser Text
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Text -> Parser 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 <- [Parser Text] -> Parser Text
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([Parser Text] -> Parser Text) -> [Parser Text] -> Parser Text
forall a b. (a -> b) -> a -> b
$ Text -> [Parser 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 <- [Parser Text] -> Parser Text
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([Parser Text] -> Parser Text) -> [Parser Text] -> Parser Text
forall a b. (a -> b) -> a -> b
$ Text -> [Parser 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 <- [Parser Text] -> Parser 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", Parser 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" Parser 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" Parser 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" Parser 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" Parser 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`"

typeDefinitionName :: TypeDefinition -> DefinitionName
typeDefinitionName :: TypeDefinition -> DefinitionName
typeDefinitionName (TypeDefinition DefinitionName
name TypeData
_) = DefinitionName
name

lexeme :: Parser a -> Parser a
lexeme :: Parser a -> Parser a
lexeme = Parser () -> Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
Lexer.lexeme Parser ()
spaceConsumer

symbol :: Text -> Parser Text
symbol :: Text -> Parser Text
symbol = Parser ()
-> Tokens Text -> ParsecT Void Text (RIO AppState) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> Tokens s -> m (Tokens s)
Lexer.symbol Parser ()
spaceConsumer

spaceConsumer :: Parser ()
spaceConsumer :: Parser ()
spaceConsumer = Parser () -> Parser () -> Parser () -> Parser ()
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> m () -> m () -> m ()
Lexer.space Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space1 (Tokens Text -> Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Tokens s -> m ()
Lexer.skipLineComment Tokens Text
"# ") Parser ()
forall (f :: * -> *) a. Alternative f => f a
empty