{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}

-- | Parser for AVRO (@.avdl@) files, as defined in <http://avro.apache.org/docs/1.8.2/spec.html>.
module Language.Avro.Parser
  ( -- * Main parsers
    parseProtocol,
    readWithImports,

    -- * Intermediate parsers
    parseAliases,
    parseAnnotation,
    parseDecimal,
    parseImport,
    parseMethod,
    parseNamespace,
    parseOrder,
    parseSchema,
  )
where

import Control.Monad (filterM)
import Data.Avro
import Data.Either (partitionEithers)
import qualified Data.Set as S
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Vector as V
import Language.Avro.Types
import System.Directory (doesFileExist)
import System.FilePath
import Text.Megaparsec
import Text.Megaparsec.Char
import qualified Text.Megaparsec.Char.Lexer as L
import Text.Megaparsec.Error (errorBundlePretty)

spaces :: MonadParsec Char T.Text m => m ()
spaces :: m ()
spaces = m () -> m () -> m () -> m ()
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> m () -> m () -> m ()
L.space m ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space1 (Tokens Text -> m ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Tokens s -> m ()
L.skipLineComment Tokens Text
"//") (Tokens Text -> Tokens Text -> m ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Tokens s -> Tokens s -> m ()
L.skipBlockComment Tokens Text
"/*" Tokens Text
"*/")

lexeme :: MonadParsec Char T.Text m => m a -> m a
lexeme :: m a -> m a
lexeme = m () -> m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
L.lexeme m ()
forall (m :: * -> *). MonadParsec Char Text m => m ()
spaces

symbol :: MonadParsec Char T.Text m => T.Text -> m T.Text
symbol :: Text -> m Text
symbol = m () -> Tokens Text -> m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> Tokens s -> m (Tokens s)
L.symbol m ()
forall (m :: * -> *). MonadParsec Char Text m => m ()
spaces

reserved :: MonadParsec Char T.Text m => T.Text -> m T.Text
reserved :: Text -> m Text
reserved = m Text -> m Text
forall (m :: * -> *) a. MonadParsec Char Text m => m a -> m a
lexeme (m Text -> m Text) -> (Text -> m Text) -> Text -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> m Text
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
chunk

number :: (MonadParsec Char T.Text m, Integral a) => m a
number :: m a
number = m () -> m a -> m a
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m () -> m a -> m a
L.signed m ()
forall (m :: * -> *). MonadParsec Char Text m => m ()
spaces (m a -> m a
forall (m :: * -> *) a. MonadParsec Char Text m => m a -> m a
lexeme m a
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
L.decimal) m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m a -> m a
forall (m :: * -> *) a. MonadParsec Char Text m => m a -> m a
lexeme m a
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
L.octal m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m a -> m a
forall (m :: * -> *) a. MonadParsec Char Text m => m a -> m a
lexeme m a
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
L.hexadecimal

floating :: (MonadParsec Char T.Text m, RealFloat a) => m a
floating :: m a
floating = m () -> m a -> m a
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m () -> m a -> m a
L.signed m ()
forall (m :: * -> *). MonadParsec Char Text m => m ()
spaces (m a -> m a
forall (m :: * -> *) a. MonadParsec Char Text m => m a -> m a
lexeme m a
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, RealFloat a) =>
m a
L.float)

strlit :: MonadParsec Char T.Text m => m T.Text
strlit :: m Text
strlit = String -> Text
T.pack (String -> Text) -> m String -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Token Text -> m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'"' m Char -> m String -> m String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m Char -> m Char -> m String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill m Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Char
L.charLiteral (Token Text -> m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'"'))

braces :: MonadParsec Char T.Text m => m a -> m a
braces :: m a -> m a
braces = m Text -> m Text -> m a -> m a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Text -> m Text
forall (m :: * -> *). MonadParsec Char Text m => Text -> m Text
symbol Text
"{") (Text -> m Text
forall (m :: * -> *). MonadParsec Char Text m => Text -> m Text
symbol Text
"}")

brackets :: MonadParsec Char T.Text m => m a -> m a
brackets :: m a -> m a
brackets = m Text -> m Text -> m a -> m a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Text -> m Text
forall (m :: * -> *). MonadParsec Char Text m => Text -> m Text
symbol Text
"[") (Text -> m Text
forall (m :: * -> *). MonadParsec Char Text m => Text -> m Text
symbol Text
"]")

parens :: MonadParsec Char T.Text m => m a -> m a
parens :: m a -> m a
parens = m Text -> m Text -> m a -> m a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Text -> m Text
forall (m :: * -> *). MonadParsec Char Text m => Text -> m Text
symbol Text
"(") (Text -> m Text
forall (m :: * -> *). MonadParsec Char Text m => Text -> m Text
symbol Text
")")

diamonds :: MonadParsec Char T.Text m => m a -> m a
diamonds :: m a -> m a
diamonds = m Text -> m Text -> m a -> m a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Text -> m Text
forall (m :: * -> *). MonadParsec Char Text m => Text -> m Text
symbol Text
"<") (Text -> m Text
forall (m :: * -> *). MonadParsec Char Text m => Text -> m Text
symbol Text
">")

backticks :: MonadParsec Char T.Text m => m T.Text
backticks :: m Text
backticks = String -> Text
T.pack (String -> Text) -> m String -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Token Text -> m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'`' m Char -> m String -> m String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m Char -> m Char -> m String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill m Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Char
L.charLiteral (Token Text -> m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'`'))

