module Domain.Attoparsec.TypeString where

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

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

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

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

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