{-# OPTIONS_GHC -Wno-partial-fields #-}

-- | intermediate syntax for the parser
--
-- see "Data.Serde.Syn" for the grammar
module Data.Serde.Internal.ISyn
  ( parsetop,
    ISyn (..),
    ISynFld (..),
    INewtypePayload (..),
    ViaInfo (..),
    Derive (..),
    Parser,

    -- * debug
    _testbody1,
  )
where

import Control.Monad
import Data.Void
import Text.Megaparsec (Parsec, many, (<|>))
import Text.Megaparsec qualified as M
import Text.Megaparsec.Char qualified as M
import Text.Megaparsec.Char.Lexer qualified as L

-- | parser type for the intermediate syntax
type Parser = Parsec Void String

-- intermediate syntax types

-- | intermediate representation of type definitions
-- parsed from the input syntax. can be a data type,
-- newtype, or type alias.
data ISyn
  = ISynData {ISyn -> [Char]
isnam :: String, ISyn -> [ISynFld]
isflds :: [ISynFld]}
  | ISynNewtype {isnam :: String, ISyn -> INewtypePayload
isfld1 :: INewtypePayload}
  | ISynAlias {isnam :: String, ISyn -> [Char]
isdest :: String}
  deriving (Int -> ISyn -> ShowS
[ISyn] -> ShowS
ISyn -> [Char]
(Int -> ISyn -> ShowS)
-> (ISyn -> [Char]) -> ([ISyn] -> ShowS) -> Show ISyn
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ISyn -> ShowS
showsPrec :: Int -> ISyn -> ShowS
$cshow :: ISyn -> [Char]
show :: ISyn -> [Char]
$cshowList :: [ISyn] -> ShowS
showList :: [ISyn] -> ShowS
Show)

-- | payload for newtype definitions, which can either be
-- a field with a name and type, or just a type
data INewtypePayload
  = IField ISynFld
  | IType ViaInfo
  deriving (Int -> INewtypePayload -> ShowS
[INewtypePayload] -> ShowS
INewtypePayload -> [Char]
(Int -> INewtypePayload -> ShowS)
-> (INewtypePayload -> [Char])
-> ([INewtypePayload] -> ShowS)
-> Show INewtypePayload
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> INewtypePayload -> ShowS
showsPrec :: Int -> INewtypePayload -> ShowS
$cshow :: INewtypePayload -> [Char]
show :: INewtypePayload -> [Char]
$cshowList :: [INewtypePayload] -> ShowS
showList :: [INewtypePayload] -> ShowS
Show)

-- | field definition for data types and newtypes,
-- containing a field name and its type information
data ISynFld = ISynFld
  { ISynFld -> [Char]
isfldnam :: String,
    ISynFld -> ViaInfo
isfldtyp :: ViaInfo
  }
  deriving (Int -> ISynFld -> ShowS
[ISynFld] -> ShowS
ISynFld -> [Char]
(Int -> ISynFld -> ShowS)
-> (ISynFld -> [Char]) -> ([ISynFld] -> ShowS) -> Show ISynFld
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ISynFld -> ShowS
showsPrec :: Int -> ISynFld -> ShowS
$cshow :: ISynFld -> [Char]
show :: ISynFld -> [Char]
$cshowList :: [ISynFld] -> ShowS
showList :: [ISynFld] -> ShowS
Show)

-- | collection of type classes to derive for all defined types
newtype Derive = Derive
  { Derive -> [[Char]]
getderive :: [String]
  }
  deriving (Int -> Derive -> ShowS
[Derive] -> ShowS
Derive -> [Char]
(Int -> Derive -> ShowS)
-> (Derive -> [Char]) -> ([Derive] -> ShowS) -> Show Derive
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Derive -> ShowS
showsPrec :: Int -> Derive -> ShowS
$cshow :: Derive -> [Char]
show :: Derive -> [Char]
$cshowList :: [Derive] -> ShowS
showList :: [Derive] -> ShowS
Show)

-- | type information that may include a 'via' clause
data ViaInfo
  = Plain String
  | WithVia String String
  deriving (Int -> ViaInfo -> ShowS
[ViaInfo] -> ShowS
ViaInfo -> [Char]
(Int -> ViaInfo -> ShowS)
-> (ViaInfo -> [Char]) -> ([ViaInfo] -> ShowS) -> Show ViaInfo
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ViaInfo -> ShowS
showsPrec :: Int -> ViaInfo -> ShowS
$cshow :: ViaInfo -> [Char]
show :: ViaInfo -> [Char]
$cshowList :: [ViaInfo] -> ShowS
showList :: [ViaInfo] -> ShowS
Show)

-- parser utilities
sc :: Parser ()
sc :: Parser ()
sc = Parser () -> Parser () -> Parser () -> Parser ()
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> m () -> m () -> m ()
L.space Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
M.space1 (Tokens [Char] -> Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Tokens s -> m ()
L.skipLineComment [Char]
Tokens [Char]
"--") (Tokens [Char] -> Tokens [Char] -> Parser ()
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> Tokens s -> m ()
L.skipBlockComment [Char]
Tokens [Char]
"{-" [Char]
Tokens [Char]
"-}")

scnonl :: Parser ()
scnonl :: Parser ()
scnonl =
  Parser () -> Parser () -> Parser () -> Parser ()
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> m () -> m () -> m ()
L.space Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
M.hspace1 (Tokens [Char] -> Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Tokens s -> m ()
L.skipLineComment [Char]
Tokens [Char]
"--") (Tokens [Char] -> Tokens [Char] -> Parser ()
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> Tokens s -> m ()
L.skipBlockComment [Char]
Tokens [Char]
"{-" [Char]
Tokens [Char]
"-}")

lexeme :: Parser a -> Parser a
lexeme :: forall a. Parser a -> Parser a
lexeme = Parser ()
-> ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
L.lexeme Parser ()
scnonl

identifier :: Parser String
identifier :: Parser [Char]
identifier = (:) (Char -> ShowS)
-> ParsecT Void [Char] Identity Char
-> ParsecT Void [Char] Identity ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void [Char] Identity Char
headchar ParsecT Void [Char] Identity ShowS
-> Parser [Char] -> Parser [Char]
forall a b.
ParsecT Void [Char] Identity (a -> b)
-> ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void [Char] Identity Char -> Parser [Char]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
M.many ParsecT Void [Char] Identity Char
bodychar
  where
    headchar :: ParsecT Void [Char] Identity Char
headchar = ParsecT Void [Char] Identity Char
ParsecT Void [Char] Identity (Token [Char])
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
M.letterChar ParsecT Void [Char] Identity Char
-> ParsecT Void [Char] Identity Char
-> ParsecT Void [Char] Identity Char
forall a.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token [Char] -> ParsecT Void [Char] Identity (Token [Char])
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
M.char Char
Token [Char]
'_'
    bodychar :: ParsecT Void [Char] Identity Char
bodychar = ParsecT Void [Char] Identity Char
ParsecT Void [Char] Identity (Token [Char])
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
M.alphaNumChar ParsecT Void [Char] Identity Char
-> ParsecT Void [Char] Identity Char
-> ParsecT Void [Char] Identity Char
forall a.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token [Char] -> ParsecT Void [Char] Identity (Token [Char])
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
M.char Char
Token [Char]
'_' ParsecT Void [Char] Identity Char
-> ParsecT Void [Char] Identity Char
-> ParsecT Void [Char] Identity Char
forall a.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token [Char] -> ParsecT Void [Char] Identity (Token [Char])
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
M.char Char
Token [Char]
'\''

typechars :: Parser Char
typechars :: ParsecT Void [Char] Identity Char
typechars = ParsecT Void [Char] Identity Char
ParsecT Void [Char] Identity (Token [Char])
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
M.alphaNumChar ParsecT Void [Char] Identity Char
-> ParsecT Void [Char] Identity Char
-> ParsecT Void [Char] Identity Char
forall a.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Token [Char]] -> ParsecT Void [Char] Identity (Token [Char])
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
M.oneOf [Char]
[Token [Char]]
"_'() ,:[]=.<>-|\""

