{-# Language ScopedTypeVariables, OverloadedStrings #-}
module Config.Schema.Spec
(
ValueSpec
, sectionsSpec
, assocSpec
, atomSpec
, anyAtomSpec
, listSpec
, customSpec
, namedSpec
, numberSpec
, integerSpec
, naturalSpec
, rationalSpec
, textSpec
, HasSpec(..)
, SectionsSpec
, reqSection
, optSection
, reqSection'
, optSection'
, oneOrList
, yesOrNoSpec
, trueOrFalseSpec
, stringSpec
, numSpec
, fractionalSpec
, nonemptySpec
, oneOrNonemptySpec
) where
import Data.Bits (FiniteBits, isSigned, toIntegralSized, finiteBitSize)
import Data.Functor.Alt (Alt(..))
import Data.Int
import Data.List.NonEmpty (NonEmpty)
import qualified Data.List.NonEmpty as NonEmpty
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Word
import Data.Ratio
import GHC.Natural (Natural)
import Config.Schema.Types
import Config.Number (Number, numberToInteger, numberToRational)
class HasSpec a where anySpec :: ValueSpec a
instance HasSpec Text where anySpec :: ValueSpec Text
anySpec = ValueSpec Text
textSpec
instance HasSpec Integer where anySpec :: ValueSpec Integer
anySpec = ValueSpec Integer
integerSpec
instance HasSpec Int where anySpec :: ValueSpec Int
anySpec = ValueSpec Int
forall a. (Integral a, FiniteBits a) => ValueSpec a
sizedBitsSpec
instance HasSpec Int8 where anySpec :: ValueSpec Int8
anySpec = ValueSpec Int8
forall a. (Integral a, FiniteBits a) => ValueSpec a
sizedBitsSpec
instance HasSpec Int16 where anySpec :: ValueSpec Int16
anySpec = ValueSpec Int16
forall a. (Integral a, FiniteBits a) => ValueSpec a
sizedBitsSpec
instance HasSpec Int32 where anySpec :: ValueSpec Int32
anySpec = ValueSpec Int32
forall a. (Integral a, FiniteBits a) => ValueSpec a
sizedBitsSpec
instance HasSpec Int64 where anySpec :: ValueSpec Int64
anySpec = ValueSpec Int64
forall a. (Integral a, FiniteBits a) => ValueSpec a
sizedBitsSpec
instance HasSpec Word where anySpec :: ValueSpec Word
anySpec = ValueSpec Word
forall a. (Integral a, FiniteBits a) => ValueSpec a
sizedBitsSpec
instance HasSpec Word8 where anySpec :: ValueSpec Word8
anySpec = ValueSpec Word8
forall a. (Integral a, FiniteBits a) => ValueSpec a
sizedBitsSpec
instance HasSpec Word16 where anySpec :: ValueSpec Word16
anySpec = ValueSpec Word16
forall a. (Integral a, FiniteBits a) => ValueSpec a
sizedBitsSpec
instance HasSpec Word32 where anySpec :: ValueSpec Word32
anySpec = ValueSpec Word32
forall a. (Integral a, FiniteBits a) => ValueSpec a
sizedBitsSpec
instance HasSpec Word64 where anySpec :: ValueSpec Word64
anySpec = ValueSpec Word64
forall a. (Integral a, FiniteBits a) => ValueSpec a
sizedBitsSpec
instance HasSpec Natural where anySpec :: ValueSpec Natural
anySpec = ValueSpec Natural
naturalSpec
instance HasSpec Double where anySpec :: ValueSpec Double
anySpec = ValueSpec Double
forall a. Fractional a => ValueSpec a
fractionalSpec
instance HasSpec Float where anySpec :: ValueSpec Float
anySpec = ValueSpec Float
forall a. Fractional a => ValueSpec a
fractionalSpec
instance Integral a => HasSpec (Ratio a) where
anySpec :: ValueSpec (Ratio a)
anySpec = ValueSpec (Ratio a)
forall a. Fractional a => ValueSpec a
fractionalSpec
instance HasSpec a => HasSpec [a] where
anySpec :: ValueSpec [a]
anySpec = ValueSpec a -> ValueSpec [a]
forall a. ValueSpec a -> ValueSpec [a]
listSpec ValueSpec a
forall a. HasSpec a => ValueSpec a
anySpec
instance HasSpec a => HasSpec (NonEmpty a) where
anySpec :: ValueSpec (NonEmpty a)
anySpec = ValueSpec a -> ValueSpec (NonEmpty a)
forall a. ValueSpec a -> ValueSpec (NonEmpty a)
nonemptySpec ValueSpec a
forall a. HasSpec a => ValueSpec a
anySpec
instance (HasSpec a, HasSpec b) => HasSpec (Either a b) where
anySpec :: ValueSpec (Either a b)
anySpec = a -> Either a b
forall a b. a -> Either a b
Left (a -> Either a b) -> ValueSpec a -> ValueSpec (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ValueSpec a
forall a. HasSpec a => ValueSpec a
anySpec ValueSpec (Either a b)
-> ValueSpec (Either a b) -> ValueSpec (Either a b)
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> b -> Either a b
forall a b. b -> Either a b
Right (b -> Either a b) -> ValueSpec b -> ValueSpec (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ValueSpec b
forall a. HasSpec a => ValueSpec a
anySpec
{-# INLINE sizedBitsSpec #-}
sizedBitsSpec :: forall a. (Integral a, FiniteBits a) => ValueSpec a
sizedBitsSpec :: ValueSpec a
sizedBitsSpec = Text
-> ValueSpec Integer -> (Integer -> Either Text a) -> ValueSpec a
forall a b.
Text -> ValueSpec a -> (a -> Either Text b) -> ValueSpec b
customSpec Text
label ValueSpec Integer
integerSpec Integer -> Either Text a
forall a b a.
(Integral a, Integral b, Bits a, Bits b, IsString a) =>
a -> Either a b
check
where
signText :: [Char]
signText = if a -> Bool
forall a. Bits a => a -> Bool
isSigned (0::a) then "signed" else "unsigned"
label :: Text
label = [Char] -> Text
Text.pack (Int -> [Char]
forall a. Show a => a -> [Char]
show (a -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize (0::a)) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ "-bit " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
signText)
check :: a -> Either a b
check i :: a
i = case a -> Maybe b
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
toIntegralSized a
i of
Nothing -> a -> Either a b
forall a b. a -> Either a b
Left "out of bounds"
Just j :: b
j -> b -> Either a b
forall a b. b -> Either a b
Right b
j
naturalSpec :: ValueSpec Natural
naturalSpec :: ValueSpec Natural
naturalSpec = Text
-> ValueSpec Integer
-> (Integer -> Either Text Natural)
-> ValueSpec Natural
forall a b.
Text -> ValueSpec a -> (a -> Either Text b) -> ValueSpec b
customSpec "non-negative" ValueSpec Integer
integerSpec Integer -> Either Text Natural
forall a b. (IsString a, Num b) => Integer -> Either a b
check
where
check :: Integer -> Either a b
check i :: Integer
i
| Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = a -> Either a b
forall a b. a -> Either a b
Left "negative number"
| Bool
otherwise = b -> Either a b
forall a b. b -> Either a b
Right (Integer -> b
forall a. Num a => Integer -> a
fromInteger Integer
i)
atomSpec :: Text -> ValueSpec ()
atomSpec :: Text -> ValueSpec ()
atomSpec = PrimValueSpec () -> ValueSpec ()
forall a. PrimValueSpec a -> ValueSpec a
primValueSpec (PrimValueSpec () -> ValueSpec ())
-> (Text -> PrimValueSpec ()) -> Text -> ValueSpec ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> PrimValueSpec ()
AtomSpec
anyAtomSpec :: ValueSpec Text
anyAtomSpec :: ValueSpec Text
anyAtomSpec = PrimValueSpec Text -> ValueSpec Text
forall a. PrimValueSpec a -> ValueSpec a
primValueSpec PrimValueSpec Text
AnyAtomSpec
stringSpec :: ValueSpec String
stringSpec :: ValueSpec [Char]
stringSpec = Text -> [Char]
Text.unpack (Text -> [Char]) -> ValueSpec Text -> ValueSpec [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ValueSpec Text
textSpec
numSpec :: Num a => ValueSpec a
numSpec :: ValueSpec a
numSpec = Integer -> a
forall a. Num a => Integer -> a
fromInteger (Integer -> a) -> ValueSpec Integer -> ValueSpec a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ValueSpec Integer
integerSpec
textSpec :: ValueSpec Text
textSpec :: ValueSpec Text
textSpec = PrimValueSpec Text -> ValueSpec Text
forall a. PrimValueSpec a -> ValueSpec a
primValueSpec PrimValueSpec Text
TextSpec
fractionalSpec :: Fractional a => ValueSpec a
fractionalSpec :: ValueSpec a
fractionalSpec = Rational -> a
forall a. Fractional a => Rational -> a
fromRational (Rational -> a) -> ValueSpec Rational -> ValueSpec a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ValueSpec Rational
rationalSpec
numberSpec :: ValueSpec Number
numberSpec :: ValueSpec Number
numberSpec = PrimValueSpec Number -> ValueSpec Number
forall a. PrimValueSpec a -> ValueSpec a
primValueSpec PrimValueSpec Number
NumberSpec
integerSpec :: ValueSpec Integer
integerSpec :: ValueSpec Integer
integerSpec = Text
-> ValueSpec Number
-> (Number -> Either Text Integer)
-> ValueSpec Integer
forall a b.
Text -> ValueSpec a -> (a -> Either Text b) -> ValueSpec b
customSpec "integral" ValueSpec Number
numberSpec Number -> Either Text Integer
forall a. IsString a => Number -> Either a Integer
check
where
check :: Number -> Either a Integer
check n :: Number
n =
case Number -> Maybe Integer
numberToInteger Number
n of
Nothing -> a -> Either a Integer
forall a b. a -> Either a b
Left "fractional number"
Just i :: Integer
i -> Integer -> Either a Integer
forall a b. b -> Either a b
Right Integer
i
rationalSpec :: ValueSpec Rational
rationalSpec :: ValueSpec Rational
rationalSpec = Number -> Rational
numberToRational (Number -> Rational) -> ValueSpec Number -> ValueSpec Rational
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ValueSpec Number
numberSpec
listSpec :: ValueSpec a -> ValueSpec [a]
listSpec :: ValueSpec a -> ValueSpec [a]
listSpec = PrimValueSpec [a] -> ValueSpec [a]
forall a. PrimValueSpec a -> ValueSpec a
primValueSpec (PrimValueSpec [a] -> ValueSpec [a])
-> (ValueSpec a -> PrimValueSpec [a])
-> ValueSpec a
-> ValueSpec [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueSpec a -> PrimValueSpec [a]
forall a. ValueSpec a -> PrimValueSpec [a]
ListSpec
sectionsSpec ::
Text ->
SectionsSpec a ->
ValueSpec a
sectionsSpec :: Text -> SectionsSpec a -> ValueSpec a
sectionsSpec i :: Text
i s :: SectionsSpec a
s = PrimValueSpec a -> ValueSpec a
forall a. PrimValueSpec a -> ValueSpec a
primValueSpec (Text -> SectionsSpec a -> PrimValueSpec a
forall a. Text -> SectionsSpec a -> PrimValueSpec a
SectionsSpec Text
i SectionsSpec a
s)
assocSpec ::
ValueSpec a ->
ValueSpec [(Text,a)]
assocSpec :: ValueSpec a -> ValueSpec [(Text, a)]
assocSpec = PrimValueSpec [(Text, a)] -> ValueSpec [(Text, a)]
forall a. PrimValueSpec a -> ValueSpec a
primValueSpec (PrimValueSpec [(Text, a)] -> ValueSpec [(Text, a)])
-> (ValueSpec a -> PrimValueSpec [(Text, a)])
-> ValueSpec a
-> ValueSpec [(Text, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueSpec a -> PrimValueSpec [(Text, a)]
forall a. ValueSpec a -> PrimValueSpec [(Text, a)]
AssocSpec
namedSpec ::
Text ->
ValueSpec a ->
ValueSpec a
namedSpec :: Text -> ValueSpec a -> ValueSpec a
namedSpec n :: Text
n s :: ValueSpec a
s = PrimValueSpec a -> ValueSpec a
forall a. PrimValueSpec a -> ValueSpec a
primValueSpec (Text -> ValueSpec a -> PrimValueSpec a
forall a. Text -> ValueSpec a -> PrimValueSpec a
NamedSpec Text
n ValueSpec a
s)
oneOrList :: ValueSpec a -> ValueSpec [a]
oneOrList :: ValueSpec a -> ValueSpec [a]
oneOrList s :: ValueSpec a
s = a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> [a]) -> ValueSpec a -> ValueSpec [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ValueSpec a
s ValueSpec [a] -> ValueSpec [a] -> ValueSpec [a]
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> ValueSpec a -> ValueSpec [a]
forall a. ValueSpec a -> ValueSpec [a]
listSpec ValueSpec a
s
customSpec :: Text -> ValueSpec a -> (a -> Either Text b) -> ValueSpec b
customSpec :: Text -> ValueSpec a -> (a -> Either Text b) -> ValueSpec b
customSpec lbl :: Text
lbl w :: ValueSpec a
w f :: a -> Either Text b
f = PrimValueSpec b -> ValueSpec b
forall a. PrimValueSpec a -> ValueSpec a
primValueSpec (Text -> ValueSpec (Either Text b) -> PrimValueSpec b
forall a. Text -> ValueSpec (Either Text a) -> PrimValueSpec a
CustomSpec Text
lbl (a -> Either Text b
f (a -> Either Text b) -> ValueSpec a -> ValueSpec (Either Text b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ValueSpec a
w))
yesOrNoSpec :: ValueSpec Bool
yesOrNoSpec :: ValueSpec Bool
yesOrNoSpec = Bool
True Bool -> ValueSpec () -> ValueSpec Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ValueSpec ()
atomSpec "yes" ValueSpec Bool -> ValueSpec Bool -> ValueSpec Bool
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> Bool
False Bool -> ValueSpec () -> ValueSpec Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ValueSpec ()
atomSpec "no"
trueOrFalseSpec :: ValueSpec Bool
trueOrFalseSpec :: ValueSpec Bool
trueOrFalseSpec = Bool
True Bool -> ValueSpec () -> ValueSpec Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ValueSpec ()
atomSpec "true" ValueSpec Bool -> ValueSpec Bool -> ValueSpec Bool
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> Bool
False Bool -> ValueSpec () -> ValueSpec Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ValueSpec ()
atomSpec "false"
nonemptySpec :: ValueSpec a -> ValueSpec (NonEmpty a)
nonemptySpec :: ValueSpec a -> ValueSpec (NonEmpty a)
nonemptySpec s :: ValueSpec a
s = Text
-> ValueSpec [a]
-> ([a] -> Either Text (NonEmpty a))
-> ValueSpec (NonEmpty a)
forall a b.
Text -> ValueSpec a -> (a -> Either Text b) -> ValueSpec b
customSpec "nonempty" (ValueSpec a -> ValueSpec [a]
forall a. ValueSpec a -> ValueSpec [a]
listSpec ValueSpec a
s) [a] -> Either Text (NonEmpty a)
forall a a. IsString a => [a] -> Either a (NonEmpty a)
check
where
check :: [a] -> Either a (NonEmpty a)
check xs :: [a]
xs = case [a] -> Maybe (NonEmpty a)
forall a. [a] -> Maybe (NonEmpty a)
NonEmpty.nonEmpty [a]
xs of
Nothing -> a -> Either a (NonEmpty a)
forall a b. a -> Either a b
Left "empty list"
Just xxs :: NonEmpty a
xxs -> NonEmpty a -> Either a (NonEmpty a)
forall a b. b -> Either a b
Right NonEmpty a
xxs
oneOrNonemptySpec :: ValueSpec a -> ValueSpec (NonEmpty a)
oneOrNonemptySpec :: ValueSpec a -> ValueSpec (NonEmpty a)
oneOrNonemptySpec s :: ValueSpec a
s = a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> NonEmpty a) -> ValueSpec a -> ValueSpec (NonEmpty a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ValueSpec a
s ValueSpec (NonEmpty a)
-> ValueSpec (NonEmpty a) -> ValueSpec (NonEmpty a)
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> ValueSpec a -> ValueSpec (NonEmpty a)
forall a. ValueSpec a -> ValueSpec (NonEmpty a)
nonemptySpec ValueSpec a
s
reqSection ::
HasSpec a =>
Text ->
Text ->
SectionsSpec a
reqSection :: Text -> Text -> SectionsSpec a
reqSection n :: Text
n = Text -> ValueSpec a -> Text -> SectionsSpec a
forall a. Text -> ValueSpec a -> Text -> SectionsSpec a
reqSection' Text
n ValueSpec a
forall a. HasSpec a => ValueSpec a
anySpec
reqSection' ::
Text ->
ValueSpec a ->
Text ->
SectionsSpec a
reqSection' :: Text -> ValueSpec a -> Text -> SectionsSpec a
reqSection' n :: Text
n w :: ValueSpec a
w i :: Text
i = PrimSectionSpec a -> SectionsSpec a
forall a. PrimSectionSpec a -> SectionsSpec a
primSectionsSpec (Text -> Text -> ValueSpec a -> PrimSectionSpec a
forall a. Text -> Text -> ValueSpec a -> PrimSectionSpec a
ReqSection Text
n Text
i ValueSpec a
w)
optSection ::
HasSpec a =>
Text ->
Text ->
SectionsSpec (Maybe a)
optSection :: Text -> Text -> SectionsSpec (Maybe a)
optSection n :: Text
n = Text -> ValueSpec a -> Text -> SectionsSpec (Maybe a)
forall a. Text -> ValueSpec a -> Text -> SectionsSpec (Maybe a)
optSection' Text
n ValueSpec a
forall a. HasSpec a => ValueSpec a
anySpec
optSection' ::
Text ->
ValueSpec a ->
Text ->
SectionsSpec (Maybe a)
optSection' :: Text -> ValueSpec a -> Text -> SectionsSpec (Maybe a)
optSection' n :: Text
n w :: ValueSpec a
w i :: Text
i = PrimSectionSpec (Maybe a) -> SectionsSpec (Maybe a)
forall a. PrimSectionSpec a -> SectionsSpec a
primSectionsSpec (Text -> Text -> ValueSpec a -> PrimSectionSpec (Maybe a)
forall a. Text -> Text -> ValueSpec a -> PrimSectionSpec (Maybe a)
OptSection Text
n Text
i ValueSpec a
w)