{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}

module Data.Medea.Parser.Spec.Array
  ( Specification (..),
    defaultSpec,
    parseSpecification,
  )
where

import Control.Applicative ((<|>))
import Control.Applicative.Permutations (runPermutation, toPermutationWithDefault)
import Data.Medea.Parser.Primitive
  ( Identifier,
    Natural,
    ReservedIdentifier (..),
    parseIdentifier,
    parseKeyVal,
    parseLine,
    parseNatural,
    parseReserved,
  )
import Data.Medea.Parser.Types (MedeaParser, ParseError (..))
import Text.Megaparsec (MonadParsec (..), customFailure, many, try)

data Specification = Specification
  { Specification -> Maybe Natural
minLength :: !(Maybe Natural),
    Specification -> Maybe Natural
maxLength :: !(Maybe Natural),
    Specification -> Maybe Identifier
elementType :: !(Maybe Identifier),
    Specification -> Maybe [Identifier]
tupleSpec :: !(Maybe [Identifier])
  }
  deriving stock (Specification -> Specification -> Bool
(Specification -> Specification -> Bool)
-> (Specification -> Specification -> Bool) -> Eq Specification
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Specification -> Specification -> Bool
$c/= :: Specification -> Specification -> Bool
== :: Specification -> Specification -> Bool
$c== :: Specification -> Specification -> Bool
Eq, Int -> Specification -> ShowS
[Specification] -> ShowS
Specification -> String
(Int -> Specification -> ShowS)
-> (Specification -> String)
-> ([Specification] -> ShowS)
-> Show Specification
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Specification] -> ShowS
$cshowList :: [Specification] -> ShowS
show :: Specification -> String
$cshow :: Specification -> String
showsPrec :: Int -> Specification -> ShowS
$cshowsPrec :: Int -> Specification -> ShowS
Show)

-- tupleSpec with an empty list indicates an empty tuple/encoding of unit
-- tupleSpec of Nothing indicates that there is no tuple spec at all

defaultSpec :: Specification
defaultSpec :: Specification
defaultSpec = Maybe Natural
-> Maybe Natural
-> Maybe Identifier
-> Maybe [Identifier]
-> Specification
Specification Maybe Natural
forall a. Maybe a
Nothing Maybe Natural
forall a. Maybe a
Nothing Maybe Identifier
forall a. Maybe a
Nothing Maybe [Identifier]
forall a. Maybe a
Nothing

parseSpecification :: MedeaParser Specification
parseSpecification :: MedeaParser Specification
parseSpecification = do
  Specification
spec <- MedeaParser Specification -> MedeaParser Specification
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try MedeaParser Specification
permute
  case Specification
spec of
    Specification Maybe Natural
Nothing Maybe Natural
Nothing Maybe Identifier
Nothing Maybe [Identifier]
Nothing ->
      -- the user must specify length, or a type, or a tuple spec
      ParseError -> MedeaParser Specification
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure ParseError
EmptyLengthArraySpec
    Specification Maybe Natural
_ Maybe Natural
_ (Just Identifier
_) (Just [Identifier]
_) ->
      -- the user has defined both element type and tuple.
      -- this is illegal behaviour
      ParseError -> MedeaParser Specification
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure ParseError
ConflictingSpecRequirements
    Specification (Just Natural
_) Maybe Natural
_ Maybe Identifier
_ (Just [Identifier]
_) ->
      -- the user cannot specify length and tuples
      ParseError -> MedeaParser Specification
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure ParseError
ConflictingSpecRequirements
    Specification Maybe Natural
_ (Just Natural
_) Maybe Identifier
_ (Just [Identifier]
_) ->
      ParseError -> MedeaParser Specification
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure ParseError
ConflictingSpecRequirements
    Specification
_ -> Specification -> MedeaParser Specification
forall (f :: * -> *) a. Applicative f => a -> f a
pure Specification
spec
  where
    permute :: MedeaParser Specification
permute =
      Permutation (ParsecT ParseError Text Identity) Specification
-> MedeaParser Specification
forall (m :: * -> *) a.
(Alternative m, Monad m) =>
Permutation m a -> m a
runPermutation (Permutation (ParsecT ParseError Text Identity) Specification
 -> MedeaParser Specification)
-> Permutation (ParsecT ParseError Text Identity) Specification
-> MedeaParser Specification
forall a b. (a -> b) -> a -> b
$
        Maybe Natural
-> Maybe Natural
-> Maybe Identifier
-> Maybe [Identifier]
-> Specification
Specification
          (Maybe Natural
 -> Maybe Natural
 -> Maybe Identifier
 -> Maybe [Identifier]
 -> Specification)