untileol :: Parser Char -> Parser String
untileol :: ParsecT Void [Char] Identity Char -> Parser [Char]
untileol ParsecT Void [Char] Identity Char
p = Parser [Char] -> Parser [Char]
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
M.try (Parser [Char] -> Parser [Char]) -> Parser [Char] -> Parser [Char]
forall a b. (a -> b) -> a -> b
$ ParsecT Void [Char] Identity Char -> Parser () -> Parser [Char]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
M.manyTill ParsecT Void [Char] Identity Char
p (Parser () -> Parser ()
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
M.lookAhead (Parser ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
M.eof Parser () -> Parser () -> Parser ()
forall a.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void [Char] Identity (Tokens [Char]) -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void [Char] Identity (Tokens [Char])
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
M.eol))

untilvia :: Parser String
untilvia :: Parser [Char]
untilvia =
  Parser [Char] -> Parser [Char]
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
M.try (Parser [Char] -> Parser [Char]) -> Parser [Char] -> Parser [Char]
forall a b. (a -> b) -> a -> b
$
    ShowS -> Parser [Char] -> Parser [Char]
forall a b.
(a -> b)
-> ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ShowS
forall a. [a] -> [a]
reverse ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. [a] -> [a]
reverse) (Parser [Char] -> Parser [Char]) -> Parser [Char] -> Parser [Char]
forall a b. (a -> b) -> a -> b
$
      ParsecT Void [Char] Identity Char -> Parser () -> Parser [Char]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