ident :: MonadParsec Char T.Text m => m T.Text
ident :: m Text
ident = String -> Text
T.pack (String -> Text) -> m String -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((:) (Char -> String -> String) -> m Char -> m (String -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
letterChar m (String -> String) -> m String -> m String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Char -> m String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (m Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar m Char -> m Char -> m Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token Text -> m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'_' m Char -> m Char -> m Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token Text -> m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'-'))

identifier :: MonadParsec Char T.Text m => m T.Text
identifier :: m Text
identifier = m Text -> m Text
forall (m :: * -> *) a. MonadParsec Char Text m => m a -> m a
lexeme (m Text
forall (m :: * -> *). MonadParsec Char Text m => m Text
ident m Text -> m Text -> m Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m Text
forall (m :: * -> *). MonadParsec Char Text m => m Text
backticks)

toNamedType :: [T.Text] -> TypeName
toNamedType :: [Text] -> TypeName
toNamedType [] = String -> TypeName
forall a. HasCallStack => String -> a
error String
"named types cannot be empty"
toNamedType [Text]
xs = TN :: Text -> [Text] -> TypeName
TN {Text
baseName :: Text
baseName :: Text
baseName, [Text]
namespace :: [Text]
namespace :: [Text]
namespace}
  where
    baseName :: Text
baseName = [Text] -> Text
forall a. [a] -> a
last [Text]
xs
    namespace :: [Text]
namespace = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"") ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. [a] -> [a]
init [Text]
xs

multiNamedTypes :: [T.Text] -> [TypeName]
multiNamedTypes :: [Text] -> [TypeName]
multiNamedTypes = (Text -> TypeName) -> [Text] -> [TypeName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text -> TypeName) -> [Text] -> [TypeName])
-> (Text -> TypeName) -> [Text] -> [TypeName]
forall a b. (a -> b) -> a -> b
$ [Text] -> TypeName
toNamedType ([Text] -> TypeName) -> (Text -> [Text]) -> Text -> TypeName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Text]
T.splitOn Text
"."

-- | Parses annotations into the 'Annotation' structure.
parseAnnotation :: MonadParsec Char T.Text m => m Annotation
parseAnnotation :: m Annotation
parseAnnotation = Text -> Text -> Annotation
Annotation (Text -> Text -> Annotation)
-> m Text -> m (Text -> Text -> Annotation)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> m Text
forall (m :: * -> *). MonadParsec Char Text m => Text -> m Text
symbol Text
"@" m (Text -> Text -> Annotation) -> m Text -> m (Text -> Annotation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Text
forall (m :: * -> *). MonadParsec Char Text m => m Text
identifier m (Text -> Annotation) -> m Text -> m Annotation
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Text -> m Text
forall (m :: * -> *) a. MonadParsec Char Text m => m a -> m a
parens m Text
forall (m :: * -> *). MonadParsec Char Text m => m Text
strlit

-- | Parses a single import into the 'ImportType' structure.
parseNamespace :: MonadParsec Char T.Text m => m Namespace
parseNamespace :: m Namespace
parseNamespace = Text -> Namespace
toNs (Text -> Namespace) -> m Text -> m (Text -> Namespace)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Text -> m Text
forall (m :: * -> *). MonadParsec Char Text m => Text -> m Text
symbol Text
"@" m Text -> m Text -> m Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> m Text
forall (m :: * -> *). MonadParsec Char Text m => Text -> m Text
reserved Text
"namespace") m (Text -> Namespace) -> m Text -> m Namespace
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Text -> m Text
forall (m :: * -> *) a. MonadParsec Char Text m => m a -> m a
parens m Text
forall (m :: * -> *). MonadParsec Char Text m => m Text
strlit
  where
    toNs :: T.Text -> Namespace
    toNs :: Text -> Namespace
toNs = [Text] -> Namespace
Namespace ([Text] -> Namespace) -> (Text -> [Text]) -> Text -> Namespace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Text]
T.splitOn Text
"."

-- | Parses aliases, which are just Lists of 'TypeName'.
parseAliases :: MonadParsec Char T.Text m => m Aliases
parseAliases :: m [TypeName]
parseAliases = [Text] -> [TypeName]
multiNamedTypes ([Text] -> [TypeName]) -> m [Text] -> m [TypeName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [Text]
forall (m :: * -> *). MonadParsec Char Text m => m [Text]
parseFieldAlias

-- | Parses a single import into the 'ImportType' structure.
parseImport :: MonadParsec Char T.Text m => m ImportType
parseImport :: m ImportType
parseImport =
  Text -> m Text
forall (m :: * -> *). MonadParsec Char Text m => Text -> m Text
reserved Text
"import"
    m Text -> m ImportType -> m ImportType
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ( ((Text -> ImportType) -> Text -> m ImportType
forall (m :: * -> *) a.
MonadParsec Char Text m =>
(Text -> a) -> Text -> m a
impHelper Text -> ImportType
IdlImport Text
"idl" m ImportType -> String -> m ImportType
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"Import of type IDL")
           m ImportType -> m ImportType -> m ImportType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((Text -> ImportType) -> Text -> m ImportType
forall (m :: * -> *) a.
MonadParsec Char Text m =>
(Text -> a) -> Text -> m a
impHelper Text -> ImportType
ProtocolImport Text
"protocol" m ImportType -> String -> m ImportType
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"Import of type protocol")
           m ImportType -> m ImportType -> m ImportType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((Text -> ImportType) -> Text -> m ImportType
forall (m :: * -> *) a.
MonadParsec Char Text m =>
(Text -> a) -> Text -> m a
impHelper Text -> ImportType
SchemaImport Text
"schema" m ImportType -> String -> m ImportType
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"Import of type schema")
       )
  where
    impHelper :: MonadParsec Char T.Text m => (T.Text -> a) -> T.Text -> m a
    impHelper :: (Text -> a) -> Text -> m a
impHelper Text -> a
ct Text
t = Text -> a
ct (Text -> a) -> m Text -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> m Text
forall (m :: * -> *). MonadParsec Char Text m => Text -> m Text
reserved Text
t m Text -> m Text -> m Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m Text
forall (m :: * -> *). MonadParsec Char Text m => m Text
strlit m Text -> m Text -> m Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> m Text
forall (m :: * -> *). MonadParsec Char Text m => Text -> m Text
symbol Text
";")