-> Permutation (ParsecT ParseError Text Identity) (Maybe Natural)
-> Permutation
     (ParsecT ParseError Text Identity)
     (Maybe Natural
      -> Maybe Identifier -> Maybe [Identifier] -> Specification)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Natural
-> ParsecT ParseError Text Identity (Maybe Natural)
-> Permutation (ParsecT ParseError Text Identity) (Maybe Natural)
forall (m :: * -> *) a.
Alternative m =>
a -> m a -> Permutation m a
toPermutationWithDefault Maybe Natural
forall a. Maybe a
Nothing (ParsecT ParseError Text Identity (Maybe Natural)
-> ParsecT ParseError Text Identity (Maybe Natural)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT ParseError Text Identity (Maybe Natural)
parseMinSpec)
          Permutation
  (ParsecT ParseError Text Identity)
  (Maybe Natural
   -> Maybe Identifier -> Maybe [Identifier] -> Specification)
-> Permutation (ParsecT ParseError Text Identity) (Maybe Natural)
-> Permutation
     (ParsecT ParseError Text Identity)
     (Maybe Identifier -> Maybe [Identifier] -> Specification)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Natural
-> ParsecT ParseError Text Identity (Maybe Natural)
-> Permutation (ParsecT ParseError Text Identity) (Maybe Natural)
forall (m :: * -> *) a.
Alternative m =>
a -> m a -> Permutation m a
toPermutationWithDefault Maybe Natural
forall a. Maybe a
Nothing (ParsecT ParseError Text Identity (Maybe Natural)
-> ParsecT ParseError Text Identity (Maybe Natural)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT ParseError Text Identity (Maybe Natural)
parseMaxSpec)
          Permutation
  (ParsecT ParseError Text Identity)
  (Maybe Identifier -> Maybe [Identifier] -> Specification)
-> Permutation
     (ParsecT ParseError Text Identity) (Maybe Identifier)
-> Permutation
     (ParsecT ParseError Text Identity)
     (Maybe [Identifier] -> Specification)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Identifier
-> ParsecT ParseError Text Identity (Maybe Identifier)
-> Permutation
     (ParsecT ParseError Text Identity) (Maybe Identifier)
forall (m :: * -> *) a.
Alternative m =>
a -> m a -> Permutation m a
toPermutationWithDefault Maybe Identifier
forall a. Maybe a
Nothing (ParsecT ParseError Text Identity (Maybe Identifier)
-> ParsecT ParseError Text Identity (Maybe Identifier)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT ParseError Text Identity (Maybe Identifier)
parseElementType)
          Permutation
  (ParsecT ParseError Text Identity)
  (Maybe [Identifier] -> Specification)
-> Permutation
     (ParsecT ParseError Text Identity) (Maybe [Identifier])
-> Permutation (ParsecT ParseError Text Identity) Specification
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe [Identifier]
-> ParsecT ParseError Text Identity (Maybe [Identifier])
-> Permutation
     (ParsecT ParseError Text Identity) (Maybe [Identifier])
forall (m :: * -> *) a.
Alternative m =>
a -> m a -> Permutation m a
toPermutationWithDefault Maybe [Identifier]
forall a. Maybe a
Nothing (ParsecT ParseError Text Identity (Maybe [Identifier])
-> ParsecT ParseError Text Identity (Maybe [Identifier])
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT ParseError Text Identity (Maybe [Identifier])
parseTupleSpec)

parseMinSpec :: MedeaParser (Maybe Natural)
parseMinSpec :: ParsecT ParseError Text Identity (Maybe Natural)
parseMinSpec =
  Int
-> ParsecT ParseError Text Identity (Maybe Natural)
-> ParsecT ParseError Text Identity (Maybe Natural)
forall a. Int -> MedeaParser a -> MedeaParser a
parseLine Int
4 (ParsecT ParseError Text Identity (Maybe Natural)
 -> ParsecT ParseError Text Identity (Maybe Natural))
-> ParsecT ParseError Text Identity (Maybe Natural)
-> ParsecT ParseError Text Identity (Maybe Natural)
forall a b. (a -> b) -> a -> b
$ Natural -> Maybe Natural
forall a. a -> Maybe a
Just (Natural -> Maybe Natural)
-> ParsecT ParseError Text Identity Natural
-> ParsecT ParseError Text Identity (Maybe Natural)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReservedIdentifier
-> ParsecT ParseError Text Identity Natural
-> ParsecT ParseError Text Identity Natural
forall a. ReservedIdentifier -> MedeaParser a -> MedeaParser a
parseKeyVal ReservedIdentifier
RMinLength ParsecT ParseError Text Identity Natural
parseNatural