M.manyTill ParsecT Void [Char] Identity Char
typechars (Parser () -> Parser [Char]) -> Parser () -> Parser [Char]
forall a b. (a -> b) -> a -> b
$
        Parser () -> Parser ()
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
M.lookAhead (ParsecT Void [Char] Identity (Tokens [Char]) -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void [Char] Identity (Tokens [Char])
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
M.eol Parser () -> Parser () -> Parser ()
forall a.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void [Char] Identity (Tokens [Char]) -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Tokens [Char] -> ParsecT Void [Char] Identity (Tokens [Char])
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
M.string [Char]
Tokens [Char]
"via") Parser () -> Parser () -> Parser ()
forall a.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
M.eof)

-- Main parsers
parsetype :: Parser ViaInfo
parsetype :: Parser ViaInfo
parsetype =
  [Parser ViaInfo] -> Parser ViaInfo
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
M.choice
    [ Parser ViaInfo -> Parser ViaInfo
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
M.try (Parser ViaInfo -> Parser ViaInfo)
-> Parser ViaInfo -> Parser ViaInfo
forall a b. (a -> b) -> a -> b
$
        [Char] -> [Char] -> ViaInfo
WithVia
          ([Char] -> [Char] -> ViaInfo)
-> Parser [Char]
-> ParsecT Void [Char] Identity ([Char] -> ViaInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [Char] -> Parser [Char]
forall a. Parser a -> Parser a
lexeme Parser [Char]
untilvia
          ParsecT Void [Char] Identity ([Char] -> ViaInfo)
-> Parser [Char] -> Parser ViaInfo
forall a b.
ParsecT Void [Char] Identity (a -> b)
-> ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ParsecT Void [Char] Identity (Tokens [Char])
-> ParsecT Void [Char] Identity (Tokens [Char])
forall a. Parser a -> Parser a
lexeme (Tokens [Char] -> ParsecT Void [Char] Identity (Tokens [Char])
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
M.string [Char]
Tokens [Char]
"via") ParsecT Void [Char] Identity (Tokens [Char])
-> Parser [Char] -> Parser [Char]
forall a b.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity b -> ParsecT Void [Char] Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser [Char] -> Parser [Char]
forall a. Parser a -> Parser a
lexeme (ParsecT Void [Char] Identity Char -> Parser [Char]
untileol ParsecT Void [Char] Identity Char
ParsecT Void [Char] Identity (Token [Char])
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
M.anySingle)),
      [Char] -> ViaInfo
Plain ([Char] -> ViaInfo) -> Parser [Char] -> Parser ViaInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [Char] -> Parser [Char]
forall a. Parser a -> Parser a
lexeme (ParsecT Void [Char] Identity Char -> Parser [Char]
untileol ParsecT Void [Char] Identity Char
ParsecT Void [Char] Identity (Token [Char])
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
M.anySingle)
    ]

