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

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

import Data.Medea.Parser.Primitive
  ( Identifier,
    ReservedIdentifier (..),
    parseIdentifier,
    parseLine,
    parseReserved,
  )
import Data.Medea.Parser.Types (MedeaParser)
import Data.Vector (Vector)
import qualified Data.Vector as V
import Text.Megaparsec (MonadParsec (..), some)

newtype Specification = Specification (Vector Identifier)
  deriving newtype (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)

defaultSpec :: Specification
defaultSpec :: Specification
defaultSpec = Vector Identifier -> Specification
Specification Vector Identifier
forall a. Vector a
V.empty

parseSpecification :: MedeaParser Specification
parseSpecification :: MedeaParser Specification
parseSpecification = 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
RType
  [Identifier]
types <- MedeaParser Identifier
-> ParsecT ParseError Text Identity [Identifier]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (MedeaParser Identifier
 -> ParsecT ParseError Text Identity [Identifier])
-> (MedeaParser Identifier -> MedeaParser Identifier)
-> MedeaParser Identifier
-> ParsecT ParseError Text Identity [Identifier]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MedeaParser Identifier -> MedeaParser Identifier
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (MedeaParser Identifier
 -> ParsecT ParseError Text Identity [Identifier])
-> MedeaParser Identifier
-> ParsecT ParseError Text Identity [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
  Specification -> MedeaParser Specification
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Specification -> MedeaParser Specification)
-> ([Identifier] -> Specification)
-> [Identifier]
-> MedeaParser Specification
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Identifier -> Specification
Specification (Vector Identifier -> Specification)
-> ([Identifier] -> Vector Identifier)
-> [Identifier]
-> Specification
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Identifier] -> Vector Identifier
forall a. [a] -> Vector a
V.fromList ([Identifier] -> MedeaParser Specification)
-> [Identifier] -> MedeaParser Specification
forall a b. (a -> b) -> a -> b
$ [Identifier]
types