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

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

import Data.Coerce (coerce)
import Data.Medea.Parser.Primitive
  ( MedeaString,
    ReservedIdentifier (..),
    parseLine,
    parseReserved,
    parseString,
    unwrap,
  )
import Data.Medea.Parser.Types (MedeaParser, ParseError (..))
import Data.Text (Text)
import Data.Vector (Vector)
import qualified Data.Vector as Vec
import Text.Megaparsec (MonadParsec (..), customFailure, many)

newtype Specification = Specification (Vector MedeaString)
  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, 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)

toReducedSpec :: Specification -> Vector Text
toReducedSpec :: Specification -> Vector Text
toReducedSpec Specification
spec = (MedeaString -> Text) -> Vector MedeaString -> Vector Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MedeaString -> Text
unwrap (Specification -> Vector MedeaString
coerce Specification
spec :: Vector MedeaString)

defaultSpec :: Specification
defaultSpec :: Specification
defaultSpec = Vector MedeaString -> Specification
Specification Vector MedeaString
forall a. Vector a
Vec.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
RStringValues
  [MedeaString]
items <- ParsecT ParseError Text Identity MedeaString
-> ParsecT ParseError Text Identity [MedeaString]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT ParseError Text Identity MedeaString
 -> ParsecT ParseError Text Identity [MedeaString])
-> ParsecT ParseError Text Identity MedeaString
-> ParsecT ParseError Text Identity [MedeaString]
forall a b. (a -> b) -> a -> b
$ ParsecT ParseError Text Identity MedeaString
-> ParsecT ParseError Text Identity MedeaString
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT ParseError Text Identity MedeaString
 -> ParsecT ParseError Text Identity MedeaString)
-> ParsecT ParseError Text Identity MedeaString
-> ParsecT ParseError Text Identity MedeaString
forall a b. (a -> b) -> a -> b
$ Int
-> ParsecT ParseError Text Identity MedeaString
-> ParsecT ParseError Text Identity MedeaString
forall a. Int -> MedeaParser a -> MedeaParser a
parseLine Int
8 ParsecT ParseError Text Identity MedeaString
parseString
  if [MedeaString] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [MedeaString]
items
    then ParseError -> MedeaParser Specification
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure ParseError
EmptyStringValuesSpec
    else Specification -> MedeaParser Specification
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Specification -> MedeaParser Specification)
-> Specification -> MedeaParser Specification
forall a b. (a -> b) -> a -> b
$ Vector MedeaString -> Specification
Specification (Vector MedeaString -> Specification)
-> Vector MedeaString -> Specification
forall a b. (a -> b) -> a -> b
$ [MedeaString] -> Vector MedeaString
forall a. [a] -> Vector a
Vec.fromList [MedeaString]
items