module Parsing where import RIO ( Bool (..), Char, Either (..), FilePath, IO, IORef, Int, Maybe (..), RIO, Set, Show, String, Text, Void, any, ask, compare, const, error, for, fromMaybe, isLeft, maybe, mconcat, mempty, modifyIORef, newIORef, not, pure, readFileUtf8, readIORef, runRIO, show, writeIORef, ($), ($>), (&), (*>), (.), (<$), (<$>), (<*), (<>), (==), (>>>), ) import qualified RIO.FilePath as FilePath import qualified RIO.List as List import qualified RIO.Set as Set import RIO.Text (pack, unpack) import qualified RIO.Text as Text import System.IO (putStrLn) import Text.Megaparsec import Text.Megaparsec.Char import Text.Megaparsec.Char.Lexer import Text.Show.Pretty (pPrint) import Types data AppState = AppState { AppState -> IORef [Module] modulesReference :: !(IORef [Module]), AppState -> IORef [Import] currentImportsReference :: !(IORef [Import]), AppState -> IORef (Set ModuleName) currentDeclarationNamesReference :: !(IORef (Set ModuleName)), AppState -> IORef [TypeDefinition] currentDefinitionsReference :: !(IORef [TypeDefinition]), AppState -> IORef (Maybe DefinitionName) currentDefinitionNameReference :: !(IORef (Maybe DefinitionName)) } type Parser = ParsecT Void Text (RIO AppState) parseModules :: [FilePath] -> IO (Either [String] [Module]) parseModules :: [FilePath] -> IO (Either [FilePath] [Module]) parseModules [FilePath] files = do IORef [Module] modulesReference <- [Module] -> IO (IORef [Module]) forall (m :: * -> *) a. MonadIO m => a -> m (IORef a) newIORef [] IORef [TypeDefinition] currentDefinitionsReference <- [TypeDefinition] -> IO (IORef [TypeDefinition]) forall (m :: * -> *) a. MonadIO m => a -> m (IORef a) newIORef [] IORef [Import] currentImportsReference <- [Import] -> IO (IORef [Import]) forall (m :: * -> *) a. MonadIO m => a -> m (IORef a) newIORef [] IORef (Set ModuleName) currentDeclarationNamesReference <- Set ModuleName -> IO (IORef (Set ModuleName)) forall (m :: * -> *) a. MonadIO m => a -> m (IORef a) newIORef Set ModuleName forall a. Set a Set.empty IORef (Maybe DefinitionName) currentDefinitionNameReference <- Maybe DefinitionName -> IO (IORef (Maybe DefinitionName)) forall (m :: * -> *) a. MonadIO m => a -> m (IORef a) newIORef Maybe DefinitionName forall a. Maybe a Nothing let state :: AppState state = AppState :: IORef [Module] -> IORef [Import] -> IORef (Set ModuleName) -> IORef [TypeDefinition] -> IORef (Maybe DefinitionName) -> AppState AppState { IORef [TypeDefinition] currentDefinitionsReference :: IORef [TypeDefinition] $sel:currentDefinitionsReference:AppState :: IORef [TypeDefinition] currentDefinitionsReference, IORef (Maybe DefinitionName) currentDefinitionNameReference :: IORef (Maybe DefinitionName) $sel:currentDefinitionNameReference:AppState :: IORef (Maybe DefinitionName) currentDefinitionNameReference, IORef [Import] currentImportsReference :: IORef [Import] $sel:currentImportsReference:AppState :: IORef [Import] currentImportsReference, IORef (Set ModuleName) currentDeclarationNamesReference :: IORef (Set ModuleName) $sel:currentDeclarationNamesReference:AppState :: IORef (Set ModuleName) currentDeclarationNamesReference, IORef [Module] modulesReference :: IORef [Module] $sel:modulesReference:AppState :: IORef [Module] modulesReference } [Either FilePath Module] results <- [FilePath] -> (FilePath -> IO (Either FilePath Module)) -> IO [Either FilePath Module] forall (t :: * -> *) (f :: * -> *) a b. (Traversable t, Applicative f) => t a -> (a -> f b) -> f (t b) for [FilePath] files ((FilePath -> IO (Either FilePath Module)) -> IO [Either FilePath Module]) -> (FilePath -> IO (Either FilePath Module)) -> IO [Either FilePath Module] forall a b. (a -> b) -> a -> b $ \FilePath f -> do let moduleName :: ModuleName moduleName = FilePath f FilePath -> (FilePath -> FilePath) -> FilePath forall a b. a -> (a -> b) -> b & FilePath -> FilePath FilePath.takeBaseName FilePath -> (FilePath -> Text) -> Text forall a b. a -> (a -> b) -> b & FilePath -> Text pack Text -> (Text -> ModuleName) -> ModuleName forall a b. a -> (a -> b) -> b & Text -> ModuleName ModuleName Text fileContents <- FilePath -> IO Text forall (m :: * -> *). MonadIO m => FilePath -> m Text readFileUtf8 FilePath f Either (ParseErrorBundle Text Void) Module maybeModule <- AppState -> Text -> Parser Module -> IO (Either (ParseErrorBundle Text Void) Module) forall a. AppState -> Text -> Parser a -> IO (Either (ParseErrorBundle Text Void) a) run AppState state Text fileContents (Parser Module -> IO (Either (ParseErrorBundle Text Void) Module)) -> Parser Module -> IO (Either (ParseErrorBundle Text Void) Module) forall a b. (a -> b) -> a -> b $ ModuleName -> FilePath -> Parser Module moduleP ModuleName moduleName FilePath f case Either (ParseErrorBundle Text Void) Module maybeModule of Right Module module' -> do Module -> IORef [Module] -> IO () addModule Module module' IORef [Module] modulesReference pure $ Module -> Either FilePath Module forall a b. b -> Either a b Right Module module' Left ParseErrorBundle Text Void e -> Either FilePath Module -> IO (Either FilePath Module) forall (f :: * -> *) a. Applicative f => a -> f a pure (Either FilePath Module -> IO (Either FilePath Module)) -> Either FilePath Module -> IO (Either FilePath Module) forall a b. (a -> b) -> a -> b $ FilePath -> Either FilePath Module forall a b. a -> Either a b Left (FilePath -> Either FilePath Module) -> FilePath -> Either FilePath Module forall a b. (a -> b) -> a -> b $ [FilePath] -> FilePath forall a. Monoid a => [a] -> a mconcat [FilePath "Error parsing module '", FilePath f, FilePath "': \n", ParseErrorBundle Text Void -> FilePath forall s e. (VisualStream s, TraversableStream s, ShowErrorComponent e) => ParseErrorBundle s e -> FilePath errorBundlePretty ParseErrorBundle Text Void e] case (Either FilePath Module -> Bool) -> [Either FilePath Module] -> ([Either FilePath Module], [Either FilePath Module]) forall a. (a -> Bool) -> [a] -> ([a], [a]) List.partition Either FilePath Module -> Bool forall a b. Either a b -> Bool isLeft [Either FilePath Module] results of ([], [Either FilePath Module] maybeModules) -> Either [FilePath] [Module] -> IO (Either [FilePath] [Module]) forall (f :: * -> *) a. Applicative f => a -> f a pure (Either [FilePath] [Module] -> IO (Either [FilePath] [Module])) -> Either [FilePath] [Module] -> IO (Either [FilePath] [Module]) forall a b. (a -> b) -> a -> b $ [Module] -> Either [FilePath] [Module] forall a b. b -> Either a b Right ([Module] -> Either [FilePath] [Module]) -> [Module] -> Either [FilePath] [Module] forall a b. (a -> b) -> a -> b $ (Either FilePath Module -> Module) -> [Either FilePath Module] -> [Module] forall a b. (a -> b) -> [a] -> [b] List.map Either FilePath Module -> Module forall l r. Either l r -> r partialFromRight [Either FilePath Module] maybeModules ([Either FilePath Module] errors, [Either FilePath Module] _modules) -> Either [FilePath] [Module] -> IO (Either [FilePath] [Module]) forall (f :: * -> *) a. Applicative f => a -> f a pure (Either [FilePath] [Module] -> IO (Either [FilePath] [Module])) -> Either [FilePath] [Module] -> IO (Either [FilePath] [Module]) forall a b. (a -> b) -> a -> b $ [FilePath] -> Either [FilePath] [Module] forall a b. a -> Either a b Left ([FilePath] -> Either [FilePath] [Module]) -> [FilePath] -> Either [FilePath] [Module] forall a b. (a -> b) -> a -> b $ (Either FilePath Module -> FilePath) -> [Either FilePath Module] -> [FilePath] forall a b. (a -> b) -> [a] -> [b] List.map Either FilePath Module -> FilePath forall l r. Either l r -> l partialFromLeft [Either FilePath Module] errors run :: AppState -> Text -> Parser a -> IO (Either (ParseErrorBundle Text Void) a) run :: AppState -> Text -> Parser a -> IO (Either (ParseErrorBundle Text Void) a) run AppState state Text text Parser a parser = do let parserResult :: RIO AppState (Either (ParseErrorBundle Text Void) a) parserResult = Parser a -> FilePath -> Text -> RIO AppState (Either (ParseErrorBundle Text Void) a) forall (m :: * -> *) e s a. Monad m => ParsecT e s m a -> FilePath -> s -> m (Either (ParseErrorBundle s e) a) runParserT Parser a parser FilePath "" Text text AppState -> RIO AppState (Either (ParseErrorBundle Text Void) a) -> IO (Either (ParseErrorBundle Text Void) a) forall (m :: * -> *) env a. MonadIO m => env -> RIO env a -> m a runRIO AppState state RIO AppState (Either (ParseErrorBundle Text Void) a) parserResult test :: (Show a) => AppState -> Text -> Parser a -> IO () test :: AppState -> Text -> Parser a -> IO () test AppState state Text text Parser a parser = do Either (ParseErrorBundle Text Void) a result <- AppState -> Text -> Parser a -> IO (Either (ParseErrorBundle Text Void) a) forall a. AppState -> Text -> Parser a -> IO (Either (ParseErrorBundle Text Void) a) run AppState state Text text Parser a parser case Either (ParseErrorBundle Text Void) a result of Right a successValue -> a -> IO () forall a. Show a => a -> IO () pPrint a successValue Left ParseErrorBundle Text Void e -> FilePath -> IO () putStrLn (FilePath -> IO ()) -> FilePath -> IO () forall a b. (a -> b) -> a -> b $ ParseErrorBundle Text Void -> FilePath forall s e. (VisualStream s, TraversableStream s, ShowErrorComponent e) => ParseErrorBundle s e -> FilePath errorBundlePretty ParseErrorBundle Text Void e moduleP :: ModuleName -> FilePath -> Parser Module moduleP :: ModuleName -> FilePath -> Parser Module moduleP ModuleName name FilePath sourceFile = do [Import] imports <- [Import] -> Maybe [Import] -> [Import] forall a. a -> Maybe a -> a fromMaybe [] (Maybe [Import] -> [Import]) -> ParsecT Void Text (RIO AppState) (Maybe [Import]) -> ParsecT Void Text (RIO AppState) [Import] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> ParsecT Void Text (RIO AppState) [Import] -> ParsecT Void Text (RIO AppState) (Maybe [Import]) forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a) optional (ParsecT Void Text (RIO AppState) Import -> ParsecT Void Text (RIO AppState) Char -> ParsecT Void Text (RIO AppState) [Import] forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a] sepEndBy1 ParsecT Void Text (RIO AppState) Import importP ParsecT Void Text (RIO AppState) Char forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => m (Token s) newline ParsecT Void Text (RIO AppState) [Import] -> ParsecT Void Text (RIO AppState) Char -> ParsecT Void Text (RIO AppState) [Import] forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a <* ParsecT Void Text (RIO AppState) Char forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => m (Token s) newline) [Import] -> Parser () addImports [Import] imports [TypeDefinition] definitions <- ParsecT Void Text (RIO AppState) TypeDefinition -> ParsecT Void Text (RIO AppState) Char -> ParsecT Void Text (RIO AppState) [TypeDefinition] forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a] sepBy1 ParsecT Void Text (RIO AppState) TypeDefinition typeDefinitionP (ParsecT Void Text (RIO AppState) Char forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => m (Token s) newline ParsecT Void Text (RIO AppState) Char -> ParsecT Void Text (RIO AppState) Char -> ParsecT Void Text (RIO AppState) Char forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a <* ParsecT Void Text (RIO AppState) Char forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => m (Token s) newline) ParsecT Void Text (RIO AppState) [TypeDefinition] -> Parser () -> ParsecT Void Text (RIO AppState) [TypeDefinition] forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a <* Parser () forall e s (m :: * -> *). MonadParsec e s m => m () eof [ModuleName] declarationNames <- Set ModuleName -> [ModuleName] forall a. Set a -> [a] Set.toList (Set ModuleName -> [ModuleName]) -> ParsecT Void Text (RIO AppState) (Set ModuleName) -> ParsecT Void Text (RIO AppState) [ModuleName] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> ParsecT Void Text (RIO AppState) (Set ModuleName) getDeclarationNames Parser () clearDeclarationNames Parser () clearDefinitions pure Module :: ModuleName -> [Import] -> [ModuleName] -> [TypeDefinition] -> FilePath -> Module Module {ModuleName $sel:name:Module :: ModuleName name :: ModuleName name, [Import] $sel:imports:Module :: [Import] imports :: [Import] imports, [TypeDefinition] $sel:definitions:Module :: [TypeDefinition] definitions :: [TypeDefinition] definitions, FilePath $sel:sourceFile:Module :: FilePath sourceFile :: FilePath sourceFile, [ModuleName] $sel:declarationNames:Module :: [ModuleName] declarationNames :: [ModuleName] declarationNames} addImports :: [Import] -> Parser () addImports :: [Import] -> Parser () addImports [Import] imports = do AppState {IORef [Import] currentImportsReference :: IORef [Import] $sel:currentImportsReference:AppState :: AppState -> IORef [Import] currentImportsReference} <- ParsecT Void Text (RIO AppState) AppState forall r (m :: * -> *). MonadReader r m => m r ask IORef [Import] -> [Import] -> Parser () forall (m :: * -> *) a. MonadIO m => IORef a -> a -> m () writeIORef IORef [Import] currentImportsReference [Import] imports addDeclarationName :: ModuleName -> Parser () addDeclarationName :: ModuleName -> Parser () addDeclarationName ModuleName moduleName = do AppState {IORef (Set ModuleName) currentDeclarationNamesReference :: IORef (Set ModuleName) $sel:currentDeclarationNamesReference:AppState :: AppState -> IORef (Set ModuleName) currentDeclarationNamesReference} <- ParsecT Void Text (RIO AppState) AppState forall r (m :: * -> *). MonadReader r m => m r ask IORef (Set ModuleName) -> (Set ModuleName -> Set ModuleName) -> Parser () forall (m :: * -> *) a. MonadIO m => IORef a -> (a -> a) -> m () modifyIORef IORef (Set ModuleName) currentDeclarationNamesReference (ModuleName -> Set ModuleName -> Set ModuleName forall a. Ord a => a -> Set a -> Set a Set.insert ModuleName moduleName) getDeclarationNames :: Parser (Set ModuleName) getDeclarationNames :: ParsecT Void Text (RIO AppState) (Set ModuleName) getDeclarationNames = do AppState {IORef (Set ModuleName) currentDeclarationNamesReference :: IORef (Set ModuleName) $sel:currentDeclarationNamesReference:AppState :: AppState -> IORef (Set ModuleName) currentDeclarationNamesReference} <- ParsecT Void Text (RIO AppState) AppState forall r (m :: * -> *). MonadReader r m => m r ask IORef (Set ModuleName) -> ParsecT Void Text (RIO AppState) (Set ModuleName) forall (m :: * -> *) a. MonadIO m => IORef a -> m a readIORef IORef (Set ModuleName) currentDeclarationNamesReference clearDeclarationNames :: Parser () clearDeclarationNames :: Parser () clearDeclarationNames = do AppState {IORef (Set ModuleName) currentDeclarationNamesReference :: IORef (Set ModuleName) $sel:currentDeclarationNamesReference:AppState :: AppState -> IORef (Set ModuleName) currentDeclarationNamesReference} <- ParsecT Void Text (RIO AppState) AppState forall r (m :: * -> *). MonadReader r m => m r ask IORef (Set ModuleName) -> Set ModuleName -> Parser () forall (m :: * -> *) a. MonadIO m => IORef a -> a -> m () writeIORef IORef (Set ModuleName) currentDeclarationNamesReference Set ModuleName forall a. Set a Set.empty importP :: Parser Import importP :: ParsecT Void Text (RIO AppState) Import importP = do Tokens Text -> ParsecT Void Text (RIO AppState) (Tokens Text) forall e s (m :: * -> *). MonadParsec e s m => Tokens s -> m (Tokens s) string Tokens Text "import " FilePath importName <- ParsecT Void Text (RIO AppState) Char -> ParsecT Void Text (RIO AppState) FilePath forall (m :: * -> *) a. MonadPlus m => m a -> m [a] some (ParsecT Void Text (RIO AppState) Char forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => m (Token s) alphaNumChar ParsecT Void Text (RIO AppState) Char -> ParsecT Void Text (RIO AppState) Char -> ParsecT Void Text (RIO AppState) Char forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> Token Text -> ParsecT Void Text (RIO AppState) (Token Text) forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => Token s -> m (Token s) char Char Token Text '_') Maybe Module maybeModule <- FilePath -> Parser (Maybe Module) getModule FilePath importName case Maybe Module maybeModule of Just Module module' -> do Import -> ParsecT Void Text (RIO AppState) Import forall (f :: * -> *) a. Applicative f => a -> f a pure (Import -> ParsecT Void Text (RIO AppState) Import) -> Import -> ParsecT Void Text (RIO AppState) Import forall a b. (a -> b) -> a -> b $ Module -> Import Import Module module' Maybe Module Nothing -> FilePath -> ParsecT Void Text (RIO AppState) Import forall a. FilePath -> Parser a reportError (FilePath -> ParsecT Void Text (RIO AppState) Import) -> FilePath -> ParsecT Void Text (RIO AppState) Import forall a b. (a -> b) -> a -> b $ FilePath "Unknown module referenced: " FilePath -> FilePath -> FilePath forall a. Semigroup a => a -> a -> a <> FilePath importName getModule :: String -> Parser (Maybe Module) getModule :: FilePath -> Parser (Maybe Module) getModule FilePath importName = do AppState {IORef [Module] modulesReference :: IORef [Module] $sel:modulesReference:AppState :: AppState -> IORef [Module] modulesReference} <- ParsecT Void Text (RIO AppState) AppState forall r (m :: * -> *). MonadReader r m => m r ask [Module] modules <- IORef [Module] -> ParsecT Void Text (RIO AppState) [Module] forall (m :: * -> *) a. MonadIO m => IORef a -> m a readIORef IORef [Module] modulesReference pure $ (Module -> Bool) -> [Module] -> Maybe Module forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a List.find (\Module {$sel:name:Module :: Module -> ModuleName name = ModuleName Text name} -> Text name Text -> Text -> Bool forall a. Eq a => a -> a -> Bool == FilePath -> Text pack FilePath importName) [Module] modules addModule :: Module -> IORef [Module] -> IO () addModule :: Module -> IORef [Module] -> IO () addModule Module module' IORef [Module] modulesReference = do IORef [Module] -> ([Module] -> [Module]) -> IO () forall (m :: * -> *) a. MonadIO m => IORef a -> (a -> a) -> m () modifyIORef IORef [Module] modulesReference (Module module' Module -> [Module] -> [Module] forall a. a -> [a] -> [a] :) typeDefinitionP :: Parser TypeDefinition typeDefinitionP :: ParsecT Void Text (RIO AppState) TypeDefinition typeDefinitionP = do Text keyword <- [ParsecT Void Text (RIO AppState) Text] -> ParsecT Void Text (RIO AppState) Text forall (f :: * -> *) (m :: * -> *) a. (Foldable f, Alternative m) => f (m a) -> m a choice ([ParsecT Void Text (RIO AppState) Text] -> ParsecT Void Text (RIO AppState) Text) -> [ParsecT Void Text (RIO AppState) Text] -> ParsecT Void Text (RIO AppState) Text forall a b. (a -> b) -> a -> b $ (Text -> ParsecT Void Text (RIO AppState) Text) -> [Text] -> [ParsecT Void Text (RIO AppState) Text] forall a b. (a -> b) -> [a] -> [b] List.map Text -> ParsecT Void Text (RIO AppState) Text forall e s (m :: * -> *). MonadParsec e s m => Tokens s -> m (Tokens s) string [Text "struct", Text "untagged union", Text "union", Text "enum", Text "declare"] TypeDefinition definition <- case Text keyword of Text "struct" -> Token Text -> ParsecT Void Text (RIO AppState) (Token Text) forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => Token s -> m (Token s) char Char Token Text ' ' ParsecT Void Text (RIO AppState) Char -> ParsecT Void Text (RIO AppState) TypeDefinition -> ParsecT Void Text (RIO AppState) TypeDefinition forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b *> ParsecT Void Text (RIO AppState) TypeDefinition structP Text "union" -> do Maybe TagType maybeTagType <- ParsecT Void Text (RIO AppState) TagType -> ParsecT Void Text (RIO AppState) (Maybe TagType) forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a) optional (ParsecT Void Text (RIO AppState) TagType -> ParsecT Void Text (RIO AppState) (Maybe TagType)) -> ParsecT Void Text (RIO AppState) TagType -> ParsecT Void Text (RIO AppState) (Maybe TagType) forall a b. (a -> b) -> a -> b $ do Char _ <- Token Text -> ParsecT Void Text (RIO AppState) (Token Text) forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => Token s -> m (Token s) char Char Token Text '(' ParsecT Void Text (RIO AppState) TagType tagTypeP ParsecT Void Text (RIO AppState) TagType -> ParsecT Void Text (RIO AppState) Char -> ParsecT Void Text (RIO AppState) TagType forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a <* Token Text -> ParsecT Void Text (RIO AppState) (Token Text) forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => Token s -> m (Token s) char Char Token Text ')' let tagType :: TagType tagType = TagType -> Maybe TagType -> TagType forall a. a -> Maybe a -> a fromMaybe (FieldName -> TagType StandardTypeTag (FieldName -> TagType) -> FieldName -> TagType forall a b. (a -> b) -> a -> b $ Text -> FieldName FieldName Text "type") Maybe TagType maybeTagType Token Text -> ParsecT Void Text (RIO AppState) (Token Text) forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => Token s -> m (Token s) char Char Token Text ' ' ParsecT Void Text (RIO AppState) Char -> ParsecT Void Text (RIO AppState) TypeDefinition -> ParsecT Void Text (RIO AppState) TypeDefinition forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b *> case TagType tagType of StandardTypeTag FieldName fieldName -> FieldName -> ParsecT Void Text (RIO AppState) TypeDefinition unionP FieldName fieldName EmbeddedTypeTag FieldName fieldName -> FieldName -> ParsecT Void Text (RIO AppState) TypeDefinition embeddedUnionP FieldName fieldName Text "untagged union" -> Token Text -> ParsecT Void Text (RIO AppState) (Token Text) forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => Token s -> m (Token s) char Char Token Text ' ' ParsecT Void Text (RIO AppState) Char -> ParsecT Void Text (RIO AppState) TypeDefinition -> ParsecT Void Text (RIO AppState) TypeDefinition forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b *> ParsecT Void Text (RIO AppState) TypeDefinition untaggedUnionP Text "enum" -> Token Text -> ParsecT Void Text (RIO AppState) (Token Text) forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => Token s -> m (Token s) char Char Token Text ' ' ParsecT Void Text (RIO AppState) Char -> ParsecT Void Text (RIO AppState) TypeDefinition -> ParsecT Void Text (RIO AppState) TypeDefinition forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b *> ParsecT Void Text (RIO AppState) TypeDefinition enumerationP Text "declare" -> Token Text -> ParsecT Void Text (RIO AppState) (Token Text) forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => Token s -> m (Token s) char Char Token Text ' ' ParsecT Void Text (RIO AppState) Char -> ParsecT Void Text (RIO AppState) TypeDefinition -> ParsecT Void Text (RIO AppState) TypeDefinition forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b *> ParsecT Void Text (RIO AppState) TypeDefinition declarationP Text other -> FilePath -> ParsecT Void Text (RIO AppState) TypeDefinition forall a. FilePath -> Parser a reportError (FilePath -> ParsecT Void Text (RIO AppState) TypeDefinition) -> FilePath -> ParsecT Void Text (RIO AppState) TypeDefinition forall a b. (a -> b) -> a -> b $ FilePath "Unknown type definition keyword: " FilePath -> FilePath -> FilePath forall a. Semigroup a => a -> a -> a <> Text -> FilePath unpack Text other TypeDefinition -> Parser () addDefinition TypeDefinition definition pure TypeDefinition definition declarationP :: Parser TypeDefinition declarationP :: ParsecT Void Text (RIO AppState) TypeDefinition declarationP = do ModuleName externalModule <- (FilePath -> Text pack (FilePath -> Text) -> (Text -> ModuleName) -> FilePath -> ModuleName forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k). Category cat => cat a b -> cat b c -> cat a c >>> Text -> ModuleName ModuleName) (FilePath -> ModuleName) -> ParsecT Void Text (RIO AppState) FilePath -> ParsecT Void Text (RIO AppState) ModuleName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> ParsecT Void Text (RIO AppState) Char -> ParsecT Void Text (RIO AppState) FilePath forall (m :: * -> *) a. MonadPlus m => m a -> m [a] some (ParsecT Void Text (RIO AppState) Char forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => m (Token s) alphaNumChar ParsecT Void Text (RIO AppState) Char -> ParsecT Void Text (RIO AppState) Char -> ParsecT Void Text (RIO AppState) Char forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> Token Text -> ParsecT Void Text (RIO AppState) (Token Text) forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => Token s -> m (Token s) char Char Token Text '_') ParsecT Void Text (RIO AppState) ModuleName -> ParsecT Void Text (RIO AppState) Char -> ParsecT Void Text (RIO AppState) ModuleName forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a <* Token Text -> ParsecT Void Text (RIO AppState) (Token Text) forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => Token s -> m (Token s) char Char Token Text '.' DefinitionName name <- Parser DefinitionName readCurrentDefinitionName [TypeVariable] typeVariables <- ([Text] -> Maybe [Text] -> [Text] forall a. a -> Maybe a -> a fromMaybe [] (Maybe [Text] -> [Text]) -> ([Text] -> [TypeVariable]) -> Maybe [Text] -> [TypeVariable] forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k). Category cat => cat a b -> cat b c -> cat a c >>> (Text -> TypeVariable) -> [Text] -> [TypeVariable] forall a b. (a -> b) -> [a] -> [b] List.map Text -> TypeVariable TypeVariable) (Maybe [Text] -> [TypeVariable]) -> ParsecT Void Text (RIO AppState) (Maybe [Text]) -> ParsecT Void Text (RIO AppState) [TypeVariable] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> ParsecT Void Text (RIO AppState) [Text] -> ParsecT Void Text (RIO AppState) (Maybe [Text]) forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a) optional (ParsecT Void Text (RIO AppState) Char -> ParsecT Void Text (RIO AppState) Char -> ParsecT Void Text (RIO AppState) [Text] -> ParsecT Void Text (RIO AppState) [Text] forall (m :: * -> *) open close a. Applicative m => m open -> m close -> m a -> m a between (Token Text -> ParsecT Void Text (RIO AppState) (Token Text) forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => Token s -> m (Token s) char Char Token Text '<') (Token Text -> ParsecT Void Text (RIO AppState) (Token Text) forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => Token s -> m (Token s) char Char Token Text '>') ParsecT Void Text (RIO AppState) [Text] typeVariablesP) ModuleName -> Parser () addDeclarationName ModuleName externalModule pure $ DefinitionName -> TypeData -> TypeDefinition TypeDefinition DefinitionName name (TypeData -> TypeDefinition) -> TypeData -> TypeDefinition forall a b. (a -> b) -> a -> b $ ModuleName -> [TypeVariable] -> TypeData DeclaredType ModuleName externalModule [TypeVariable] typeVariables untaggedUnionP :: Parser TypeDefinition untaggedUnionP :: ParsecT Void Text (RIO AppState) TypeDefinition untaggedUnionP = do DefinitionName name <- Parser DefinitionName readCurrentDefinitionName Parser DefinitionName -> ParsecT Void Text (RIO AppState) Text -> Parser DefinitionName forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a <* Tokens Text -> ParsecT Void Text (RIO AppState) (Tokens Text) forall e s (m :: * -> *). MonadParsec e s m => Tokens s -> m (Tokens s) string Tokens Text " {\n" [FieldType] cases <- Parser [FieldType] untaggedUnionCasesP Token Text -> ParsecT Void Text (RIO AppState) (Token Text) forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => Token s -> m (Token s) char Char Token Text '}' pure $ DefinitionName -> TypeData -> TypeDefinition TypeDefinition DefinitionName name (TypeData -> TypeDefinition) -> TypeData -> TypeDefinition forall a b. (a -> b) -> a -> b $ [FieldType] -> TypeData UntaggedUnion [FieldType] cases untaggedUnionCasesP :: Parser [FieldType] untaggedUnionCasesP :: Parser [FieldType] untaggedUnionCasesP = do ParsecT Void Text (RIO AppState) FieldType -> Parser [FieldType] forall (m :: * -> *) a. MonadPlus m => m a -> m [a] some ParsecT Void Text (RIO AppState) FieldType untaggedUnionCaseP untaggedUnionCaseP :: Parser FieldType untaggedUnionCaseP :: ParsecT Void Text (RIO AppState) FieldType untaggedUnionCaseP = Tokens Text -> ParsecT Void Text (RIO AppState) (Tokens Text) forall e s (m :: * -> *). MonadParsec e s m => Tokens s -> m (Tokens s) string Tokens Text " " ParsecT Void Text (RIO AppState) Text -> ParsecT Void Text (RIO AppState) FieldType -> ParsecT Void Text (RIO AppState) FieldType forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b *> [TypeVariable] -> ParsecT Void Text (RIO AppState) FieldType fieldTypeP [] ParsecT Void Text (RIO AppState) FieldType -> ParsecT Void Text (RIO AppState) Char -> ParsecT Void Text (RIO AppState) FieldType forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a <* ParsecT Void Text (RIO AppState) Char forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => m (Token s) newline tagTypeP :: Parser TagType tagTypeP :: ParsecT Void Text (RIO AppState) TagType tagTypeP = do Maybe FieldName maybeTagName <- ParsecT Void Text (RIO AppState) FieldName -> ParsecT Void Text (RIO AppState) (Maybe FieldName) forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a) optional (ParsecT Void Text (RIO AppState) FieldName -> ParsecT Void Text (RIO AppState) (Maybe FieldName)) -> ParsecT Void Text (RIO AppState) FieldName -> ParsecT Void Text (RIO AppState) (Maybe FieldName) forall a b. (a -> b) -> a -> b $ Tokens Text -> ParsecT Void Text (RIO AppState) (Tokens Text) forall e s (m :: * -> *). MonadParsec e s m => Tokens s -> m (Tokens s) string Tokens Text "tag = " ParsecT Void Text (RIO AppState) Text -> ParsecT Void Text (RIO AppState) FieldName -> ParsecT Void Text (RIO AppState) FieldName forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b *> ParsecT Void Text (RIO AppState) FieldName fieldNameP ParsecT Void Text (RIO AppState) Text -> ParsecT Void Text (RIO AppState) [Text] forall (m :: * -> *) a. MonadPlus m => m a -> m [a] many (ParsecT Void Text (RIO AppState) Text -> ParsecT Void Text (RIO AppState) [Text]) -> ParsecT Void Text (RIO AppState) Text -> ParsecT Void Text (RIO AppState) [Text] forall a b. (a -> b) -> a -> b $ Tokens Text -> ParsecT Void Text (RIO AppState) (Tokens Text) forall e s (m :: * -> *). MonadParsec e s m => Tokens s -> m (Tokens s) string Tokens Text ", " Maybe TypeTag maybeEmbedded <- ParsecT Void Text (RIO AppState) TypeTag -> ParsecT Void Text (RIO AppState) (Maybe TypeTag) forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a) optional (ParsecT Void Text (RIO AppState) TypeTag -> ParsecT Void Text (RIO AppState) (Maybe TypeTag)) -> ParsecT Void Text (RIO AppState) TypeTag -> ParsecT Void Text (RIO AppState) (Maybe TypeTag) forall a b. (a -> b) -> a -> b $ Text -> TypeTag TypeTag (Text -> TypeTag) -> ParsecT Void Text (RIO AppState) Text -> ParsecT Void Text (RIO AppState) TypeTag forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Tokens Text -> ParsecT Void Text (RIO AppState) (Tokens Text) forall e s (m :: * -> *). MonadParsec e s m => Tokens s -> m (Tokens s) string Tokens Text "embedded" let tagField :: FieldName tagField = FieldName -> Maybe FieldName -> FieldName forall a. a -> Maybe a -> a fromMaybe (Text -> FieldName FieldName Text "type") Maybe FieldName maybeTagName pure $ TagType -> (TypeTag -> TagType) -> Maybe TypeTag -> TagType forall b a. b -> (a -> b) -> Maybe a -> b maybe (FieldName -> TagType StandardTypeTag FieldName tagField) (TagType -> TypeTag -> TagType forall a b. a -> b -> a const (TagType -> TypeTag -> TagType) -> TagType -> TypeTag -> TagType forall a b. (a -> b) -> a -> b $ FieldName -> TagType EmbeddedTypeTag FieldName tagField) Maybe TypeTag maybeEmbedded readCurrentDefinitionName :: Parser DefinitionName readCurrentDefinitionName :: Parser DefinitionName readCurrentDefinitionName = do DefinitionName name <- Parser DefinitionName definitionNameP DefinitionName -> Parser () setCurrentDefinitionName DefinitionName name pure DefinitionName name structP :: Parser TypeDefinition structP :: ParsecT Void Text (RIO AppState) TypeDefinition structP = do DefinitionName name <- Parser DefinitionName readCurrentDefinitionName Parser DefinitionName -> ParsecT Void Text (RIO AppState) Char -> Parser DefinitionName forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a <* Token Text -> ParsecT Void Text (RIO AppState) (Token Text) forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => Token s -> m (Token s) char Char Token Text ' ' Maybe [Text] maybeTypeVariables <- ParsecT Void Text (RIO AppState) [Text] -> ParsecT Void Text (RIO AppState) (Maybe [Text]) forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a) optional (ParsecT Void Text (RIO AppState) [Text] -> ParsecT Void Text (RIO AppState) (Maybe [Text])) -> ParsecT Void Text (RIO AppState) [Text] -> ParsecT Void Text (RIO AppState) (Maybe [Text]) forall a b. (a -> b) -> a -> b $ ParsecT Void Text (RIO AppState) Char -> ParsecT Void Text (RIO AppState) Char -> ParsecT Void Text (RIO AppState) [Text] -> ParsecT Void Text (RIO AppState) [Text] forall (m :: * -> *) open close a. Applicative m => m open -> m close -> m a -> m a between (Token Text -> ParsecT Void Text (RIO AppState) (Token Text) forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => Token s -> m (Token s) char Char Token Text '<') (Token Text -> ParsecT Void Text (RIO AppState) (Token Text) forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => Token s -> m (Token s) char Char Token Text '>') ParsecT Void Text (RIO AppState) [Text] typeVariablesP Tokens Text -> ParsecT Void Text (RIO AppState) (Tokens Text) forall e s (m :: * -> *). MonadParsec e s m => Tokens s -> m (Tokens s) string Tokens Text "{\n" case Maybe [Text] maybeTypeVariables of Just [Text] typeVariables -> DefinitionName -> [TypeVariable] -> ParsecT Void Text (RIO AppState) TypeDefinition genericStructP DefinitionName name ([TypeVariable] -> ParsecT Void Text (RIO AppState) TypeDefinition) -> [TypeVariable] -> ParsecT Void Text (RIO AppState) TypeDefinition forall a b. (a -> b) -> a -> b $ (Text -> TypeVariable) -> [Text] -> [TypeVariable] forall a b. (a -> b) -> [a] -> [b] List.map Text -> TypeVariable TypeVariable [Text] typeVariables Maybe [Text] Nothing -> DefinitionName -> ParsecT Void Text (RIO AppState) TypeDefinition plainStructP DefinitionName name genericStructP :: DefinitionName -> [TypeVariable] -> Parser TypeDefinition genericStructP :: DefinitionName -> [TypeVariable] -> ParsecT Void Text (RIO AppState) TypeDefinition genericStructP DefinitionName name [TypeVariable] typeVariables = do [StructField] fields <- [TypeVariable] -> Parser [StructField] fieldsP [TypeVariable] typeVariables Token Text -> ParsecT Void Text (RIO AppState) (Token Text) forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => Token s -> m (Token s) char Char Token Text '}' pure $ DefinitionName -> TypeData -> TypeDefinition TypeDefinition DefinitionName name (TypeData -> TypeDefinition) -> TypeData -> TypeDefinition forall a b. (a -> b) -> a -> b $ StructType -> TypeData Struct (StructType -> TypeData) -> StructType -> TypeData forall a b. (a -> b) -> a -> b $ [TypeVariable] -> [StructField] -> StructType GenericStruct [TypeVariable] typeVariables [StructField] fields plainStructP :: DefinitionName -> Parser TypeDefinition plainStructP :: DefinitionName -> ParsecT Void Text (RIO AppState) TypeDefinition plainStructP DefinitionName name = do [StructField] fields <- [TypeVariable] -> Parser [StructField] fieldsP [] Token Text -> ParsecT Void Text (RIO AppState) (Token Text) forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => Token s -> m (Token s) char Char Token Text '}' pure $ DefinitionName -> TypeData -> TypeDefinition TypeDefinition DefinitionName name (TypeData -> TypeDefinition) -> TypeData -> TypeDefinition forall a b. (a -> b) -> a -> b $ StructType -> TypeData Struct (StructType -> TypeData) -> StructType -> TypeData forall a b. (a -> b) -> a -> b $ [StructField] -> StructType PlainStruct [StructField] fields constructorsP :: [TypeVariable] -> Parser [Constructor] constructorsP :: [TypeVariable] -> Parser [Constructor] constructorsP = ParsecT Void Text (RIO AppState) Constructor -> Parser [Constructor] forall (m :: * -> *) a. MonadPlus m => m a -> m [a] some (ParsecT Void Text (RIO AppState) Constructor -> Parser [Constructor]) -> ([TypeVariable] -> ParsecT Void Text (RIO AppState) Constructor) -> [TypeVariable] -> Parser [Constructor] forall b c a. (b -> c) -> (a -> b) -> a -> c . [TypeVariable] -> ParsecT Void Text (RIO AppState) Constructor constructorP constructorP :: [TypeVariable] -> Parser Constructor constructorP :: [TypeVariable] -> ParsecT Void Text (RIO AppState) Constructor constructorP [TypeVariable] typeVariables = do Tokens Text -> ParsecT Void Text (RIO AppState) (Tokens Text) forall e s (m :: * -> *). MonadParsec e s m => Tokens s -> m (Tokens s) string Tokens Text " " Text name <- ParsecT Void Text (RIO AppState) Text constructorNameP Maybe Text maybeColon <- ParsecT Void Text (RIO AppState) Text -> ParsecT Void Text (RIO AppState) (Maybe Text) forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a) optional (ParsecT Void Text (RIO AppState) Text -> ParsecT Void Text (RIO AppState) (Maybe Text)) -> ParsecT Void Text (RIO AppState) Text -> ParsecT Void Text (RIO AppState) (Maybe Text) forall a b. (a -> b) -> a -> b $ Tokens Text -> ParsecT Void Text (RIO AppState) (Tokens Text) forall e s (m :: * -> *). MonadParsec e s m => Tokens s -> m (Tokens s) string Tokens Text ": " Maybe FieldType payload <- case Maybe Text maybeColon of Just Text _ -> FieldType -> Maybe FieldType forall a. a -> Maybe a Just (FieldType -> Maybe FieldType) -> ParsecT Void Text (RIO AppState) FieldType -> ParsecT Void Text (RIO AppState) (Maybe FieldType) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [TypeVariable] -> ParsecT Void Text (RIO AppState) FieldType fieldTypeP [TypeVariable] typeVariables Maybe Text Nothing -> Maybe FieldType -> ParsecT Void Text (RIO AppState) (Maybe FieldType) forall (f :: * -> *) a. Applicative f => a -> f a pure Maybe FieldType forall a. Maybe a Nothing ParsecT Void Text (RIO AppState) Char forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => m (Token s) newline pure $ ConstructorName -> Maybe FieldType -> Constructor Constructor (Text -> ConstructorName ConstructorName Text name) Maybe FieldType payload constructorNameP :: Parser Text constructorNameP :: ParsecT Void Text (RIO AppState) Text constructorNameP = do Char firstLetter <- ParsecT Void Text (RIO AppState) Char forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => m (Token s) alphaNumChar FilePath rest <- ParsecT Void Text (RIO AppState) Char -> ParsecT Void Text (RIO AppState) FilePath forall (m :: * -> *) a. MonadPlus m => m a -> m [a] many ParsecT Void Text (RIO AppState) Char forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => m (Token s) alphaNumChar pure $ FilePath -> Text pack (FilePath -> Text) -> FilePath -> Text forall a b. (a -> b) -> a -> b $ Char firstLetter Char -> FilePath -> FilePath forall a. a -> [a] -> [a] : FilePath rest unionP :: FieldName -> Parser TypeDefinition unionP :: FieldName -> ParsecT Void Text (RIO AppState) TypeDefinition unionP FieldName typeTag = do DefinitionName name <- Parser DefinitionName readCurrentDefinitionName Parser DefinitionName -> ParsecT Void Text (RIO AppState) Char -> Parser DefinitionName forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a <* Token Text -> ParsecT Void Text (RIO AppState) (Token Text) forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => Token s -> m (Token s) char Char Token Text ' ' Maybe [Text] maybeTypeVariables <- ParsecT Void Text (RIO AppState) [Text] -> ParsecT Void Text (RIO AppState) (Maybe [Text]) forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a) optional (ParsecT Void Text (RIO AppState) [Text] -> ParsecT Void Text (RIO AppState) (Maybe [Text])) -> ParsecT Void Text (RIO AppState) [Text] -> ParsecT Void Text (RIO AppState) (Maybe [Text]) forall a b. (a -> b) -> a -> b $ ParsecT Void Text (RIO AppState) Char -> ParsecT Void Text (RIO AppState) Char -> ParsecT Void Text (RIO AppState) [Text] -> ParsecT Void Text (RIO AppState) [Text] forall (m :: * -> *) open close a. Applicative m => m open -> m close -> m a -> m a between (Token Text -> ParsecT Void Text (RIO AppState) (Token Text) forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => Token s -> m (Token s) char Char Token Text '<') (Token Text -> ParsecT Void Text (RIO AppState) (Token Text) forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => Token s -> m (Token s) char Char Token Text '>') ParsecT Void Text (RIO AppState) [Text] typeVariablesP Tokens Text -> ParsecT Void Text (RIO AppState) (Tokens Text) forall e s (m :: * -> *). MonadParsec e s m => Tokens s -> m (Tokens s) string Tokens Text "{\n" case Maybe [Text] maybeTypeVariables of Just [Text] typeVariables -> FieldName -> DefinitionName -> [TypeVariable] -> ParsecT Void Text (RIO AppState) TypeDefinition genericUnionP FieldName typeTag DefinitionName name ([TypeVariable] -> ParsecT Void Text (RIO AppState) TypeDefinition) -> [TypeVariable] -> ParsecT Void Text (RIO AppState) TypeDefinition forall a b. (a -> b) -> a -> b $ (Text -> TypeVariable) -> [Text] -> [TypeVariable] forall a b. (a -> b) -> [a] -> [b] List.map Text -> TypeVariable TypeVariable [Text] typeVariables Maybe [Text] Nothing -> FieldName -> DefinitionName -> ParsecT Void Text (RIO AppState) TypeDefinition plainUnionP FieldName typeTag DefinitionName name embeddedUnionP :: FieldName -> Parser TypeDefinition embeddedUnionP :: FieldName -> ParsecT Void Text (RIO AppState) TypeDefinition embeddedUnionP FieldName typeTag = do DefinitionName name <- Parser DefinitionName readCurrentDefinitionName Parser DefinitionName -> ParsecT Void Text (RIO AppState) Text -> Parser DefinitionName forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a <* Tokens Text -> ParsecT Void Text (RIO AppState) (Tokens Text) forall e s (m :: * -> *). MonadParsec e s m => Tokens s -> m (Tokens s) string Tokens Text " {\n" [EmbeddedConstructor] constructors <- [TypeVariable] -> Parser [EmbeddedConstructor] embeddedUnionStructConstructorsP [] Char _ <- Token Text -> ParsecT Void Text (RIO AppState) (Token Text) forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => Token s -> m (Token s) char Char Token Text '}' pure $ DefinitionName -> TypeData -> TypeDefinition TypeDefinition DefinitionName name (FieldName -> [EmbeddedConstructor] -> TypeData EmbeddedUnion FieldName typeTag [EmbeddedConstructor] constructors) genericUnionP :: FieldName -> DefinitionName -> [TypeVariable] -> Parser TypeDefinition genericUnionP :: FieldName -> DefinitionName -> [TypeVariable] -> ParsecT Void Text (RIO AppState) TypeDefinition genericUnionP FieldName typeTag DefinitionName name [TypeVariable] typeVariables = do [Constructor] constructors <- [TypeVariable] -> Parser [Constructor] constructorsP [TypeVariable] typeVariables Char _ <- Token Text -> ParsecT Void Text (RIO AppState) (Token Text) forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => Token s -> m (Token s) char Char Token Text '}' let union :: TypeData union = FieldName -> UnionType -> TypeData Union FieldName typeTag UnionType unionType unionType :: UnionType unionType = [TypeVariable] -> [Constructor] -> UnionType GenericUnion [TypeVariable] typeVariables [Constructor] constructors TypeDefinition -> ParsecT Void Text (RIO AppState) TypeDefinition forall (f :: * -> *) a. Applicative f => a -> f a pure (TypeDefinition -> ParsecT Void Text (RIO AppState) TypeDefinition) -> TypeDefinition -> ParsecT Void Text (RIO AppState) TypeDefinition forall a b. (a -> b) -> a -> b $ DefinitionName -> TypeData -> TypeDefinition TypeDefinition DefinitionName name TypeData union embeddedUnionStructConstructorsP :: [TypeVariable] -> Parser [EmbeddedConstructor] embeddedUnionStructConstructorsP :: [TypeVariable] -> Parser [EmbeddedConstructor] embeddedUnionStructConstructorsP [TypeVariable] typeVariables = ParsecT Void Text (RIO AppState) EmbeddedConstructor -> Parser [EmbeddedConstructor] forall (m :: * -> *) a. MonadPlus m => m a -> m [a] some (ParsecT Void Text (RIO AppState) EmbeddedConstructor -> Parser [EmbeddedConstructor]) -> ParsecT Void Text (RIO AppState) EmbeddedConstructor -> Parser [EmbeddedConstructor] forall a b. (a -> b) -> a -> b $ [TypeVariable] -> ParsecT Void Text (RIO AppState) EmbeddedConstructor embeddedUnionStructConstructorP [TypeVariable] typeVariables embeddedUnionStructConstructorP :: [TypeVariable] -> Parser EmbeddedConstructor embeddedUnionStructConstructorP :: [TypeVariable] -> ParsecT Void Text (RIO AppState) EmbeddedConstructor embeddedUnionStructConstructorP [TypeVariable] typeVariables = do Text constructorName <- Tokens Text -> ParsecT Void Text (RIO AppState) (Tokens Text) forall e s (m :: * -> *). MonadParsec e s m => Tokens s -> m (Tokens s) string Tokens Text " " ParsecT Void Text (RIO AppState) Text -> ParsecT Void Text (RIO AppState) Text -> ParsecT Void Text (RIO AppState) Text forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b *> ParsecT Void Text (RIO AppState) Text embeddedConstructorNameP Maybe DefinitionReference maybeDefinition <- [ParsecT Void Text (RIO AppState) (Maybe DefinitionReference)] -> ParsecT Void Text (RIO AppState) (Maybe DefinitionReference) forall (f :: * -> *) (m :: * -> *) a. (Foldable f, Alternative m) => f (m a) -> m a choice [ Maybe DefinitionReference forall a. Maybe a Nothing Maybe DefinitionReference -> ParsecT Void Text (RIO AppState) Char -> ParsecT Void Text (RIO AppState) (Maybe DefinitionReference) forall (f :: * -> *) a b. Functor f => a -> f b -> f a <$ ParsecT Void Text (RIO AppState) Char forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => m (Token s) newline, DefinitionReference -> Maybe DefinitionReference forall a. a -> Maybe a Just (DefinitionReference -> Maybe DefinitionReference) -> ParsecT Void Text (RIO AppState) DefinitionReference -> ParsecT Void Text (RIO AppState) (Maybe DefinitionReference) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (Tokens Text -> ParsecT Void Text (RIO AppState) (Tokens Text) forall e s (m :: * -> *). MonadParsec e s m => Tokens s -> m (Tokens s) string Tokens Text ": " ParsecT Void Text (RIO AppState) Text -> ParsecT Void Text (RIO AppState) DefinitionReference -> ParsecT Void Text (RIO AppState) DefinitionReference forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b *> [TypeVariable] -> ParsecT Void Text (RIO AppState) DefinitionReference structReferenceP [TypeVariable] typeVariables ParsecT Void Text (RIO AppState) DefinitionReference -> ParsecT Void Text (RIO AppState) Char -> ParsecT Void Text (RIO AppState) DefinitionReference forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a <* ParsecT Void Text (RIO AppState) Char forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => m (Token s) newline) ] pure $ ConstructorName -> Maybe DefinitionReference -> EmbeddedConstructor EmbeddedConstructor (Text -> ConstructorName ConstructorName Text constructorName) Maybe DefinitionReference maybeDefinition structReferenceP :: [TypeVariable] -> Parser DefinitionReference structReferenceP :: [TypeVariable] -> ParsecT Void Text (RIO AppState) DefinitionReference structReferenceP [TypeVariable] typeVariables = do DefinitionReference definition <- [TypeVariable] -> ParsecT Void Text (RIO AppState) DefinitionReference definitionReferenceP [TypeVariable] typeVariables case DefinitionReference definition of (DefinitionReference (TypeDefinition DefinitionName _name (Struct (PlainStruct [StructField] _)))) -> DefinitionReference -> ParsecT Void Text (RIO AppState) DefinitionReference forall (f :: * -> *) a. Applicative f => a -> f a pure DefinitionReference definition (ImportedDefinitionReference ModuleName _moduleName (TypeDefinition DefinitionName _name (Struct (PlainStruct [StructField] _)))) -> DefinitionReference -> ParsecT Void Text (RIO AppState) DefinitionReference forall (f :: * -> *) a. Applicative f => a -> f a pure DefinitionReference definition (AppliedGenericReference [FieldType] _appliedTypes (TypeDefinition DefinitionName _name (Struct (PlainStruct [StructField] _)))) -> DefinitionReference -> ParsecT Void Text (RIO AppState) DefinitionReference forall (f :: * -> *) a. Applicative f => a -> f a pure DefinitionReference definition ( AppliedImportedGenericReference ModuleName _moduleName AppliedTypes _appliedTypes (TypeDefinition DefinitionName _name (Struct (PlainStruct [StructField] _))) ) -> DefinitionReference -> ParsecT Void Text (RIO AppState) DefinitionReference forall (f :: * -> *) a. Applicative f => a -> f a pure DefinitionReference definition DefinitionReference other -> FilePath -> ParsecT Void Text (RIO AppState) DefinitionReference forall a. FilePath -> Parser a reportError (FilePath -> ParsecT Void Text (RIO AppState) DefinitionReference) -> FilePath -> ParsecT Void Text (RIO AppState) DefinitionReference forall a b. (a -> b) -> a -> b $ [FilePath] -> FilePath forall a. Monoid a => [a] -> a mconcat [FilePath "Expected plain struct reference, got: ", DefinitionReference -> FilePath forall a. Show a => a -> FilePath show DefinitionReference other] embeddedConstructorNameP :: Parser Text embeddedConstructorNameP :: ParsecT Void Text (RIO AppState) Text embeddedConstructorNameP = FilePath -> Text pack (FilePath -> Text) -> ParsecT Void Text (RIO AppState) FilePath -> ParsecT Void Text (RIO AppState) Text forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> ParsecT Void Text (RIO AppState) Char -> ParsecT Void Text (RIO AppState) FilePath forall (m :: * -> *) a. MonadPlus m => m a -> m [a] some ParsecT Void Text (RIO AppState) Char forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => m (Token s) alphaNumChar enumerationP :: Parser TypeDefinition enumerationP :: ParsecT Void Text (RIO AppState) TypeDefinition enumerationP = do DefinitionName name <- Parser DefinitionName definitionNameP DefinitionName -> Parser () setCurrentDefinitionName DefinitionName name Tokens Text -> ParsecT Void Text (RIO AppState) (Tokens Text) forall e s (m :: * -> *). MonadParsec e s m => Tokens s -> m (Tokens s) string Tokens Text " {\n" [EnumerationValue] values <- Parser [EnumerationValue] enumerationValuesP Token Text -> ParsecT Void Text (RIO AppState) (Token Text) forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => Token s -> m (Token s) char Char Token Text '}' pure $ DefinitionName -> TypeData -> TypeDefinition TypeDefinition DefinitionName name (TypeData -> TypeDefinition) -> TypeData -> TypeDefinition forall a b. (a -> b) -> a -> b $ [EnumerationValue] -> TypeData Enumeration [EnumerationValue] values enumerationValuesP :: Parser [EnumerationValue] enumerationValuesP :: Parser [EnumerationValue] enumerationValuesP = ParsecT Void Text (RIO AppState) EnumerationValue -> Parser [EnumerationValue] forall (m :: * -> *) a. MonadPlus m => m a -> m [a] some ParsecT Void Text (RIO AppState) EnumerationValue enumerationValueP enumerationValueP :: Parser EnumerationValue enumerationValueP :: ParsecT Void Text (RIO AppState) EnumerationValue enumerationValueP = do Tokens Text -> ParsecT Void Text (RIO AppState) (Tokens Text) forall e s (m :: * -> *). MonadParsec e s m => Tokens s -> m (Tokens s) string Tokens Text " " EnumerationIdentifier identifier <- (FilePath -> Text pack (FilePath -> Text) -> (Text -> EnumerationIdentifier) -> FilePath -> EnumerationIdentifier forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k). Category cat => cat a b -> cat b c -> cat a c >>> Text -> EnumerationIdentifier EnumerationIdentifier) (FilePath -> EnumerationIdentifier) -> ParsecT Void Text (RIO AppState) FilePath -> ParsecT Void Text (RIO AppState) EnumerationIdentifier forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> ParsecT Void Text (RIO AppState) Char -> ParsecT Void Text (RIO AppState) Text -> ParsecT Void Text (RIO AppState) FilePath forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a] someTill ParsecT Void Text (RIO AppState) Char forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => m (Token s) alphaNumChar (Tokens Text -> ParsecT Void Text (RIO AppState) (Tokens Text) forall e s (m :: * -> *). MonadParsec e s m => Tokens s -> m (Tokens s) string Tokens Text " = ") LiteralTypeValue value <- Parser LiteralTypeValue literalP Parser LiteralTypeValue -> ParsecT Void Text (RIO AppState) Char -> Parser LiteralTypeValue forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a <* ParsecT Void Text (RIO AppState) Char forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => m (Token s) newline pure $ EnumerationIdentifier -> LiteralTypeValue -> EnumerationValue EnumerationValue EnumerationIdentifier identifier LiteralTypeValue value plainUnionP :: FieldName -> DefinitionName -> Parser TypeDefinition plainUnionP :: FieldName -> DefinitionName -> ParsecT Void Text (RIO AppState) TypeDefinition plainUnionP FieldName typeTag DefinitionName name = do [Constructor] constructors <- [TypeVariable] -> Parser [Constructor] constructorsP [] Char _ <- Token Text -> ParsecT Void Text (RIO AppState) (Token Text) forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => Token s -> m (Token s) char Char Token Text '}' pure $ DefinitionName -> TypeData -> TypeDefinition TypeDefinition DefinitionName name (TypeData -> TypeDefinition) -> TypeData -> TypeDefinition forall a b. (a -> b) -> a -> b $ FieldName -> UnionType -> TypeData Union FieldName typeTag ([Constructor] -> UnionType PlainUnion [Constructor] constructors) typeVariablesP :: Parser [Text] typeVariablesP :: ParsecT Void Text (RIO AppState) [Text] typeVariablesP = ParsecT Void Text (RIO AppState) Text -> ParsecT Void Text (RIO AppState) Text -> ParsecT Void Text (RIO AppState) [Text] forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a] sepBy1 ParsecT Void Text (RIO AppState) Text pascalWordP (Tokens Text -> ParsecT Void Text (RIO AppState) (Tokens Text) forall e s (m :: * -> *). MonadParsec e s m => Tokens s -> m (Tokens s) string Tokens Text ", ") pascalWordP :: Parser Text pascalWordP :: ParsecT Void Text (RIO AppState) Text pascalWordP = do Char initialUppercaseCharacter <- ParsecT Void Text (RIO AppState) Char forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => m (Token s) upperChar ((Char initialUppercaseCharacter Char -> FilePath -> FilePath forall a. a -> [a] -> [a] :) (FilePath -> FilePath) -> (FilePath -> Text) -> FilePath -> Text forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k). Category cat => cat a b -> cat b c -> cat a c >>> FilePath -> Text pack) (FilePath -> Text) -> ParsecT Void Text (RIO AppState) FilePath -> ParsecT Void Text (RIO AppState) Text forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> ParsecT Void Text (RIO AppState) Char -> ParsecT Void Text (RIO AppState) FilePath forall (m :: * -> *) a. MonadPlus m => m a -> m [a] many ParsecT Void Text (RIO AppState) Char forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => m (Token s) alphaNumChar fieldsP :: [TypeVariable] -> Parser [StructField] fieldsP :: [TypeVariable] -> Parser [StructField] fieldsP = ParsecT Void Text (RIO AppState) StructField -> Parser [StructField] forall (m :: * -> *) a. MonadPlus m => m a -> m [a] some (ParsecT Void Text (RIO AppState) StructField -> Parser [StructField]) -> ([TypeVariable] -> ParsecT Void Text (RIO AppState) StructField) -> [TypeVariable] -> Parser [StructField] forall b c a. (b -> c) -> (a -> b) -> a -> c . [TypeVariable] -> ParsecT Void Text (RIO AppState) StructField fieldP fieldP :: [TypeVariable] -> Parser StructField fieldP :: [TypeVariable] -> ParsecT Void Text (RIO AppState) StructField fieldP [TypeVariable] typeVariables = do Tokens Text -> ParsecT Void Text (RIO AppState) (Tokens Text) forall e s (m :: * -> *). MonadParsec e s m => Tokens s -> m (Tokens s) string Tokens Text " " FieldName name <- ParsecT Void Text (RIO AppState) FieldName fieldNameP Tokens Text -> ParsecT Void Text (RIO AppState) (Tokens Text) forall e s (m :: * -> *). MonadParsec e s m => Tokens s -> m (Tokens s) string Tokens Text ": " FieldType fieldType <- [TypeVariable] -> ParsecT Void Text (RIO AppState) FieldType fieldTypeP [TypeVariable] typeVariables ParsecT Void Text (RIO AppState) Char forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => m (Token s) newline pure $ FieldName -> FieldType -> StructField StructField FieldName name FieldType fieldType fieldNameP :: Parser FieldName fieldNameP :: ParsecT Void Text (RIO AppState) FieldName fieldNameP = do Char initialAlphaChar <- ParsecT Void Text (RIO AppState) Char forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => m (Token s) lowerChar ParsecT Void Text (RIO AppState) Char -> ParsecT Void Text (RIO AppState) Char -> ParsecT Void Text (RIO AppState) Char forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> ParsecT Void Text (RIO AppState) Char forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => m (Token s) upperChar ((Char initialAlphaChar Char -> FilePath -> FilePath forall a. a -> [a] -> [a] :) (FilePath -> FilePath) -> (FilePath -> FieldName) -> FilePath -> FieldName forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k). Category cat => cat a b -> cat b c -> cat a c >>> FilePath -> Text pack (FilePath -> Text) -> (Text -> FieldName) -> FilePath -> FieldName forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k). Category cat => cat a b -> cat b c -> cat a c >>> Text -> FieldName FieldName) (FilePath -> FieldName) -> ParsecT Void Text (RIO AppState) FilePath -> ParsecT Void Text (RIO AppState) FieldName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> ParsecT Void Text (RIO AppState) Char -> ParsecT Void Text (RIO AppState) FilePath forall (m :: * -> *) a. MonadPlus m => m a -> m [a] some (ParsecT Void Text (RIO AppState) Char forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => m (Token s) alphaNumChar ParsecT Void Text (RIO AppState) Char -> ParsecT Void Text (RIO AppState) Char -> ParsecT Void Text (RIO AppState) Char forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> Token Text -> ParsecT Void Text (RIO AppState) (Token Text) forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => Token s -> m (Token s) char Char Token Text '_') definitionNameP :: Parser DefinitionName definitionNameP :: Parser DefinitionName definitionNameP = do Char initialTitleCaseCharacter <- ParsecT Void Text (RIO AppState) Char forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => m (Token s) upperChar ((Char initialTitleCaseCharacter Char -> FilePath -> FilePath forall a. a -> [a] -> [a] :) (FilePath -> FilePath) -> (FilePath -> DefinitionName) -> FilePath -> DefinitionName forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k). Category cat => cat a b -> cat b c -> cat a c >>> FilePath -> Text pack (FilePath -> Text) -> (Text -> DefinitionName) -> FilePath -> DefinitionName forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k). Category cat => cat a b -> cat b c -> cat a c >>> Text -> DefinitionName DefinitionName) (FilePath -> DefinitionName) -> ParsecT Void Text (RIO AppState) FilePath -> Parser DefinitionName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> ParsecT Void Text (RIO AppState) Char -> ParsecT Void Text (RIO AppState) FilePath forall (m :: * -> *) a. MonadPlus m => m a -> m [a] many ParsecT Void Text (RIO AppState) Char forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => m (Token s) alphaNumChar setCurrentDefinitionName :: DefinitionName -> Parser () setCurrentDefinitionName :: DefinitionName -> Parser () setCurrentDefinitionName DefinitionName name = do AppState {IORef (Maybe DefinitionName) currentDefinitionNameReference :: IORef (Maybe DefinitionName) $sel:currentDefinitionNameReference:AppState :: AppState -> IORef (Maybe DefinitionName) currentDefinitionNameReference} <- ParsecT Void Text (RIO AppState) AppState forall r (m :: * -> *). MonadReader r m => m r ask IORef (Maybe DefinitionName) -> Maybe DefinitionName -> Parser () forall (m :: * -> *) a. MonadIO m => IORef a -> a -> m () writeIORef IORef (Maybe DefinitionName) currentDefinitionNameReference (DefinitionName -> Maybe DefinitionName forall a. a -> Maybe a Just DefinitionName name) recursiveReferenceP :: Parser DefinitionName recursiveReferenceP :: Parser DefinitionName recursiveReferenceP = do AppState {IORef (Maybe DefinitionName) currentDefinitionNameReference :: IORef (Maybe DefinitionName) $sel:currentDefinitionNameReference:AppState :: AppState -> IORef (Maybe DefinitionName) currentDefinitionNameReference} <- ParsecT Void Text (RIO AppState) AppState forall r (m :: * -> *). MonadReader r m => m r ask Maybe DefinitionName maybeCurrentDefinitionName <- IORef (Maybe DefinitionName) -> ParsecT Void Text (RIO AppState) (Maybe DefinitionName) forall (m :: * -> *) a. MonadIO m => IORef a -> m a readIORef IORef (Maybe DefinitionName) currentDefinitionNameReference case Maybe DefinitionName maybeCurrentDefinitionName of Just currentDefinitionName :: DefinitionName currentDefinitionName@(DefinitionName Text n) -> do Text _ <- Tokens Text -> ParsecT Void Text (RIO AppState) (Tokens Text) forall e s (m :: * -> *). MonadParsec e s m => Tokens s -> m (Tokens s) string Text Tokens Text n pure DefinitionName currentDefinitionName Maybe DefinitionName Nothing -> FilePath -> Parser DefinitionName forall a. FilePath -> Parser a reportError FilePath "Recursive reference not valid when we have no current definition name" definitionReferenceP :: [TypeVariable] -> Parser DefinitionReference definitionReferenceP :: [TypeVariable] -> ParsecT Void Text (RIO AppState) DefinitionReference definitionReferenceP [TypeVariable] typeVariables = do [TypeDefinition] definitions <- ParsecT Void Text (RIO AppState) [TypeDefinition] getDefinitions let definitionNames :: [Text] definitionNames = [TypeDefinition] definitions [TypeDefinition] -> ([TypeDefinition] -> [Text]) -> [Text] forall a b. a -> (a -> b) -> b & (TypeDefinition -> Text) -> [TypeDefinition] -> [Text] forall a b. (a -> b) -> [a] -> [b] List.map (\(TypeDefinition (DefinitionName Text n) TypeData _typeData) -> Text n) [Text] -> ([Text] -> [Text]) -> [Text] forall a b. a -> (a -> b) -> b & (Text -> Text -> Ordering) -> [Text] -> [Text] forall a. (a -> a -> Ordering) -> [a] -> [a] List.sortBy (\Text n1 Text n2 -> Int -> Int -> Ordering forall a. Ord a => a -> a -> Ordering compare (Text -> Int Text.length Text n2) (Text -> Int Text.length Text n1)) soughtName :: DefinitionName soughtName@(DefinitionName Text n) <- Text -> DefinitionName DefinitionName (Text -> DefinitionName) -> ParsecT Void Text (RIO AppState) Text -> Parser DefinitionName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [ParsecT Void Text (RIO AppState) Text] -> ParsecT Void Text (RIO AppState) Text forall (f :: * -> *) (m :: * -> *) a. (Foldable f, Alternative m) => f (m a) -> m a choice ((Text -> ParsecT Void Text (RIO AppState) Text) -> [Text] -> [ParsecT Void Text (RIO AppState) Text] forall a b. (a -> b) -> [a] -> [b] List.map Text -> ParsecT Void Text (RIO AppState) Text forall e s (m :: * -> *). MonadParsec e s m => Tokens s -> m (Tokens s) string [Text] definitionNames) Maybe TypeDefinition maybeDefinition <- DefinitionName -> Parser (Maybe TypeDefinition) getDefinition DefinitionName soughtName Maybe [FieldType] maybeTypeVariables <- Parser [FieldType] -> ParsecT Void Text (RIO AppState) (Maybe [FieldType]) forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a) optional (Parser [FieldType] -> ParsecT Void Text (RIO AppState) (Maybe [FieldType])) -> Parser [FieldType] -> ParsecT Void Text (RIO AppState) (Maybe [FieldType]) forall a b. (a -> b) -> a -> b $ ParsecT Void Text (RIO AppState) Char -> ParsecT Void Text (RIO AppState) Char -> Parser [FieldType] -> Parser [FieldType] forall (m :: * -> *) open close a. Applicative m => m open -> m close -> m a -> m a between (Token Text -> ParsecT Void Text (RIO AppState) (Token Text) forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => Token s -> m (Token s) char Char Token Text '<') (Token Text -> ParsecT Void Text (RIO AppState) (Token Text) forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => Token s -> m (Token s) char Char Token Text '>') (Parser [FieldType] -> Parser [FieldType]) -> Parser [FieldType] -> Parser [FieldType] forall a b. (a -> b) -> a -> b $ ParsecT Void Text (RIO AppState) FieldType -> ParsecT Void Text (RIO AppState) Text -> Parser [FieldType] forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a] sepBy1 ([TypeVariable] -> ParsecT Void Text (RIO AppState) FieldType fieldTypeP [TypeVariable] typeVariables) (Tokens Text -> ParsecT Void Text (RIO AppState) (Tokens Text) forall e s (m :: * -> *). MonadParsec e s m => Tokens s -> m (Tokens s) string Tokens Text ", ") case Maybe TypeDefinition maybeDefinition of Just (TypeDefinition DefinitionName name' (DeclaredType ModuleName moduleName [TypeVariable] _typeVariables)) -> case Maybe [FieldType] maybeTypeVariables of Maybe [FieldType] Nothing -> DefinitionReference -> ParsecT Void Text (RIO AppState) DefinitionReference forall (f :: * -> *) a. Applicative f => a -> f a pure (DefinitionReference -> ParsecT Void Text (RIO AppState) DefinitionReference) -> DefinitionReference -> ParsecT Void Text (RIO AppState) DefinitionReference forall a b. (a -> b) -> a -> b $ ModuleName -> DefinitionName -> DefinitionReference DeclarationReference ModuleName moduleName DefinitionName name' Just [FieldType] appliedTypes -> DefinitionReference -> ParsecT Void Text (RIO AppState) DefinitionReference forall (f :: * -> *) a. Applicative f => a -> f a pure (DefinitionReference -> ParsecT Void Text (RIO AppState) DefinitionReference) -> DefinitionReference -> ParsecT Void Text (RIO AppState) DefinitionReference forall a b. (a -> b) -> a -> b $ ModuleName -> DefinitionName -> AppliedTypes -> DefinitionReference GenericDeclarationReference ModuleName moduleName DefinitionName name' ([FieldType] -> AppliedTypes AppliedTypes [FieldType] appliedTypes) Just TypeDefinition definition -> do case Maybe [FieldType] maybeTypeVariables of Just [FieldType] appliedTypeVariables -> DefinitionReference -> ParsecT Void Text (RIO AppState) DefinitionReference forall (f :: * -> *) a. Applicative f => a -> f a pure (DefinitionReference -> ParsecT Void Text (RIO AppState) DefinitionReference) -> DefinitionReference -> ParsecT Void Text (RIO AppState) DefinitionReference forall a b. (a -> b) -> a -> b $ [FieldType] -> TypeDefinition -> DefinitionReference AppliedGenericReference [FieldType] appliedTypeVariables TypeDefinition definition Maybe [FieldType] Nothing -> DefinitionReference -> ParsecT Void Text (RIO AppState) DefinitionReference forall (f :: * -> *) a. Applicative f => a -> f a pure (DefinitionReference -> ParsecT Void Text (RIO AppState) DefinitionReference) -> DefinitionReference -> ParsecT Void Text (RIO AppState) DefinitionReference forall a b. (a -> b) -> a -> b $ TypeDefinition -> DefinitionReference DefinitionReference TypeDefinition definition Maybe TypeDefinition Nothing -> FilePath -> ParsecT Void Text (RIO AppState) DefinitionReference forall a. FilePath -> Parser a reportError (FilePath -> ParsecT Void Text (RIO AppState) DefinitionReference) -> FilePath -> ParsecT Void Text (RIO AppState) DefinitionReference forall a b. (a -> b) -> a -> b $ [FilePath] -> FilePath forall a. Monoid a => [a] -> a mconcat [FilePath "Unknown type reference: ", Text -> FilePath unpack Text n] getDefinitions :: Parser [TypeDefinition] getDefinitions :: ParsecT Void Text (RIO AppState) [TypeDefinition] getDefinitions = do AppState {IORef [TypeDefinition] currentDefinitionsReference :: IORef [TypeDefinition] $sel:currentDefinitionsReference:AppState :: AppState -> IORef [TypeDefinition] currentDefinitionsReference} <- ParsecT Void Text (RIO AppState) AppState forall r (m :: * -> *). MonadReader r m => m r ask IORef [TypeDefinition] -> ParsecT Void Text (RIO AppState) [TypeDefinition] forall (m :: * -> *) a. MonadIO m => IORef a -> m a readIORef IORef [TypeDefinition] currentDefinitionsReference getDefinition :: DefinitionName -> Parser (Maybe TypeDefinition) getDefinition :: DefinitionName -> Parser (Maybe TypeDefinition) getDefinition DefinitionName name = do AppState {IORef [TypeDefinition] currentDefinitionsReference :: IORef [TypeDefinition] $sel:currentDefinitionsReference:AppState :: AppState -> IORef [TypeDefinition] currentDefinitionsReference} <- ParsecT Void Text (RIO AppState) AppState forall r (m :: * -> *). MonadReader r m => m r ask [TypeDefinition] definitions <- IORef [TypeDefinition] -> ParsecT Void Text (RIO AppState) [TypeDefinition] forall (m :: * -> *) a. MonadIO m => IORef a -> m a readIORef IORef [TypeDefinition] currentDefinitionsReference pure $ (TypeDefinition -> Bool) -> [TypeDefinition] -> Maybe TypeDefinition forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a List.find (\(TypeDefinition DefinitionName definitionName TypeData _typeData) -> DefinitionName name DefinitionName -> DefinitionName -> Bool forall a. Eq a => a -> a -> Bool == DefinitionName definitionName) [TypeDefinition] definitions addDefinition :: TypeDefinition -> Parser () addDefinition :: TypeDefinition -> Parser () addDefinition definition :: TypeDefinition definition@(TypeDefinition (DefinitionName Text definitionName) TypeData _typeData) = do AppState {IORef [TypeDefinition] currentDefinitionsReference :: IORef [TypeDefinition] $sel:currentDefinitionsReference:AppState :: AppState -> IORef [TypeDefinition] currentDefinitionsReference} <- ParsecT Void Text (RIO AppState) AppState forall r (m :: * -> *). MonadReader r m => m r ask [TypeDefinition] definitions <- IORef [TypeDefinition] -> ParsecT Void Text (RIO AppState) [TypeDefinition] forall (m :: * -> *) a. MonadIO m => IORef a -> m a readIORef IORef [TypeDefinition] currentDefinitionsReference if Bool -> Bool not (TypeDefinition -> [TypeDefinition] -> Bool hasDefinition TypeDefinition definition [TypeDefinition] definitions) then IORef [TypeDefinition] -> ([TypeDefinition] -> [TypeDefinition]) -> Parser () forall (m :: * -> *) a. MonadIO m => IORef a -> (a -> a) -> m () modifyIORef IORef [TypeDefinition] currentDefinitionsReference (TypeDefinition definition TypeDefinition -> [TypeDefinition] -> [TypeDefinition] forall a. a -> [a] -> [a] :) else FilePath -> Parser () forall a. FilePath -> Parser a reportError (FilePath -> Parser ()) -> FilePath -> Parser () forall a b. (a -> b) -> a -> b $ FilePath "Duplicate definition with name '" FilePath -> FilePath -> FilePath forall a. Semigroup a => a -> a -> a <> Text -> FilePath unpack Text definitionName FilePath -> FilePath -> FilePath forall a. Semigroup a => a -> a -> a <> FilePath "'" clearDefinitions :: Parser () clearDefinitions :: Parser () clearDefinitions = do AppState {IORef [TypeDefinition] currentDefinitionsReference :: IORef [TypeDefinition] $sel:currentDefinitionsReference:AppState :: AppState -> IORef [TypeDefinition] currentDefinitionsReference} <- ParsecT Void Text (RIO AppState) AppState forall r (m :: * -> *). MonadReader r m => m r ask IORef [TypeDefinition] -> [TypeDefinition] -> Parser () forall (m :: * -> *) a. MonadIO m => IORef a -> a -> m () writeIORef IORef [TypeDefinition] currentDefinitionsReference [TypeDefinition] forall a. Monoid a => a mempty hasDefinition :: TypeDefinition -> [TypeDefinition] -> Bool hasDefinition :: TypeDefinition -> [TypeDefinition] -> Bool hasDefinition (TypeDefinition DefinitionName name TypeData _typeData) = (TypeDefinition -> Bool) -> [TypeDefinition] -> Bool forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool any (\(TypeDefinition DefinitionName name' TypeData _typeData) -> DefinitionName name DefinitionName -> DefinitionName -> Bool forall a. Eq a => a -> a -> Bool == DefinitionName name') fieldTypeP :: [TypeVariable] -> Parser FieldType fieldTypeP :: [TypeVariable] -> ParsecT Void Text (RIO AppState) FieldType fieldTypeP [TypeVariable] typeVariables = [ParsecT Void Text (RIO AppState) FieldType] -> ParsecT Void Text (RIO AppState) FieldType forall (f :: * -> *) (m :: * -> *) a. (Foldable f, Alternative m) => f (m a) -> m a choice [ LiteralTypeValue -> FieldType LiteralType (LiteralTypeValue -> FieldType) -> Parser LiteralTypeValue -> ParsecT Void Text (RIO AppState) FieldType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Parser LiteralTypeValue literalP, ComplexTypeValue -> FieldType ComplexType (ComplexTypeValue -> FieldType) -> ParsecT Void Text (RIO AppState) ComplexTypeValue -> ParsecT Void Text (RIO AppState) FieldType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [TypeVariable] -> ParsecT Void Text (RIO AppState) ComplexTypeValue complexTypeP [TypeVariable] typeVariables, TypeVariable -> FieldType TypeVariableReferenceType (TypeVariable -> FieldType) -> ParsecT Void Text (RIO AppState) TypeVariable -> ParsecT Void Text (RIO AppState) FieldType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [TypeVariable] -> ParsecT Void Text (RIO AppState) TypeVariable typeVariableReferenceP [TypeVariable] typeVariables, DefinitionReference -> FieldType DefinitionReferenceType (DefinitionReference -> FieldType) -> ParsecT Void Text (RIO AppState) DefinitionReference -> ParsecT Void Text (RIO AppState) FieldType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [TypeVariable] -> ParsecT Void Text (RIO AppState) DefinitionReference definitionReferenceP [TypeVariable] typeVariables, BasicTypeValue -> FieldType BasicType (BasicTypeValue -> FieldType) -> ParsecT Void Text (RIO AppState) BasicTypeValue -> ParsecT Void Text (RIO AppState) FieldType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> ParsecT Void Text (RIO AppState) BasicTypeValue basicTypeValueP, DefinitionReference -> FieldType DefinitionReferenceType (DefinitionReference -> FieldType) -> ParsecT Void Text (RIO AppState) DefinitionReference -> ParsecT Void Text (RIO AppState) FieldType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [TypeVariable] -> ParsecT Void Text (RIO AppState) DefinitionReference importedReferenceP [TypeVariable] typeVariables, DefinitionName -> FieldType RecursiveReferenceType (DefinitionName -> FieldType) -> Parser DefinitionName -> ParsecT Void Text (RIO AppState) FieldType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Parser DefinitionName recursiveReferenceP ] typeVariableReferenceP :: [TypeVariable] -> Parser TypeVariable typeVariableReferenceP :: [TypeVariable] -> ParsecT Void Text (RIO AppState) TypeVariable typeVariableReferenceP [TypeVariable] typeVariables = Text -> TypeVariable TypeVariable (Text -> TypeVariable) -> ParsecT Void Text (RIO AppState) Text -> ParsecT Void Text (RIO AppState) TypeVariable forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [ParsecT Void Text (RIO AppState) Text] -> ParsecT Void Text (RIO AppState) Text forall (f :: * -> *) (m :: * -> *) a. (Foldable f, Alternative m) => f (m a) -> m a choice ((TypeVariable -> ParsecT Void Text (RIO AppState) Text) -> [TypeVariable] -> [ParsecT Void Text (RIO AppState) Text] forall a b. (a -> b) -> [a] -> [b] List.map (\(TypeVariable Text t) -> Tokens Text -> ParsecT Void Text (RIO AppState) (Tokens Text) forall e s (m :: * -> *). MonadParsec e s m => Tokens s -> m (Tokens s) string Text Tokens Text t) [TypeVariable] typeVariables) importedReferenceP :: [TypeVariable] -> Parser DefinitionReference importedReferenceP :: [TypeVariable] -> ParsecT Void Text (RIO AppState) DefinitionReference importedReferenceP [TypeVariable] typeVariables = do [Import] imports <- ParsecT Void Text (RIO AppState) [Import] getImports Text moduleName <- [ParsecT Void Text (RIO AppState) Text] -> ParsecT Void Text (RIO AppState) Text forall (f :: * -> *) (m :: * -> *) a. (Foldable f, Alternative m) => f (m a) -> m a choice ((Import -> ParsecT Void Text (RIO AppState) Text) -> [Import] -> [ParsecT Void Text (RIO AppState) Text] forall a b. (a -> b) -> [a] -> [b] List.map (\(Import Module {$sel:name:Module :: Module -> ModuleName name = ModuleName Text name}) -> Tokens Text -> ParsecT Void Text (RIO AppState) (Tokens Text) forall e s (m :: * -> *). MonadParsec e s m => Tokens s -> m (Tokens s) string Text Tokens Text name) [Import] imports) ParsecT Void Text (RIO AppState) Text -> ParsecT Void Text (RIO AppState) Char -> ParsecT Void Text (RIO AppState) Text forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a <* Token Text -> ParsecT Void Text (RIO AppState) (Token Text) forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => Token s -> m (Token s) char Char Token Text '.' definitionName :: DefinitionName definitionName@(DefinitionName Text n) <- Parser DefinitionName definitionNameP Maybe Import maybeModule <- Text -> Parser (Maybe Import) getImport Text moduleName case Maybe Import maybeModule of Just (Import Module {$sel:name:Module :: Module -> ModuleName name = ModuleName sourceModule, [TypeDefinition] definitions :: [TypeDefinition] $sel:definitions:Module :: Module -> [TypeDefinition] definitions}) -> do case (TypeDefinition -> Bool) -> [TypeDefinition] -> Maybe TypeDefinition forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a List.find (\(TypeDefinition DefinitionName name TypeData _typeData) -> DefinitionName name DefinitionName -> DefinitionName -> Bool forall a. Eq a => a -> a -> Bool == DefinitionName definitionName) [TypeDefinition] definitions of Just definition :: TypeDefinition definition@(TypeDefinition DefinitionName foundDefinitionName TypeData typeData) -> do Maybe [FieldType] maybeTypeVariables <- Parser [FieldType] -> ParsecT Void Text (RIO AppState) (Maybe [FieldType]) forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a) optional (Parser [FieldType] -> ParsecT Void Text (RIO AppState) (Maybe [FieldType])) -> Parser [FieldType] -> ParsecT Void Text (RIO AppState) (Maybe [FieldType]) forall a b. (a -> b) -> a -> b $ ParsecT Void Text (RIO AppState) Char -> ParsecT Void Text (RIO AppState) Char -> Parser [FieldType] -> Parser [FieldType] forall (m :: * -> *) open close a. Applicative m => m open -> m close -> m a -> m a between (Token Text -> ParsecT Void Text (RIO AppState) (Token Text) forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => Token s -> m (Token s) char Char Token Text '<') (Token Text -> ParsecT Void Text (RIO AppState) (Token Text) forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => Token s -> m (Token s) char Char Token Text '>') (Parser [FieldType] -> Parser [FieldType]) -> Parser [FieldType] -> Parser [FieldType] forall a b. (a -> b) -> a -> b $ ParsecT Void Text (RIO AppState) FieldType -> ParsecT Void Text (RIO AppState) Text -> Parser [FieldType] forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a] sepBy1 ([TypeVariable] -> ParsecT Void Text (RIO AppState) FieldType fieldTypeP [TypeVariable] typeVariables) (Tokens Text -> ParsecT Void Text (RIO AppState) (Tokens Text) forall e s (m :: * -> *). MonadParsec e s m => Tokens s -> m (Tokens s) string Tokens Text ", ") pure $ case Maybe [FieldType] maybeTypeVariables of Just [FieldType] appliedTypeVariables -> ModuleName -> AppliedTypes -> TypeDefinition -> DefinitionReference AppliedImportedGenericReference (Text -> ModuleName ModuleName Text moduleName) ([FieldType] -> AppliedTypes AppliedTypes [FieldType] appliedTypeVariables) TypeDefinition definition Maybe [FieldType] Nothing -> ModuleName -> TypeDefinition -> DefinitionReference ImportedDefinitionReference ModuleName sourceModule (TypeDefinition -> DefinitionReference) -> TypeDefinition -> DefinitionReference forall a b. (a -> b) -> a -> b $ DefinitionName -> TypeData -> TypeDefinition TypeDefinition DefinitionName foundDefinitionName TypeData typeData Maybe TypeDefinition Nothing -> FilePath -> ParsecT Void Text (RIO AppState) DefinitionReference forall a. FilePath -> Parser a reportError (FilePath -> ParsecT Void Text (RIO AppState) DefinitionReference) -> FilePath -> ParsecT Void Text (RIO AppState) DefinitionReference forall a b. (a -> b) -> a -> b $ [FilePath] -> FilePath forall a. Monoid a => [a] -> a mconcat [ FilePath "Unknown definition in module '", Text -> FilePath unpack Text moduleName, FilePath "': ", Text -> FilePath unpack Text n ] Maybe Import Nothing -> FilePath -> ParsecT Void Text (RIO AppState) DefinitionReference forall a. FilePath -> Parser a reportError (FilePath -> ParsecT Void Text (RIO AppState) DefinitionReference) -> FilePath -> ParsecT Void Text (RIO AppState) DefinitionReference forall a b. (a -> b) -> a -> b $ FilePath "Unknown module referenced, not in imports: " FilePath -> FilePath -> FilePath forall a. Semigroup a => a -> a -> a <> Text -> FilePath unpack Text moduleName getImports :: Parser [Import] getImports :: ParsecT Void Text (RIO AppState) [Import] getImports = do AppState {IORef [Import] currentImportsReference :: IORef [Import] $sel:currentImportsReference:AppState :: AppState -> IORef [Import] currentImportsReference} <- ParsecT Void Text (RIO AppState) AppState forall r (m :: * -> *). MonadReader r m => m r ask IORef [Import] -> ParsecT Void Text (RIO AppState) [Import] forall (m :: * -> *) a. MonadIO m => IORef a -> m a readIORef IORef [Import] currentImportsReference getImport :: Text -> Parser (Maybe Import) getImport :: Text -> Parser (Maybe Import) getImport Text soughtName = do AppState {IORef [Import] currentImportsReference :: IORef [Import] $sel:currentImportsReference:AppState :: AppState -> IORef [Import] currentImportsReference} <- ParsecT Void Text (RIO AppState) AppState forall r (m :: * -> *). MonadReader r m => m r ask [Import] imports <- IORef [Import] -> ParsecT Void Text (RIO AppState) [Import] forall (m :: * -> *) a. MonadIO m => IORef a -> m a readIORef IORef [Import] currentImportsReference pure $ (Import -> Bool) -> [Import] -> Maybe Import forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a List.find (\(Import Module {$sel:name:Module :: Module -> ModuleName name = ModuleName Text name}) -> Text soughtName Text -> Text -> Bool forall a. Eq a => a -> a -> Bool == Text name) [Import] imports reportError :: String -> Parser a reportError :: FilePath -> Parser a reportError = FilePath -> ErrorFancy Void forall e. FilePath -> ErrorFancy e ErrorFail (FilePath -> ErrorFancy Void) -> (ErrorFancy Void -> Parser a) -> FilePath -> Parser a forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k). Category cat => cat a b -> cat b c -> cat a c >>> ErrorFancy Void -> Set (ErrorFancy Void) forall a. a -> Set a Set.singleton (ErrorFancy Void -> Set (ErrorFancy Void)) -> (Set (ErrorFancy Void) -> Parser a) -> ErrorFancy Void -> Parser a forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k). Category cat => cat a b -> cat b c -> cat a c >>> Set (ErrorFancy Void) -> Parser a forall e s (m :: * -> *) a. MonadParsec e s m => Set (ErrorFancy e) -> m a fancyFailure basicTypeValueP :: Parser BasicTypeValue basicTypeValueP :: ParsecT Void Text (RIO AppState) BasicTypeValue basicTypeValueP = [ParsecT Void Text (RIO AppState) BasicTypeValue] -> ParsecT Void Text (RIO AppState) BasicTypeValue forall (f :: * -> *) (m :: * -> *) a. (Foldable f, Alternative m) => f (m a) -> m a choice [ParsecT Void Text (RIO AppState) BasicTypeValue uintP, ParsecT Void Text (RIO AppState) BasicTypeValue intP, ParsecT Void Text (RIO AppState) BasicTypeValue floatP, ParsecT Void Text (RIO AppState) BasicTypeValue booleanP, ParsecT Void Text (RIO AppState) BasicTypeValue basicStringP] complexTypeP :: [TypeVariable] -> Parser ComplexTypeValue complexTypeP :: [TypeVariable] -> ParsecT Void Text (RIO AppState) ComplexTypeValue complexTypeP [TypeVariable] typeVariables = [ParsecT Void Text (RIO AppState) ComplexTypeValue] -> ParsecT Void Text (RIO AppState) ComplexTypeValue forall (f :: * -> *) (m :: * -> *) a. (Foldable f, Alternative m) => f (m a) -> m a choice [ [TypeVariable] -> ParsecT Void Text (RIO AppState) ComplexTypeValue sliceTypeP [TypeVariable] typeVariables, [TypeVariable] -> ParsecT Void Text (RIO AppState) ComplexTypeValue arrayTypeP [TypeVariable] typeVariables, [TypeVariable] -> ParsecT Void Text (RIO AppState) ComplexTypeValue optionalTypeP [TypeVariable] typeVariables, [TypeVariable] -> ParsecT Void Text (RIO AppState) ComplexTypeValue pointerTypeP [TypeVariable] typeVariables ] sliceTypeP :: [TypeVariable] -> Parser ComplexTypeValue sliceTypeP :: [TypeVariable] -> ParsecT Void Text (RIO AppState) ComplexTypeValue sliceTypeP [TypeVariable] typeVariables = FieldType -> ComplexTypeValue SliceType (FieldType -> ComplexTypeValue) -> ParsecT Void Text (RIO AppState) FieldType -> ParsecT Void Text (RIO AppState) ComplexTypeValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> ParsecT Void Text (RIO AppState) Text -> ParsecT Void Text (RIO AppState) FieldType -> ParsecT Void Text (RIO AppState) FieldType forall ignored a. Parser ignored -> Parser a -> Parser a precededBy (Tokens Text -> ParsecT Void Text (RIO AppState) (Tokens Text) forall e s (m :: * -> *). MonadParsec e s m => Tokens s -> m (Tokens s) string Tokens Text "[]") ([TypeVariable] -> ParsecT Void Text (RIO AppState) FieldType fieldTypeP [TypeVariable] typeVariables) arrayTypeP :: [TypeVariable] -> Parser ComplexTypeValue arrayTypeP :: [TypeVariable] -> ParsecT Void Text (RIO AppState) ComplexTypeValue arrayTypeP [TypeVariable] typeVariables = do Integer size <- ParsecT Void Text (RIO AppState) Char -> ParsecT Void Text (RIO AppState) Char -> ParsecT Void Text (RIO AppState) Integer -> ParsecT Void Text (RIO AppState) Integer forall (m :: * -> *) open close a. Applicative m => m open -> m close -> m a -> m a between (Token Text -> ParsecT Void Text (RIO AppState) (Token Text) forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => Token s -> m (Token s) char Char Token Text '[') (Token Text -> ParsecT Void Text (RIO AppState) (Token Text) forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => Token s -> m (Token s) char Char Token Text ']') ParsecT Void Text (RIO AppState) Integer forall e s (m :: * -> *) a. (MonadParsec e s m, Token s ~ Char, Num a) => m a decimal Integer -> FieldType -> ComplexTypeValue ArrayType Integer size (FieldType -> ComplexTypeValue) -> ParsecT Void Text (RIO AppState) FieldType -> ParsecT Void Text (RIO AppState) ComplexTypeValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [TypeVariable] -> ParsecT Void Text (RIO AppState) FieldType fieldTypeP [TypeVariable] typeVariables optionalTypeP :: [TypeVariable] -> Parser ComplexTypeValue optionalTypeP :: [TypeVariable] -> ParsecT Void Text (RIO AppState) ComplexTypeValue optionalTypeP [TypeVariable] typeVariables = FieldType -> ComplexTypeValue OptionalType (FieldType -> ComplexTypeValue) -> ParsecT Void Text (RIO AppState) FieldType -> ParsecT Void Text (RIO AppState) ComplexTypeValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> ParsecT Void Text (RIO AppState) Char -> ParsecT Void Text (RIO AppState) FieldType -> ParsecT Void Text (RIO AppState) FieldType forall ignored a. Parser ignored -> Parser a -> Parser a precededBy (Token Text -> ParsecT Void Text (RIO AppState) (Token Text) forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => Token s -> m (Token s) char Char Token Text '?') ([TypeVariable] -> ParsecT Void Text (RIO AppState) FieldType fieldTypeP [TypeVariable] typeVariables) pointerTypeP :: [TypeVariable] -> Parser ComplexTypeValue pointerTypeP :: [TypeVariable] -> ParsecT Void Text (RIO AppState) ComplexTypeValue pointerTypeP [TypeVariable] typeVariables = FieldType -> ComplexTypeValue PointerType (FieldType -> ComplexTypeValue) -> ParsecT Void Text (RIO AppState) FieldType -> ParsecT Void Text (RIO AppState) ComplexTypeValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> ParsecT Void Text (RIO AppState) Char -> ParsecT Void Text (RIO AppState) FieldType -> ParsecT Void Text (RIO AppState) FieldType forall ignored a. Parser ignored -> Parser a -> Parser a precededBy (Token Text -> ParsecT Void Text (RIO AppState) (Token Text) forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => Token s -> m (Token s) char Char Token Text '*') ([TypeVariable] -> ParsecT Void Text (RIO AppState) FieldType fieldTypeP [TypeVariable] typeVariables) precededBy :: Parser ignored -> Parser a -> Parser a precededBy :: Parser ignored -> Parser a -> Parser a precededBy Parser ignored precededParser Parser a parser = do ignored _ <- Parser ignored precededParser Parser a parser integerSizes :: [Int] integerSizes :: [Int] integerSizes = [Int 8, Int 16, Int 32, Int 64, Int 128] integerTypeParsers :: Text -> [Parser Text] integerTypeParsers :: Text -> [ParsecT Void Text (RIO AppState) Text] integerTypeParsers Text prefix = (Int -> ParsecT Void Text (RIO AppState) Text) -> [Int] -> [ParsecT Void Text (RIO AppState) Text] forall a b. (a -> b) -> [a] -> [b] List.map (Int -> FilePath forall a. Show a => a -> FilePath show (Int -> FilePath) -> (FilePath -> ParsecT Void Text (RIO AppState) Text) -> Int -> ParsecT Void Text (RIO AppState) Text forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k). Category cat => cat a b -> cat b c -> cat a c >>> FilePath -> Text pack (FilePath -> Text) -> (Text -> ParsecT Void Text (RIO AppState) Text) -> FilePath -> ParsecT Void Text (RIO AppState) Text forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k). Category cat => cat a b -> cat b c -> cat a c >>> (Text prefix Text -> Text -> Text forall a. Semigroup a => a -> a -> a <>) (Text -> Text) -> (Text -> ParsecT Void Text (RIO AppState) Text) -> Text -> ParsecT Void Text (RIO AppState) Text forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k). Category cat => cat a b -> cat b c -> cat a c >>> Text -> ParsecT Void Text (RIO AppState) Text forall e s (m :: * -> *). MonadParsec e s m => Tokens s -> m (Tokens s) string) [Int] integerSizes uintP :: Parser BasicTypeValue uintP :: ParsecT Void Text (RIO AppState) BasicTypeValue uintP = do Text uint <- [ParsecT Void Text (RIO AppState) Text] -> ParsecT Void Text (RIO AppState) Text forall (f :: * -> *) (m :: * -> *) a. (Foldable f, Alternative m) => f (m a) -> m a choice ([ParsecT Void Text (RIO AppState) Text] -> ParsecT Void Text (RIO AppState) Text) -> [ParsecT Void Text (RIO AppState) Text] -> ParsecT Void Text (RIO AppState) Text forall a b. (a -> b) -> a -> b $ Text -> [ParsecT Void Text (RIO AppState) Text] integerTypeParsers Text "U" case Text uint of Text "U8" -> BasicTypeValue -> ParsecT Void Text (RIO AppState) BasicTypeValue forall (f :: * -> *) a. Applicative f => a -> f a pure BasicTypeValue U8 Text "U16" -> BasicTypeValue -> ParsecT Void Text (RIO AppState) BasicTypeValue forall (f :: * -> *) a. Applicative f => a -> f a pure BasicTypeValue U16 Text "U32" -> BasicTypeValue -> ParsecT Void Text (RIO AppState) BasicTypeValue forall (f :: * -> *) a. Applicative f => a -> f a pure BasicTypeValue U32 Text "U64" -> BasicTypeValue -> ParsecT Void Text (RIO AppState) BasicTypeValue forall (f :: * -> *) a. Applicative f => a -> f a pure BasicTypeValue U64 Text "U128" -> BasicTypeValue -> ParsecT Void Text (RIO AppState) BasicTypeValue forall (f :: * -> *) a. Applicative f => a -> f a pure BasicTypeValue U128 Text other -> FilePath -> ParsecT Void Text (RIO AppState) BasicTypeValue forall a. FilePath -> Parser a reportError (FilePath -> ParsecT Void Text (RIO AppState) BasicTypeValue) -> FilePath -> ParsecT Void Text (RIO AppState) BasicTypeValue forall a b. (a -> b) -> a -> b $ FilePath "Invalid size for Ux: " FilePath -> FilePath -> FilePath forall a. Semigroup a => a -> a -> a <> Text -> FilePath unpack Text other intP :: Parser BasicTypeValue intP :: ParsecT Void Text (RIO AppState) BasicTypeValue intP = do Text int <- [ParsecT Void Text (RIO AppState) Text] -> ParsecT Void Text (RIO AppState) Text forall (f :: * -> *) (m :: * -> *) a. (Foldable f, Alternative m) => f (m a) -> m a choice ([ParsecT Void Text (RIO AppState) Text] -> ParsecT Void Text (RIO AppState) Text) -> [ParsecT Void Text (RIO AppState) Text] -> ParsecT Void Text (RIO AppState) Text forall a b. (a -> b) -> a -> b $ Text -> [ParsecT Void Text (RIO AppState) Text] integerTypeParsers Text "I" case Text int of Text "I8" -> BasicTypeValue -> ParsecT Void Text (RIO AppState) BasicTypeValue forall (f :: * -> *) a. Applicative f => a -> f a pure BasicTypeValue I8 Text "I16" -> BasicTypeValue -> ParsecT Void Text (RIO AppState) BasicTypeValue forall (f :: * -> *) a. Applicative f => a -> f a pure BasicTypeValue I16 Text "I32" -> BasicTypeValue -> ParsecT Void Text (RIO AppState) BasicTypeValue forall (f :: * -> *) a. Applicative f => a -> f a pure BasicTypeValue I32 Text "I64" -> BasicTypeValue -> ParsecT Void Text (RIO AppState) BasicTypeValue forall (f :: * -> *) a. Applicative f => a -> f a pure BasicTypeValue I64 Text "I128" -> BasicTypeValue -> ParsecT Void Text (RIO AppState) BasicTypeValue forall (f :: * -> *) a. Applicative f => a -> f a pure BasicTypeValue I128 Text other -> FilePath -> ParsecT Void Text (RIO AppState) BasicTypeValue forall a. FilePath -> Parser a reportError (FilePath -> ParsecT Void Text (RIO AppState) BasicTypeValue) -> FilePath -> ParsecT Void Text (RIO AppState) BasicTypeValue forall a b. (a -> b) -> a -> b $ FilePath "Invalid size for Ix: " FilePath -> FilePath -> FilePath forall a. Semigroup a => a -> a -> a <> Text -> FilePath unpack Text other floatP :: Parser BasicTypeValue floatP :: ParsecT Void Text (RIO AppState) BasicTypeValue floatP = do Text int <- [ParsecT Void Text (RIO AppState) Text] -> ParsecT Void Text (RIO AppState) Text forall (f :: * -> *) (m :: * -> *) a. (Foldable f, Alternative m) => f (m a) -> m a choice [Tokens Text -> ParsecT Void Text (RIO AppState) (Tokens Text) forall e s (m :: * -> *). MonadParsec e s m => Tokens s -> m (Tokens s) string Tokens Text "F32", ParsecT Void Text (RIO AppState) Text "F64"] case Text int of Text "F32" -> BasicTypeValue -> ParsecT Void Text (RIO AppState) BasicTypeValue forall (f :: * -> *) a. Applicative f => a -> f a pure BasicTypeValue F32 Text "F64" -> BasicTypeValue -> ParsecT Void Text (RIO AppState) BasicTypeValue forall (f :: * -> *) a. Applicative f => a -> f a pure BasicTypeValue F64 Text other -> FilePath -> ParsecT Void Text (RIO AppState) BasicTypeValue forall a. FilePath -> Parser a reportError (FilePath -> ParsecT Void Text (RIO AppState) BasicTypeValue) -> FilePath -> ParsecT Void Text (RIO AppState) BasicTypeValue forall a b. (a -> b) -> a -> b $ FilePath "Invalid size for Fx: " FilePath -> FilePath -> FilePath forall a. Semigroup a => a -> a -> a <> Text -> FilePath unpack Text other booleanP :: Parser BasicTypeValue booleanP :: ParsecT Void Text (RIO AppState) BasicTypeValue booleanP = Tokens Text -> ParsecT Void Text (RIO AppState) (Tokens Text) forall e s (m :: * -> *). MonadParsec e s m => Tokens s -> m (Tokens s) string Tokens Text "Boolean" ParsecT Void Text (RIO AppState) Text -> BasicTypeValue -> ParsecT Void Text (RIO AppState) BasicTypeValue forall (f :: * -> *) a b. Functor f => f a -> b -> f b $> BasicTypeValue Boolean basicStringP :: Parser BasicTypeValue basicStringP :: ParsecT Void Text (RIO AppState) BasicTypeValue basicStringP = Tokens Text -> ParsecT Void Text (RIO AppState) (Tokens Text) forall e s (m :: * -> *). MonadParsec e s m => Tokens s -> m (Tokens s) string Tokens Text "String" ParsecT Void Text (RIO AppState) Text -> BasicTypeValue -> ParsecT Void Text (RIO AppState) BasicTypeValue forall (f :: * -> *) a b. Functor f => f a -> b -> f b $> BasicTypeValue BasicString literalP :: Parser LiteralTypeValue literalP :: Parser LiteralTypeValue literalP = [Parser LiteralTypeValue] -> Parser LiteralTypeValue forall (f :: * -> *) (m :: * -> *) a. (Foldable f, Alternative m) => f (m a) -> m a choice [Parser LiteralTypeValue literalStringP, Parser LiteralTypeValue literalIntegerP, Parser LiteralTypeValue literalFloatP, Parser LiteralTypeValue literalBooleanP] literalStringP :: Parser LiteralTypeValue literalStringP :: Parser LiteralTypeValue literalStringP = (FilePath -> Text pack (FilePath -> Text) -> (Text -> LiteralTypeValue) -> FilePath -> LiteralTypeValue forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k). Category cat => cat a b -> cat b c -> cat a c >>> Text -> LiteralTypeValue LiteralString) (FilePath -> LiteralTypeValue) -> ParsecT Void Text (RIO AppState) FilePath -> Parser LiteralTypeValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> ParsecT Void Text (RIO AppState) Char -> ParsecT Void Text (RIO AppState) Char -> ParsecT Void Text (RIO AppState) FilePath -> ParsecT Void Text (RIO AppState) FilePath forall (m :: * -> *) open close a. Applicative m => m open -> m close -> m a -> m a between (Token Text -> ParsecT Void Text (RIO AppState) (Token Text) forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => Token s -> m (Token s) char Char Token Text '"') (Token Text -> ParsecT Void Text (RIO AppState) (Token Text) forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => Token s -> m (Token s) char Char Token Text '"') (ParsecT Void Text (RIO AppState) Char -> ParsecT Void Text (RIO AppState) FilePath forall (m :: * -> *) a. MonadPlus m => m a -> m [a] many ParsecT Void Text (RIO AppState) Char stringCharacterP) stringCharacterP :: Parser Char stringCharacterP :: ParsecT Void Text (RIO AppState) Char stringCharacterP = ParsecT Void Text (RIO AppState) Char forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => m (Token s) alphaNumChar ParsecT Void Text (RIO AppState) Char -> ParsecT Void Text (RIO AppState) Char -> ParsecT Void Text (RIO AppState) Char forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> ParsecT Void Text (RIO AppState) Char forall e s (m :: * -> *). (MonadParsec e s m, Token s ~ Char) => m (Token s) spaceChar literalIntegerP :: Parser LiteralTypeValue literalIntegerP :: Parser LiteralTypeValue literalIntegerP = Integer -> LiteralTypeValue LiteralInteger (Integer -> LiteralTypeValue) -> ParsecT Void Text (RIO AppState) Integer -> Parser LiteralTypeValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> ParsecT Void Text (RIO AppState) Integer forall e s (m :: * -> *) a. (MonadParsec e s m, Token s ~ Char, Num a) => m a decimal literalFloatP :: Parser LiteralTypeValue literalFloatP :: Parser LiteralTypeValue literalFloatP = Float -> LiteralTypeValue LiteralFloat (Float -> LiteralTypeValue) -> ParsecT Void Text (RIO AppState) Float -> Parser LiteralTypeValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> ParsecT Void Text (RIO AppState) Float forall e s (m :: * -> *) a. (MonadParsec e s m, Token s ~ Char, RealFloat a) => m a float literalBooleanP :: Parser LiteralTypeValue literalBooleanP :: Parser LiteralTypeValue literalBooleanP = Bool -> LiteralTypeValue LiteralBoolean (Bool -> LiteralTypeValue) -> ParsecT Void Text (RIO AppState) Bool -> Parser LiteralTypeValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [ParsecT Void Text (RIO AppState) Bool] -> ParsecT Void Text (RIO AppState) Bool forall (f :: * -> *) (m :: * -> *) a. (Foldable f, Alternative m) => f (m a) -> m a choice [ParsecT Void Text (RIO AppState) Bool trueP, ParsecT Void Text (RIO AppState) Bool falseP] trueP :: Parser Bool trueP :: ParsecT Void Text (RIO AppState) Bool trueP = Tokens Text -> ParsecT Void Text (RIO AppState) (Tokens Text) forall e s (m :: * -> *). MonadParsec e s m => Tokens s -> m (Tokens s) string Tokens Text "true" ParsecT Void Text (RIO AppState) Text -> Bool -> ParsecT Void Text (RIO AppState) Bool forall (f :: * -> *) a b. Functor f => f a -> b -> f b $> Bool True falseP :: Parser Bool falseP :: ParsecT Void Text (RIO AppState) Bool falseP = Tokens Text -> ParsecT Void Text (RIO AppState) (Tokens Text) forall e s (m :: * -> *). MonadParsec e s m => Tokens s -> m (Tokens s) string Tokens Text "false" ParsecT Void Text (RIO AppState) Text -> Bool -> ParsecT Void Text (RIO AppState) Bool forall (f :: * -> *) a b. Functor f => f a -> b -> f b $> Bool False partialFromRight :: Either l r -> r partialFromRight :: Either l r -> r partialFromRight (Right r r) = r r partialFromRight (Left l _l) = FilePath -> r forall a. HasCallStack => FilePath -> a error FilePath "Unable to get `Right` from `Left`" partialFromLeft :: Either l r -> l partialFromLeft :: Either l r -> l partialFromLeft (Left l l) = l l partialFromLeft (Right r _r) = FilePath -> l forall a. HasCallStack => FilePath -> a error FilePath "Unable to get `Left` from `Right`"