{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
module YamlParse.Applicative.Class where
import qualified Data.Aeson as JSON
import Data.Scientific
import qualified Data.Text as T
import Data.Text (Text)
import Data.Vector (Vector)
import qualified Data.Vector as V
import qualified Data.Yaml as Yaml
import GHC.Generics (Generic)
import YamlParse.Applicative.Implement
import YamlParse.Applicative.Parser
class YamlSchema a where
{-# MINIMAL yamlSchema #-}
yamlSchema :: YamlParser a
yamlSchemaList :: YamlParser [a]
yamlSchemaList = V.toList <$> ParseArray Nothing (ParseList yamlSchema)
instance YamlSchema Bool where
yamlSchema = ParseBool Nothing ParseAny
instance YamlSchema Char where
yamlSchema =
ParseString Nothing $
ParseMaybe
( \cs -> case T.unpack cs of
[] -> Nothing
[c] -> Just c
_ -> Nothing
)
ParseAny
yamlSchemaList = T.unpack <$> yamlSchema
instance YamlSchema Text where
yamlSchema = ParseString Nothing ParseAny
instance YamlSchema Scientific where
yamlSchema = ParseNumber Nothing ParseAny
instance YamlSchema Yaml.Object where
yamlSchema = ParseObject Nothing ParseAny
instance YamlSchema Yaml.Value where
yamlSchema = ParseAny
instance YamlSchema a => YamlSchema (Vector a) where
yamlSchema = ParseArray Nothing (ParseList yamlSchema)
instance YamlSchema a => YamlSchema [a] where
yamlSchema = yamlSchemaList
requiredField :: YamlSchema a => Text -> Text -> ObjectParser a
requiredField k h = requiredFieldWith k h yamlSchema
requiredField' :: YamlSchema a => Text -> ObjectParser a
requiredField' k = requiredFieldWith' k yamlSchema
optionalField :: YamlSchema a => Text -> Text -> ObjectParser (Maybe a)
optionalField k h = optionalFieldWith k h yamlSchema
optionalField' :: YamlSchema a => Text -> ObjectParser (Maybe a)
optionalField' k = optionalFieldWith' k yamlSchema
optionalFieldWithDefault :: (Show a, YamlSchema a) => Text -> a -> Text -> ObjectParser a
optionalFieldWithDefault k d h = optionalFieldWithDefaultWith k d h yamlSchema
optionalFieldWithDefault' :: (Show a, YamlSchema a) => Text -> a -> ObjectParser a
optionalFieldWithDefault' k d = optionalFieldWithDefaultWith' k d yamlSchema
viaYamlSchema :: YamlSchema a => Yaml.Value -> Yaml.Parser a
viaYamlSchema = implementParser yamlSchema
newtype ViaYamlSchema a = ViaYamlSchema a
deriving (Show, Eq, Generic)
instance YamlSchema a => Yaml.FromJSON (ViaYamlSchema a) where
parseJSON = fmap ViaYamlSchema . viaYamlSchema