-- | Parses a single protocol into the 'Protocol' structure.
parseProtocol :: MonadParsec Char T.Text m => m Protocol
parseProtocol :: m Protocol
parseProtocol =
  Maybe Namespace -> Text -> [ProtocolThing] -> Protocol
buildProtocol (Maybe Namespace -> Text -> [ProtocolThing] -> Protocol)
-> m ()
-> m (Maybe Namespace -> Text -> [ProtocolThing] -> Protocol)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ m ()
forall (m :: * -> *). MonadParsec Char Text m => m ()
spaces m (Maybe Namespace -> Text -> [ProtocolThing] -> Protocol)
-> m (Maybe Namespace) -> m (Text -> [ProtocolThing] -> Protocol)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Namespace -> m (Maybe Namespace)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional m Namespace
forall (m :: * -> *). MonadParsec Char Text m => m Namespace
parseNamespace m (Text -> [ProtocolThing] -> Protocol)
-> m Text -> m (Text -> [ProtocolThing] -> Protocol)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> m Text
forall (m :: * -> *). MonadParsec Char Text m => Text -> m Text
reserved Text
"protocol"
    m (Text -> [ProtocolThing] -> Protocol)
-> m Text -> m ([ProtocolThing] -> Protocol)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Text
forall (m :: * -> *). MonadParsec Char Text m => m Text
identifier
    m ([ProtocolThing] -> Protocol) -> m [ProtocolThing] -> m Protocol
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m [ProtocolThing] -> m [ProtocolThing]
forall (m :: * -> *) a. MonadParsec Char Text m => m a -> m a
braces (m ProtocolThing -> m [ProtocolThing]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many m ProtocolThing
forall (m :: * -> *). MonadParsec Char Text m => m ProtocolThing
serviceThing)
  where
    buildProtocol :: Maybe Namespace -> T.Text -> [ProtocolThing] -> Protocol
    buildProtocol :: Maybe Namespace -> Text -> [ProtocolThing] -> Protocol
buildProtocol Maybe Namespace
ns Text
name [ProtocolThing]
things =
      Maybe Namespace
-> Text -> Set ImportType -> Set Schema -> Set Method -> Protocol
Protocol
        Maybe Namespace
ns
        Text
name
        ([ImportType] -> Set ImportType
forall a. Ord a => [a] -> Set a
S.fromList [ImportType
i | ProtocolThingImport ImportType
i <- [ProtocolThing]
things])
        ([Schema] -> Set Schema
forall a. Ord a => [a] -> Set a
S.fromList [Schema
t | ProtocolThingType Schema
t <- [ProtocolThing]
things])
        ([Method] -> Set Method
forall a. Ord a => [a] -> Set a
S.fromList [Method
m | ProtocolThingMethod Method
m <- [ProtocolThing]
things])

data ProtocolThing
  = ProtocolThingImport ImportType
  | ProtocolThingType Schema
  | ProtocolThingMethod Method

serviceThing :: MonadParsec Char T.Text m => m ProtocolThing
serviceThing :: m ProtocolThing
serviceThing =
  m ProtocolThing -> m ProtocolThing
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ImportType -> ProtocolThing
ProtocolThingImport (ImportType -> ProtocolThing) -> m ImportType -> m ProtocolThing
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m ImportType
forall (m :: * -> *). MonadParsec Char Text m => m ImportType
parseImport)
    m ProtocolThing -> m ProtocolThing -> m ProtocolThing
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m ProtocolThing -> m ProtocolThing
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Method -> ProtocolThing
ProtocolThingMethod (Method -> ProtocolThing) -> m Method -> m ProtocolThing
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Method
forall (m :: * -> *). MonadParsec Char Text m => m Method
parseMethod)
    m ProtocolThing -> m ProtocolThing -> m ProtocolThing
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Schema -> ProtocolThing
ProtocolThingType (Schema -> ProtocolThing) -> m Schema -> m ProtocolThing
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Schema
forall (m :: * -> *). MonadParsec Char Text m => m Schema
parseSchema m ProtocolThing -> m (Maybe Text) -> m ProtocolThing
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* m Text -> m (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Text -> m Text
forall (m :: * -> *). MonadParsec Char Text m => Text -> m Text
symbol Text
";")

parseVector :: MonadParsec Char T.Text m => m a -> m (V.Vector a)
parseVector :: m a -> m (Vector a)
parseVector m a
t = [a] -> Vector a
forall a. [a] -> Vector a
V.fromList ([a] -> Vector a) -> m [a] -> m (Vector a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [a] -> m [a]
forall (m :: * -> *) a. MonadParsec Char Text m => m a -> m a
braces (m [a] -> m [a]
forall (m :: * -> *) a. MonadParsec Char Text m => m a -> m a
lexeme (m [a] -> m [a]) -> m [a] -> m [a]
forall a b. (a -> b) -> a -> b
$ m a -> m Text -> m [a]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
sepBy1 m a
t (m Text -> m [a]) -> m Text -> m [a]
forall a b. (a -> b) -> a -> b
$ Text -> m Text
forall (m :: * -> *). MonadParsec Char Text m => Text -> m Text
symbol Text
",")

parseTypeName :: MonadParsec Char T.Text m => m TypeName
parseTypeName :: m TypeName
parseTypeName = [Text] -> TypeName
toNamedType ([Text] -> TypeName) -> (Text -> [Text]) -> Text -> TypeName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> TypeName) -> m Text -> m TypeName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Text
forall (m :: * -> *). MonadParsec Char Text m => m Text
identifier

-- | Parses order annotations into the 'Order' structure.
parseOrder :: MonadParsec Char T.Text m => m Order
parseOrder :: m Order
parseOrder =
  Text -> m Text