parseMaxSpec :: MedeaParser (Maybe Natural)
parseMaxSpec :: ParsecT ParseError Text Identity (Maybe Natural)
parseMaxSpec =
  Int
-> ParsecT ParseError Text Identity (Maybe Natural)
-> ParsecT ParseError Text Identity (Maybe Natural)
forall a. Int -> MedeaParser a -> MedeaParser a
parseLine Int
4 (ParsecT ParseError Text Identity (Maybe Natural)
 -> ParsecT ParseError Text Identity (Maybe Natural))
-> ParsecT ParseError Text Identity (Maybe Natural)
-> ParsecT ParseError Text Identity (Maybe Natural)
forall a b. (a -> b) -> a -> b
$ Natural -> Maybe Natural
forall a. a -> Maybe a
Just (Natural -> Maybe Natural)
-> ParsecT ParseError Text Identity Natural
-> ParsecT ParseError Text Identity (Maybe Natural)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReservedIdentifier
-> ParsecT ParseError Text Identity Natural
-> ParsecT ParseError Text Identity Natural
forall a. ReservedIdentifier -> MedeaParser a -> MedeaParser a
parseKeyVal ReservedIdentifier
RMaxLength ParsecT ParseError Text Identity Natural
parseNatural

parseElementType :: MedeaParser (Maybe Identifier)
parseElementType :: ParsecT ParseError Text Identity (Maybe Identifier)
parseElementType = do
  Identifier
_ <- Int -> MedeaParser Identifier -> MedeaParser Identifier
forall a. Int -> MedeaParser a -> MedeaParser a
parseLine Int
4 (MedeaParser Identifier -> MedeaParser Identifier)
-> MedeaParser Identifier -> MedeaParser Identifier
forall a b. (a -> b) -> a -> b
$ ReservedIdentifier -> MedeaParser Identifier
parseReserved ReservedIdentifier
RElementType
  Identifier
element <- Int -> MedeaParser Identifier -> MedeaParser Identifier
forall a. Int -> MedeaParser a -> MedeaParser a
parseLine Int
8 MedeaParser Identifier
parseIdentifier MedeaParser Identifier
-> MedeaParser Identifier -> MedeaParser Identifier
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParseError -> MedeaParser Identifier
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure ParseError
EmptyArrayElements
  Maybe Identifier
-> ParsecT ParseError Text Identity (Maybe Identifier)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Identifier
 -> ParsecT ParseError Text Identity (Maybe Identifier))
-> Maybe Identifier
-> ParsecT ParseError Text Identity (Maybe Identifier)
forall a b. (a -> b) -> a -> b
$ Identifier -> Maybe Identifier
forall a. a -> Maybe a
Just Identifier
element

parseTupleSpec :: MedeaParser (Maybe [Identifier])
parseTupleSpec :: ParsecT ParseError Text Identity (Maybe [Identifier])
parseTupleSpec = do
  Identifier
_ <- Int -> MedeaParser Identifier -> MedeaParser Identifier
forall a. Int -> MedeaParser a -> MedeaParser a
parseLine Int
4 (MedeaParser Identifier -> MedeaParser Identifier)
-> MedeaParser Identifier -> MedeaParser Identifier
forall a b. (a -> b) -> a -> b
$ ReservedIdentifier -> MedeaParser Identifier
parseReserved ReservedIdentifier
RTuple
  [Identifier]
elemList <- MedeaParser Identifier
-> ParsecT ParseError Text Identity [Identifier]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (MedeaParser Identifier
 -> ParsecT ParseError Text Identity [Identifier])
-> MedeaParser Identifier
-> ParsecT ParseError Text Identity [Identifier]
forall a b. (a -> b) -> a -> b
$ MedeaParser Identifier -> MedeaParser Identifier
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (MedeaParser Identifier -> MedeaParser Identifier)
-> MedeaParser Identifier -> MedeaParser Identifier
forall a b. (a -> b) -> a -> b
$ Int -> MedeaParser Identifier -> MedeaParser Identifier
forall a. Int -> MedeaParser a -> MedeaParser a
parseLine Int
8 MedeaParser Identifier
parseIdentifier
  Maybe [Identifier]
-> ParsecT ParseError Text Identity (Maybe [Identifier])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe [Identifier]
 -> ParsecT ParseError Text Identity (Maybe [Identifier]))
-> Maybe [Identifier]
-> ParsecT ParseError Text Identity (Maybe [Identifier])
forall a b. (a -> b) -> a -> b
$ [Identifier] -> Maybe [Identifier]
forall a. a -> Maybe a
Just [Identifier]
elemList