module Domain.Attoparsec.TypeString
where

import Domain.Prelude hiding (takeWhile)
import Domain.Models.TypeString
import Data.Attoparsec.Text hiding (sepBy1)
import Domain.Attoparsec.General
import Control.Applicative.Combinators.NonEmpty


commaSeq :: Parser Text [NonEmpty Unit]
commaSeq =
  Parser Text (NonEmpty Unit) -> Parser Text [NonEmpty Unit]
forall a. Parser Text a -> Parser Text [a]
commaSeparated Parser Text (NonEmpty Unit)
appSeq

appSeq :: Parser Text (NonEmpty Unit)
appSeq =
  Parser Text Unit -> Parser Text () -> Parser Text (NonEmpty Unit)
forall (m :: * -> *) a sep.
Alternative m =>
m a -> m sep -> m (NonEmpty a)
sepBy1 Parser Text Unit
unit Parser Text ()
skipSpace1

unit :: Parser Text Unit
unit =
  [Parser Text Unit] -> Parser Text Unit
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum [
    NonEmpty Unit -> Unit
InSquareBracketsUnit (NonEmpty Unit -> Unit)
-> Parser Text (NonEmpty Unit) -> Parser Text Unit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text (NonEmpty Unit) -> Parser Text (NonEmpty Unit)
forall b. Parser Text b -> Parser Text b
inSquareBrackets Parser Text (NonEmpty Unit)
appSeq
    ,
    [NonEmpty Unit] -> Unit
InParensUnit ([NonEmpty Unit] -> Unit)
-> Parser Text [NonEmpty Unit] -> Parser Text Unit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text [NonEmpty Unit] -> Parser Text [NonEmpty Unit]
forall b. Parser Text b -> Parser Text b
inParens Parser Text [NonEmpty Unit]
commaSeq
    ,
    NonEmpty Text -> Unit
RefUnit (NonEmpty Text -> Unit)
-> Parser Text (NonEmpty Text) -> Parser Text Unit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text (NonEmpty Text)
typeRef
    ]

typeRef :: Parser Text (NonEmpty Text)
typeRef =
  Parser Text Text -> Parser Text Char -> Parser Text (NonEmpty Text)
forall (m :: * -> *) a sep.
Alternative m =>
m a -> m sep -> m (NonEmpty a)
sepBy1 Parser Text Text
ucName (Char -> Parser Text Char
char Char
'.')