forall (m :: * -> *). MonadParsec Char Text m => Text -> m Text
symbol Text
"@" m Text -> m Text -> m Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> m Text
forall (m :: * -> *). MonadParsec Char Text m => Text -> m Text
reserved Text
"order" m Text -> String -> m Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"Order can be ascending/descending/ignore")
    m Text -> m Order -> m Order
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m Order -> m Order
forall (m :: * -> *) a. MonadParsec Char Text m => m a -> m a
parens
      ( Order
Ascending Order -> m Text -> m Order
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text -> m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"\"ascending\""
          m Order -> m Order -> m Order
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Order
Descending Order -> m Text -> m Order
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text -> m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"\"descending\""
          m Order -> m Order -> m Order
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Order
Ignore Order -> m Text -> m Order
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text -> m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"\"ignore\""
      )

parseFieldAlias :: MonadParsec Char T.Text m => m [T.Text]
parseFieldAlias :: m [Text]
parseFieldAlias =
  Text -> m Text
forall (m :: * -> *). MonadParsec Char Text m => Text -> m Text
symbol Text
"@" m Text -> m Text -> m Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> m Text
forall (m :: * -> *). MonadParsec Char Text m => Text -> m Text
reserved Text
"aliases"
    m Text -> m [Text] -> m [Text]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m [Text] -> m [Text]
forall (m :: * -> *) a. MonadParsec Char Text m => m a -> m a
parens (m [Text] -> m [Text]
forall (m :: * -> *) a. MonadParsec Char Text m => m a -> m a
brackets (m [Text] -> m [Text]) -> m [Text] -> m [Text]
forall a b. (a -> b) -> a -> b
$ m [Text] -> m [Text]
forall (m :: * -> *) a. MonadParsec Char Text m => m a -> m a
lexeme (m [Text] -> m [Text]) -> m [Text] -> m [Text]
forall a b. (a -> b) -> a -> b
$ m Text -> m Text -> m [Text]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
sepBy1 m Text
forall (m :: * -> *). MonadParsec Char Text m => m Text
strlit (m Text -> m [Text]) -> m Text -> m [Text]
forall a b. (a -> b) -> a -> b
$ Text -> m Text
forall (m :: * -> *). MonadParsec Char Text m => Text -> m Text
symbol Text
",")

parseField :: MonadParsec Char T.Text m => m Field
parseField :: m Field
parseField =
  (\Maybe Order
o Schema
t [Text]
a Text
n -> Text
-> [Text]
-> Maybe Text
-> Maybe Order
-> Schema
-> Maybe DefaultValue
-> Field
Field Text
n [Text]
a Maybe Text
forall a. Maybe a
Nothing Maybe Order
o Schema
t Maybe DefaultValue
forall a. Maybe a
Nothing) -- FIXME: docs are not supported yet.
    (Maybe Order -> Schema -> [Text] -> Text -> Field)
-> m (Maybe Order) -> m (Schema -> [Text] -> Text -> Field)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Order -> m (Maybe Order)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (m Order
forall (m :: * -> *). MonadParsec Char Text m => m Order
parseOrder m Order -> String -> m Order
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"Order of the field in the schema")
    m (Schema -> [Text] -> Text -> Field)
-> m Schema -> m ([Text] -> Text -> Field)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (m Schema
forall (m :: * -> *). MonadParsec Char Text m => m Schema
parseSchema m Schema -> String -> m Schema
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"Type of the field in the schema")
    m ([Text] -> Text -> Field) -> m [Text] -> m (Text -> Field)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([Text] -> m [Text] -> m [Text]
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option [] m [Text]
forall (m :: * -> *). MonadParsec Char Text m => m [Text]
parseFieldAlias m [Text] -> String -> m [Text]
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"Aliases of the field in the schema")
    m (Text -> Field) -> m Text -> m Field
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (m Text
forall (m :: * -> *). MonadParsec Char Text m => m Text
identifier m Text -> String -> m Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"Name of the field in the schema")
    -- FIXME: default values are not supported yet.
    m Field -> m Text -> m Field
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ((Text -> m Text
forall (m :: * -> *). MonadParsec Char Text m => Text -> m Text
symbol Text
";" m Text -> m Text -> m Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> m Text
forall (m :: * -> *). MonadParsec Char Text m => Text -> m Text
symbol Text
"=" m Text -> m String -> m Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* m Char -> m Text -> m String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill m Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle (Text -> m Text
forall (m :: * -> *). MonadParsec Char Text m => Text -> m Text
symbol Text
";")) m Text -> String -> m Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"Semicolon or equals sign")

-- | Parses arguments of methods into the 'Argument' structure.
parseArgument :: MonadParsec Char T.Text m => m Argument
parseArgument :: m Argument
parseArgument = Schema -> Text -> Argument
Argument (Schema -> Text -> Argument) -> m Schema -> m (Text -> Argument)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Schema
forall (m :: * -> *). MonadParsec Char Text m => m Schema
parseSchema m (Text -> Argument) -> m Text -> m Argument
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Text
forall (m :: * -> *). MonadParsec Char Text m => m Text
identifier

-- | Parses a single method/message into the 'Method' structure.
parseMethod :: MonadParsec Char T.Text m => m Method
parseMethod :: m Method
parseMethod =
  (\Schema
r Text
n [Argument]
a Schema
t Bool
o -> Text -> [Argument] -> Schema -> Schema -> Bool -> Method
Method Text
n [Argument]
a Schema
r Schema
t Bool
o)
    (Schema -> Text -> [Argument] -> Schema -> Bool -> Method)
-> m Schema -> m (Text -> [Argument] -> Schema -> Bool -> Method)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (m Schema
forall (m :: * -> *). MonadParsec Char Text m => m Schema
parseSchema m Schema -> String -> m Schema
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"Result type of the method")
    m (Text -> [Argument] -> Schema -> Bool -> Method)