parsefield :: Parser ISynFld
parsefield :: Parser ISynFld
parsefield = do
  [Char]
isfldnam <- Parser [Char] -> Parser [Char]
forall a. Parser a -> Parser a
lexeme Parser [Char]
identifier
  ParsecT Void [Char] Identity (Tokens [Char]) -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void [Char] Identity (Tokens [Char]) -> Parser ())
-> ParsecT Void [Char] Identity (Tokens [Char]) -> Parser ()
forall a b. (a -> b) -> a -> b
$ ParsecT Void [Char] Identity (Tokens [Char])
-> ParsecT Void [Char] Identity (Tokens [Char])
forall a. Parser a -> Parser a
lexeme (Tokens [Char] -> ParsecT Void [Char] Identity (Tokens [Char])
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
M.string [Char]
Tokens [Char]
"::")
  ViaInfo
isfldtyp <- Parser ViaInfo
parsetype
  ISynFld -> Parser ISynFld
forall a. a -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ISynFld {[Char]
isfldnam :: [Char]
isfldnam :: [Char]
isfldnam, ViaInfo
isfldtyp :: ViaInfo
isfldtyp :: ViaInfo
isfldtyp}

indentblock :: Parser a -> Parser b -> Parser (a, [b])
indentblock :: forall a b. Parser a -> Parser b -> Parser (a, [b])
indentblock Parser a
p1 Parser b
p2 = Parser ()
-> ParsecT
     Void
     [Char]
     Identity
     (IndentOpt (ParsecT Void [Char] Identity) (a, [b]) b)
-> ParsecT Void [Char] Identity (a, [b])
forall s e (m :: * -> *) a b.
(TraversableStream s, MonadParsec e s m, Token s ~ Char) =>
m () -> m (IndentOpt m a b) -> m a
L.indentBlock Parser ()
sc do
  a
i <- Parser a
p1
  IndentOpt (ParsecT Void [Char] Identity) (a, [b]) b
-> ParsecT
     Void
     [Char]
     Identity
     (IndentOpt (ParsecT Void [Char] Identity) (a, [b]) b)
forall a. a -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IndentOpt (ParsecT Void [Char] Identity) (a, [b]) b
 -> ParsecT
      Void
      [Char]
      Identity
      (IndentOpt (ParsecT Void [Char] Identity) (a, [b]) b))
-> IndentOpt (ParsecT Void [Char] Identity) (a, [b]) b
-> ParsecT
     Void
     [Char]
     Identity
     (IndentOpt (ParsecT Void [Char] Identity) (a, [b]) b)
forall a b. (a -> b) -> a -> b
$ Maybe Pos
-> ([b] -> ParsecT Void [Char] Identity (a, [b]))
-> Parser b
-> IndentOpt (ParsecT Void [Char] Identity) (a, [b]) b
forall (m :: * -> *) a b.
Maybe Pos -> ([b] -> m a) -> m b -> IndentOpt m a b
L.IndentMany Maybe Pos
forall a. Maybe a
Nothing ((a, [b]) -> ParsecT Void [Char] Identity (a, [b])
forall a. a -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((a, [b]) -> ParsecT Void [Char] Identity (a, [b]))
-> ([b] -> (a, [b]))
-> [b]
-> ParsecT Void [Char] Identity (a, [b])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
i,)) Parser b
p2

parsedata :: Parser ISyn
parsedata :: Parser ISyn
parsedata = do
  ([Char]
isnam, [ISynFld]
isflds) <-
    Parser [Char] -> Parser ISynFld -> Parser ([Char], [ISynFld])
forall a b. Parser a -> Parser b -> Parser (a, [b])
indentblock
      (ParsecT Void [Char] Identity (Tokens [Char])
-> ParsecT Void [Char] Identity (Tokens [Char])
forall a. Parser a -> Parser a
lexeme (Tokens [Char] -> ParsecT Void [Char] Identity (Tokens [Char])
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
M.string [Char]
Tokens [Char]
"data") ParsecT Void [Char] Identity (Tokens [Char])
-> Parser [Char] -> Parser [Char]
forall a b.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity b -> ParsecT Void [Char] Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser [Char] -> Parser [Char]
forall a. Parser a -> Parser a
lexeme Parser [Char]
identifier)
      Parser ISynFld