-> m Text -> m ([Argument] -> Schema -> Bool -> Method)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (m Text
forall (m :: * -> *). MonadParsec Char Text m => m Text
identifier m Text -> String -> m Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"Name of the method")
    m ([Argument] -> Schema -> Bool -> Method)
-> m [Argument] -> m (Schema -> Bool -> Method)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (m [Argument] -> m [Argument]
forall (m :: * -> *) a. MonadParsec Char Text m => m a -> m a
parens ([Argument] -> m [Argument] -> m [Argument]
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option [] (m [Argument] -> m [Argument]
forall (m :: * -> *) a. MonadParsec Char Text m => m a -> m a
lexeme (m [Argument] -> m [Argument]) -> m [Argument] -> m [Argument]
forall a b. (a -> b) -> a -> b
$ m Argument -> m Text -> m [Argument]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
sepBy1 m Argument
forall (m :: * -> *). MonadParsec Char Text m => m Argument
parseArgument (m Text -> m [Argument]) -> m Text -> m [Argument]
forall a b. (a -> b) -> a -> b
$ Text -> m Text
forall (m :: * -> *). MonadParsec Char Text m => Text -> m Text
symbol Text
",")) m [Argument] -> String -> m [Argument]
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"Arguments of the method")
    m (Schema -> Bool -> Method) -> m Schema -> m (Bool -> Method)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Schema -> m Schema -> m Schema
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Schema
Null (Text -> m Text
forall (m :: * -> *). MonadParsec Char Text m => Text -> m Text
reserved Text
"throws" m Text -> m Schema -> m Schema
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m Schema
forall (m :: * -> *). MonadParsec Char Text m => m Schema
parseSchema) m Schema -> String -> m Schema
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"If the method throws an exception")
    m (Bool -> Method) -> m Bool -> m Method
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Bool -> m Bool -> m Bool
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Bool
False (Bool
True Bool -> m Text -> m Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> m Text
forall (m :: * -> *). MonadParsec Char Text m => Text -> m Text
reserved Text
"oneway") m Bool -> String -> m Bool
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"If the method is `oneway` or not")
    m Method -> m Text -> m Method
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Text -> m Text
forall (m :: * -> *). MonadParsec Char Text m => Text -> m Text
symbol Text
";" m Text -> String -> m Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"Should end with a semicolon")

-- | Parses the special type @decimal@ into it's corresponding 'Decimal' structure.
parseDecimal :: MonadParsec Char T.Text m => m Decimal
parseDecimal :: m Decimal
parseDecimal = [Int] -> Decimal
toDec ([Int] -> Decimal) -> m Text -> m ([Int] -> Decimal)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> m Text
forall (m :: * -> *). MonadParsec Char Text m => Text -> m Text
reserved Text
"decimal" m ([Int] -> Decimal) -> m [Int] -> m Decimal
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m [Int] -> m [Int]
forall (m :: * -> *) a. MonadParsec Char Text m => m a -> m a
parens (m [Int] -> m [Int]
forall (m :: * -> *) a. MonadParsec Char Text m => m a -> m a
lexeme (m [Int] -> m [Int]) -> m [Int] -> m [Int]
forall a b. (a -> b) -> a -> b
$ m Int -> m Text -> m [Int]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
sepBy1 m Int
forall (m :: * -> *) a.
(MonadParsec Char Text m, Integral a) =>
m a
number (m Text -> m [Int]) -> m Text -> m [Int]
forall a b. (a -> b) -> a -> b
$ Text -> m Text
forall (m :: * -> *). MonadParsec Char Text m => Text -> m Text
symbol Text
",")
  where
    toDec :: [Int] -> Decimal
    toDec :: [Int] -> Decimal
toDec [Int
precision] = Integer -> Integer -> Decimal
Decimal (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
precision) Integer
0
    toDec [Int
precision, Int
scale] = Integer -> Integer -> Decimal
Decimal (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
precision) (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
scale)
    toDec [Int]
_ = String -> Decimal
forall a. HasCallStack => String -> a
error String
"decimal types can only be specified using two numbers!"

-- | Parses a single type respecting @Data.Avro.Schema@'s 'Schema'.
parseSchema :: MonadParsec Char T.Text m => m Schema
parseSchema :: m Schema
parseSchema =
  Schema
Null Schema -> m Text -> m Schema
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Text -> m Text
forall (m :: * -> *). MonadParsec Char Text m => Text -> m Text
reserved Text
"null" m Text -> m Text -> m Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> m Text
forall (m :: * -> *). MonadParsec Char Text m => Text -> m Text
reserved Text
"void")
    m Schema -> m Schema -> m Schema
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Schema
Boolean Schema -> m Text -> m Schema
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> m Text
forall (m :: * -> *). MonadParsec Char Text m => Text -> m Text
reserved Text
"boolean"
    m Schema -> m Schema -> m Schema
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Schema
Int' Schema -> m Text -> m Schema
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> m Text
forall (m :: * -> *). MonadParsec Char Text m => Text -> m Text
reserved Text
"int"
    m Schema -> m Schema -> m Schema
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe LogicalTypeInt -> Schema
Int (LogicalTypeInt -> Maybe LogicalTypeInt
forall a. a -> Maybe a
Just LogicalTypeInt
Date) Schema -> m Text -> m Schema
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> m Text
forall (m :: * -> *). MonadParsec Char Text m => Text -> m Text
reserved Text
"date"
    m Schema -> m Schema -> m Schema
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe LogicalTypeInt -> Schema
Int (LogicalTypeInt -> Maybe LogicalTypeInt
forall a. a -> Maybe a
Just LogicalTypeInt
TimeMillis) Schema -> m Text -> m Schema
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> m Text
forall (m :: * -> *). MonadParsec Char Text m => Text -> m Text
reserved Text
"time_ms"
    m Schema -> m Schema -> m Schema
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Schema
Long' Schema -> m Text -> m Schema
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> m Text
forall (m :: * -> *). MonadParsec Char Text m => Text -> m Text
reserved Text
"long"
    m Schema -> m Schema -> m Schema
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe LogicalTypeLong -> Schema
Long (Maybe LogicalTypeLong -> Schema)
-> (Decimal -> Maybe LogicalTypeLong) -> Decimal -> Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogicalTypeLong -> Maybe LogicalTypeLong
forall a. a -> Maybe a
Just (LogicalTypeLong -> Maybe LogicalTypeLong)
-> (Decimal -> LogicalTypeLong) -> Decimal -> Maybe LogicalTypeLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Decimal -> LogicalTypeLong
DecimalL (Decimal -> Schema) -> m Decimal -> m Schema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Decimal
forall (m :: * -> *). MonadParsec Char Text m => m Decimal
parseDecimal
    m Schema -> m Schema -> m Schema
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe LogicalTypeLong -> Schema
Long (LogicalTypeLong -> Maybe LogicalTypeLong
forall a. a -> Maybe a
Just LogicalTypeLong
TimestampMillis) Schema -> m Text -> m Schema
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> m Text
forall (m :: * -> *). MonadParsec Char Text m => Text -> m Text
reserved Text
"timestamp_ms"
    m Schema -> m Schema -> m Schema
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Schema
Float Schema -> m Text -> m Schema
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> m Text
forall (m :: * -> *). MonadParsec Char Text m => Text -> m Text
reserved Text
"float"
    m Schema -> m Schema -> m Schema
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Schema
Double Schema -> m Text -> m Schema
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> m Text
forall (m :: * -> *). MonadParsec Char Text m => Text -> m Text
reserved Text
"double"
    m Schema -> m Schema -> m Schema
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Schema
Bytes' Schema -> m Text -> m Schema
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> m Text
forall (m :: * -> *). MonadParsec Char Text m => Text -> m Text
reserved Text
"bytes"
    m Schema -> m Schema -> m Schema
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe LogicalTypeString -> Schema
String (LogicalTypeString -> Maybe LogicalTypeString
forall a. a -> Maybe a
Just LogicalTypeString
UUID) Schema -> m Text -> m Schema
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> m Text
forall (m :: * -> *). MonadParsec Char Text m => Text -> m Text
reserved Text
"uuid"
    m Schema -> m Schema -> m Schema
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Schema
String' Schema -> m Text -> m Schema
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> m Text
forall (m :: * -> *). MonadParsec Char Text m => Text -> m Text
reserved Text
"string"
    m Schema -> m Schema -> m Schema
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Schema -> Schema
Array (Schema -> Schema) -> m Text -> m (Schema -> Schema)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> m Text
forall (m :: * -> *). MonadParsec Char Text m => Text -> m Text
reserved Text
"array" m (Schema -> Schema) -> m Schema -> m Schema
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Schema -> m Schema
forall (m :: * -> *) a. MonadParsec Char Text m => m a -> m a
diamonds m Schema
forall (m :: * -> *). MonadParsec Char Text m => m Schema
parseSchema
    m Schema -> m Schema -> m Schema
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Schema -> Schema
Map (Schema -> Schema) -> m Text -> m (Schema -> Schema)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> m Text
forall (m :: * -> *). MonadParsec Char Text m => Text -> m Text
reserved Text
"map" m (Schema -> Schema) -> m Schema -> m Schema
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Schema -> m Schema
forall (m :: * -> *) a. MonadParsec Char Text m => m a -> m a
diamonds m Schema
forall (m :: * -> *). MonadParsec Char Text m => m Schema
parseSchema
    m Schema -> m Schema -> m Schema
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Vector Schema -> Schema
Union (Vector Schema -> Schema) -> m Text -> m (Vector Schema -> Schema)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> m Text
forall (m :: * -> *). MonadParsec Char Text m => Text -> m Text
reserved Text
"union" m (Vector Schema -> Schema) -> m (Vector Schema) -> m Schema
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Schema -> m (Vector Schema)
forall (m :: * -> *) a.
MonadParsec Char Text m =>
m a -> m (Vector a)
parseVector m Schema
forall (m :: * -> *). MonadParsec Char Text m => m Schema
parseSchema
    m Schema -> m Schema -> m Schema
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m Schema -> m Schema
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try
      ( (TypeName -> [TypeName] -> Int -> Maybe LogicalTypeFixed -> Schema)
-> [TypeName]
-> TypeName
-> Int
-> Maybe LogicalTypeFixed
-> Schema
forall a b c. (a -> b -> c) -> b -> a -> c
flip TypeName -> [TypeName] -> Int -> Maybe LogicalTypeFixed -> Schema
Fixed
          ([TypeName] -> TypeName -> Int -> Maybe LogicalTypeFixed -> Schema)
-> m [TypeName]
-> m (TypeName -> Int -> Maybe LogicalTypeFixed -> Schema)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeName] -> m [TypeName] -> m [TypeName]
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option [] m [TypeName]
forall (m :: * -> *). MonadParsec Char Text m => m [TypeName]
parseAliases m (TypeName -> Int -> Maybe LogicalTypeFixed -> Schema)
-> m Text
-> m (TypeName -> Int -> Maybe LogicalTypeFixed -> Schema)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> m Text
forall (m :: * -> *). MonadParsec Char Text m => Text -> m Text
reserved Text
"fixed"
          m (TypeName -> Int -> Maybe LogicalTypeFixed -> Schema)
-> m TypeName -> m (Int -> Maybe LogicalTypeFixed -> Schema)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m TypeName
forall (m :: * -> *). MonadParsec Char Text m => m TypeName
parseTypeName
          m (Int -> Maybe LogicalTypeFixed -> Schema)