parsefield
  ISyn -> Parser ISyn
forall a. a -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ISynData {[Char]
isnam :: [Char]
isnam :: [Char]
isnam, [ISynFld]
isflds :: [ISynFld]
isflds :: [ISynFld]
isflds}

parsenewtype :: Parser ISyn
parsenewtype :: Parser ISyn
parsenewtype = Parser ISyn -> Parser ISyn
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
M.try Parser ISyn
parsenewtype1 Parser ISyn -> Parser ISyn -> Parser ISyn
forall a.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity a -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ISyn
parsenewtype2
  where
    parsenewtype1 :: Parser ISyn
parsenewtype1 = do
      ([Char]
isnam, [ISynFld]
flds) <-
        Parser [Char] -> Parser ISynFld -> Parser ([Char], [ISynFld])
forall a b. Parser a -> Parser b -> Parser (a, [b])
indentblock
          (ParsecT Void [Char] Identity (Tokens [Char])
-> ParsecT Void [Char] Identity (Tokens [Char])
forall a. Parser a -> Parser a
lexeme (Tokens [Char] -> ParsecT Void [Char] Identity (Tokens [Char])
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
M.string [Char]
Tokens [Char]
"newtype") ParsecT Void [Char] Identity (Tokens [Char])
-> Parser [Char] -> Parser [Char]
forall a b.
ParsecT Void [Char] Identity a
-> ParsecT Void [Char] Identity b -> ParsecT Void [Char] Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser [Char] -> Parser [Char]
forall a. Parser a -> Parser a
lexeme Parser [Char]
identifier)
          Parser ISynFld
parsefield
      ISynFld
f <- case [ISynFld]
flds of
        [ISynFld
g] -> ISynFld -> Parser ISynFld
forall a. a -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ISynFld
g
        [ISynFld]
_ -> [Char] -> Parser ISynFld
forall a. [Char] -> ParsecT Void [Char] Identity a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"parsenewtype: a newtype must have exactly one field"
      ISyn -> Parser ISyn
forall a. a -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ISynNewtype {[Char]
isnam :: [Char]
isnam :: [Char]
isnam, isfld1 :: INewtypePayload
isfld1 = ISynFld -> INewtypePayload
IField ISynFld
f}
    parsenewtype2 :: Parser ISyn
parsenewtype2 = do
      ParsecT Void [Char] Identity (Tokens [Char]) -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void [Char] Identity (Tokens [Char]) -> Parser ())
-> ParsecT Void [Char] Identity (Tokens [Char]) -> Parser ()
forall a b. (a -> b) -> a -> b
$ ParsecT Void [Char] Identity (Tokens [Char])
-> ParsecT Void [Char] Identity (Tokens [Char])
forall a. Parser a -> Parser a
lexeme (Tokens [Char] -> ParsecT Void [Char] Identity (Tokens [Char])
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
M.string [Char]
Tokens [Char]
"newtype")
      [Char]
isnam <- Parser [Char] -> Parser [Char]
forall a. Parser a -> Parser a
lexeme Parser [Char]
identifier
      ViaInfo
typ <- Parser ViaInfo
parsetype
      ISyn -> Parser ISyn
forall a. a -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ISynNewtype {[Char]
isnam :: [Char]
isnam :: [Char]
isnam, isfld1 :: INewtypePayload
isfld1 = ViaInfo -> INewtypePayload
IType ViaInfo
typ}

parsealias :: Parser ISyn
parsealias :: Parser ISyn
parsealias = do
  ParsecT Void [Char] Identity (Tokens [Char]) -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void [Char] Identity (Tokens [Char]) -> Parser ())