-> m Int -> m (Maybe LogicalTypeFixed -> Schema)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Int -> m Int
forall (m :: * -> *) a. MonadParsec Char Text m => m a -> m a
parens m Int
forall (m :: * -> *) a.
(MonadParsec Char Text m, Integral a) =>
m a
number
          m (Maybe LogicalTypeFixed -> Schema)
-> m (Maybe LogicalTypeFixed) -> m Schema
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe LogicalTypeFixed -> m (Maybe LogicalTypeFixed)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe LogicalTypeFixed
forall a. Maybe a
Nothing
      )
    m Schema -> m Schema -> m Schema
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m Schema -> m Schema
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try
      ( (TypeName -> [TypeName] -> Maybe Text -> Vector Text -> Schema)
-> [TypeName] -> TypeName -> Maybe Text -> Vector Text -> Schema
forall a b c. (a -> b -> c) -> b -> a -> c
flip TypeName -> [TypeName] -> Maybe Text -> Vector Text -> Schema
Enum
          ([TypeName] -> TypeName -> Maybe Text -> Vector Text -> Schema)
-> m [TypeName]
-> m (TypeName -> Maybe Text -> Vector Text -> Schema)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeName] -> m [TypeName] -> m [TypeName]
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option [] m [TypeName]
forall (m :: * -> *). MonadParsec Char Text m => m [TypeName]
parseAliases m (TypeName -> Maybe Text -> Vector Text -> Schema)
-> m Text -> m (TypeName -> Maybe Text -> Vector Text -> Schema)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> m Text
forall (m :: * -> *). MonadParsec Char Text m => Text -> m Text
reserved Text
"enum"
          m (TypeName -> Maybe Text -> Vector Text -> Schema)
-> m TypeName -> m (Maybe Text -> Vector Text -> Schema)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m TypeName
forall (m :: * -> *). MonadParsec Char Text m => m TypeName
parseTypeName
          m (Maybe Text -> Vector Text -> Schema)
-> m (Maybe Text) -> m (Vector Text -> Schema)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Text -> m (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing -- FIXME: docs are ignored for now...
          m (Vector Text -> Schema) -> m (Vector Text) -> m Schema
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Text -> m (Vector Text)
forall (m :: * -> *) a.
MonadParsec Char Text m =>
m a -> m (Vector a)
parseVector m Text
forall (m :: * -> *). MonadParsec Char Text m => m Text
identifier
      )
    m Schema -> m Schema -> m Schema
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m Schema -> m Schema
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try
      ( (TypeName -> [TypeName] -> Maybe Text -> [Field] -> Schema)
-> [TypeName] -> TypeName -> Maybe Text -> [Field] -> Schema
forall a b c. (a -> b -> c) -> b -> a -> c
flip TypeName -> [TypeName] -> Maybe Text -> [Field] -> Schema
Record
          ([TypeName] -> TypeName -> Maybe Text -> [Field] -> Schema)
-> m [TypeName] -> m (TypeName -> Maybe Text -> [Field] -> Schema)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeName] -> m [TypeName] -> m [TypeName]
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option [] m [TypeName]
forall (m :: * -> *). MonadParsec Char Text m => m [TypeName]
parseAliases m (TypeName -> Maybe Text -> [Field] -> Schema)
-> m Text -> m (TypeName -> Maybe Text -> [Field] -> Schema)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Text -> m Text
forall (m :: * -> *). MonadParsec Char Text m => Text -> m Text
reserved Text
"record" m Text -> m Text -> m Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> m Text
forall (m :: * -> *). MonadParsec Char Text m => Text -> m Text
reserved Text
"error")
          m (TypeName -> Maybe Text -> [Field] -> Schema)
-> m TypeName -> m (Maybe Text -> [Field] -> Schema)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m TypeName
forall (m :: * -> *). MonadParsec Char Text m => m TypeName
parseTypeName
          m (Maybe Text -> [Field] -> Schema)
-> m (Maybe Text) -> m ([Field] -> Schema)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Text -> m (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing -- FIXME: docs are ignored for now...
          m ([Field] -> Schema) -> m [Field] -> m Schema
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Field] -> m [Field] -> m [Field]
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option [] (m [Field] -> m [Field]
forall (m :: * -> *) a. MonadParsec Char Text m => m a -> m a
braces (m [Field] -> m [Field])
-> (m Field -> m [Field]) -> m Field -> m [Field]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m Field -> m [Field]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (m Field -> m [Field]) -> m Field -> m [Field]
forall a b. (a -> b) -> a -> b
$ m Field
forall (m :: * -> *). MonadParsec Char Text m => m Field
parseField)
      )
    m Schema -> m Schema -> m Schema
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TypeName -> Schema
NamedType (TypeName -> Schema) -> ([Text] -> TypeName) -> [Text] -> Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> TypeName
toNamedType ([Text] -> Schema) -> m [Text] -> m Schema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [Text] -> m [Text]
forall (m :: * -> *) a. MonadParsec Char Text m => m a -> m a
lexeme (m Text -> m Char -> m [Text]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
sepBy1 m Text
forall (m :: * -> *). MonadParsec Char Text m => m Text
identifier (m Char -> m [Text]) -> m Char -> m [Text]
forall a b. (a -> b) -> a -> b
$ Token Text -> m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'.')

parseFile :: Parsec e T.Text a -> String -> IO (Either (ParseErrorBundle T.Text e) a)
parseFile :: Parsec e Text a
-> String -> IO (Either (ParseErrorBundle Text e) a)
parseFile Parsec e Text a
p String
file = Parsec e Text a
-> String -> Text -> Either (ParseErrorBundle Text e) a
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
runParser Parsec e Text a
p String
file (Text -> Either (ParseErrorBundle Text e) a)
-> IO Text -> IO (Either (ParseErrorBundle Text e) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Text
T.readFile String
file

(>>>=) :: Applicative m => Either a b -> (b -> m (Either a c)) -> m (Either a c)
Left a
x >>>= :: Either a b -> (b -> m (Either a c)) -> m (Either a c)
>>>= b -> m (Either a c)
_ = Either a c -> m (Either a c)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Either a c
forall a b. a -> Either a b
Left a
x)
Right b
y >>>= b -> m (Either a c)
f = b -> m (Either a c)
f b
y

-- | Reads and parses a whole file and its imports, recursively.
readWithImports ::
  -- | base directory
  FilePath ->
  -- | initial file
  FilePath ->
  IO (Either T.Text Protocol)
readWithImports :: String -> String -> IO (Either Text Protocol)
readWithImports String
baseDir String
initialFile = do
  Either (ParseErrorBundle Text Char) Protocol
initial <- Parsec Char Text Protocol
-> String -> IO (Either (ParseErrorBundle Text Char) Protocol)
forall e a.
Parsec e Text a
-> String -> IO (Either (ParseErrorBundle Text e) a)
parseFile Parsec Char Text Protocol
forall (m :: * -> *). MonadParsec Char Text m => m Protocol
parseProtocol (String
baseDir String -> String -> String
</> String
initialFile)
  case Either (ParseErrorBundle Text Char) Protocol
initial of
    Left ParseErrorBundle Text Char
err -> Either Text Protocol -> IO (Either Text Protocol)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Protocol -> IO (Either Text Protocol))
-> Either Text Protocol -> IO (Either Text Protocol)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Protocol
forall a b. a -> Either a b
Left (Text -> Either Text Protocol) -> Text -> Either Text Protocol
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (ParseErrorBundle Text Char -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty ParseErrorBundle Text Char
err)
    Right Protocol
p -> do
      [Either Text String]
possibleImps <- (Text -> IO (Either Text String))
-> [Text] -> IO [Either Text String]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (String -> IO (Either Text String)
oneOfTwo (String -> IO (Either Text String))
-> (Text -> String) -> Text -> IO (Either Text String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) [Text
i | IdlImport Text
i <- Set ImportType -> [ImportType]
forall a. Set a -> [a]
S.toList (Set ImportType -> [ImportType]) -> Set ImportType -> [ImportType]
forall a b. (a -> b) -> a -> b
$ Protocol -> Set ImportType
imports Protocol
p]
      ([Text]
lefts, [Protocol]
rights) <- [Either Text Protocol] -> ([Text], [Protocol])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either Text Protocol] -> ([Text], [Protocol]))
-> IO [Either Text Protocol] -> IO ([Text], [Protocol])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Either Text String -> IO (Either Text Protocol))
-> [Either Text String] -> IO [Either Text Protocol]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Either Text String
-> (String -> IO (Either Text Protocol))
-> IO (Either Text Protocol)
forall (m :: * -> *) a b c.
Applicative m =>
Either a b -> (b -> m (Either a c)) -> m (Either a c)
>>>= String -> String -> IO (Either Text Protocol)
readWithImports String
baseDir) [Either Text String]
possibleImps
      Either Text Protocol -> IO (Either Text Protocol)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Protocol -> IO (Either Text Protocol))
-> Either Text Protocol -> IO (Either Text Protocol)
forall a b. (a -> b) -> a -> b
$ case [Text]
lefts of
        Text
e : [Text]
_ -> Text -> Either Text Protocol
forall a b. a -> Either a b
Left Text
e
        [Text]
_ -> Protocol -> Either Text Protocol
forall a b. b -> Either a b
Right (Protocol -> Either Text Protocol)
-> Protocol -> Either Text Protocol
forall a b. (a -> b) -> a -> b
$ (Protocol -> Protocol -> Protocol)
-> Protocol -> Set Protocol -> Protocol
forall a b. (a -> b -> a) -> a -> Set b -> a
S.foldl' Protocol -> Protocol -> Protocol
forall a. Semigroup a => a -> a -> a
(<>) Protocol
p ([Protocol] -> Set Protocol
forall a. Ord a => [a] -> Set a
S.fromList [Protocol]
rights)
  where
    oneOfTwo :: FilePath -> IO (Either T.Text FilePath)
    oneOfTwo :: String -> IO (Either Text String)
oneOfTwo String
p = do
      let dir :: String
dir = String -> String
takeDirectory String
initialFile
          path1 :: String
path1 = String
baseDir String -> String -> String
</> String
p
          path2 :: String
path2 = String
baseDir String -> String -> String
</> String
dir String -> String -> String
</> String
p
      (Bool, Bool)
options <- (,) (Bool -> Bool -> (Bool, Bool))
-> IO Bool -> IO (Bool -> (Bool, Bool))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Bool
doesFileExist String
path1 IO (Bool -> (Bool, Bool)) -> IO Bool -> IO (Bool, Bool)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> IO Bool
doesFileExist String
path2
      Either Text String -> IO (Either Text String)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text String -> IO (Either Text String))
-> Either Text String -> IO (Either Text String)
forall a b. (a -> b) -> a -> b
$ case (Bool, Bool)
options of
        (Bool
True, Bool
False) -> String -> Either Text String
forall a b. b -> Either a b
Right String
p
        (Bool
False, Bool
True) -> String -> Either Text String
forall a b. b -> Either a b
Right (String -> Either Text String) -> String -> Either Text String
forall a b. (a -> b) -> a -> b
$ String
dir String -> String -> String
</> String
p
        (Bool
False, Bool
False) -> Text -> Either Text String
forall a b. a -> Either a b
Left (Text -> Either Text String) -> Text -> Either Text String
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String
"Import not found: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
p)
        (Bool
True, Bool
True)
          | String -> String
normalise String
dir String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"." -> String -> Either Text String
forall a b. b -> Either a b
Right String
p
          | Bool
otherwise -> Text -> Either Text String
forall a b. a -> Either a b
Left (Text -> Either Text String) -> Text -> Either Text String
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String
"Duplicate files found: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
p)