-> ParsecT Void [Char] Identity (Tokens [Char]) -> Parser ()
forall a b. (a -> b) -> a -> b
$ ParsecT Void [Char] Identity (Tokens [Char])
-> ParsecT Void [Char] Identity (Tokens [Char])
forall a. Parser a -> Parser a
lexeme (Tokens [Char] -> ParsecT Void [Char] Identity (Tokens [Char])
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
M.string [Char]
Tokens [Char]
"type")
  [Char]
isnam <- Parser [Char] -> Parser [Char]
forall a. Parser a -> Parser a
lexeme Parser [Char]
identifier
  [Char]
isdest <- Parser [Char] -> Parser [Char]
forall a. Parser a -> Parser a
lexeme (ParsecT Void [Char] Identity Char -> Parser [Char]
untileol ParsecT Void [Char] Identity Char
ParsecT Void [Char] Identity (Token [Char])
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
M.anySingle)
  ISyn -> Parser ISyn
forall a. a -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ISynAlias {[Char]
isnam :: [Char]
isnam :: [Char]
isnam, [Char]
isdest :: [Char]
isdest :: [Char]
isdest}

parsederive :: Parser Derive
parsederive :: Parser Derive
parsederive = do
  (Tokens [Char]
_, ![[[Char]]]
classes) <-
    ParsecT Void [Char] Identity (Tokens [Char])
-> Parser [[Char]] -> Parser (Tokens [Char], [[[Char]]])
forall a b. Parser a -> Parser b -> Parser (a, [b])
indentblock
      (ParsecT Void [Char] Identity (Tokens [Char])
-> ParsecT Void [Char] Identity (Tokens [Char])
forall a. Parser a -> Parser a
lexeme (Tokens [Char] -> ParsecT Void [Char] Identity (Tokens [Char])
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
M.string [Char]
Tokens [Char]
".derive"))
      (Parser [Char] -> Parser [[Char]]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (Parser [Char] -> Parser [Char]
forall a. Parser a -> Parser a
lexeme Parser [Char]
identifier))
  Derive -> Parser Derive
forall a. a -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Derive -> Parser Derive) -> Derive -> Parser Derive
forall a b. (a -> b) -> a -> b
$ [[Char]] -> Derive
Derive ([[[Char]]] -> [[Char]]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join [[[Char]]]
classes)

parsesyn :: Parser ISyn
parsesyn :: Parser ISyn
parsesyn =
  Parser ISyn -> Parser ISyn
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
M.try (Parser ISyn -> Parser ISyn) -> Parser ISyn -> Parser ISyn
forall a b. (a -> b) -> a -> b
$
    [Parser ISyn] -> Parser ISyn
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
M.choice
      [ Parser ISyn -> Parser ISyn
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
M.try Parser ISyn
parsedata,
        Parser ISyn -> Parser ISyn
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
M.try Parser ISyn
parsenewtype,
        Parser ISyn -> Parser ISyn
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
M.try Parser ISyn
parsealias
      ]

parsetop :: Parser (Derive, [ISyn])
parsetop :: Parser (Derive, [ISyn])
parsetop = do
  Derive
h <- Parser Derive
parsederive
  [ISyn]
decls <- Parser ISyn
parsesyn Parser ISyn -> Parser () -> ParsecT Void [Char] Identity [ISyn]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`M.sepEndBy1` Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
M.space
  Parser ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
M.eof
  (Derive, [ISyn]) -> Parser (Derive, [ISyn])
forall a. a -> ParsecT Void [Char] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Derive
h, [ISyn]
decls)

-- test (when using GHCi)
_testbody1 :: String
_testbody1 :: [Char]
_testbody1 =
  [[Char]] -> [Char]
unlines
    [ [Char]
".coerce",
      [Char]
"  mkpackdecls",
      [Char]
"  mkunpackdecls",
      [Char]
"",
      [Char]
".derive",
      [Char]
"  Eq Ord Show Read",
      [Char]
"  Generic Typeable Data",
      [Char]
"",
      [Char]
"data Person",
      [Char]
"  age :: Int32 via Age",
      [Char]
"  name :: String via VerifyLength 1 10 String",
      [Char]
"  email :: String via VerifyEmail String",
      [Char]
"",
      [Char]
"newtype Age",
      [Char]
"  getage :: Int32",
      [Char]
""
    ]