{-# Language TypeFamilies #-}
module Toml.FromValue (
FromValue(..),
FromKey(..),
Matcher,
MatchMessage(..),
Result(..),
warning,
ParseTable,
runParseTable,
parseTableFromValue,
reqKey,
optKey,
reqKeyOf,
optKeyOf,
warnTable,
KeyAlt(..),
pickKey,
getTable,
setTable,
liftMatcher,
) where
import Control.Monad (zipWithM)
import Data.Int (Int8, Int16, Int32, Int64)
import Data.List.NonEmpty (NonEmpty)
import Data.List.NonEmpty qualified as NonEmpty
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Ratio (Ratio)
import Data.Sequence (Seq)
import Data.Sequence qualified as Seq
import Data.Text qualified
import Data.Text.Lazy qualified
import Data.Time (ZonedTime, LocalTime, Day, TimeOfDay)
import Data.Word (Word8, Word16, Word32, Word64)
import Numeric.Natural (Natural)
import Toml.FromValue.Matcher (Matcher, Result(..), MatchMessage(..), warning, inIndex, inKey)
import Toml.FromValue.ParseTable
import Toml.Value (Value(..))
class FromValue a where
fromValue :: Value -> Matcher a
listFromValue :: Value -> Matcher [a]
listFromValue (Array [Value]
xs) = (Int -> Value -> Matcher a) -> [Int] -> [Value] -> Matcher [a]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (\Int
i Value
v -> Int -> Matcher a -> Matcher a
forall a. Int -> Matcher a -> Matcher a
inIndex Int
i (Value -> Matcher a
forall a. FromValue a => Value -> Matcher a
fromValue Value
v)) [Int
0..] [Value]
xs
listFromValue Value
v = String -> Value -> Matcher [a]
forall a. String -> Value -> Matcher a
typeError String
"array" Value
v
instance (Ord k, FromKey k, FromValue v) => FromValue (Map k v) where
fromValue :: Value -> Matcher (Map k v)
fromValue (Table Table
t) = [(k, v)] -> Map k v
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(k, v)] -> Map k v) -> Matcher [(k, v)] -> Matcher (Map k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((String, Value) -> Matcher (k, v))
-> [(String, Value)] -> Matcher [(k, v)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (String, Value) -> Matcher (k, v)
forall {a} {a}.
(FromKey a, FromValue a) =>
(String, Value) -> Matcher (a, a)
f (Table -> [(String, Value)]
forall k a. Map k a -> [(k, a)]
Map.assocs Table
t)
where
f :: (String, Value) -> Matcher (a, a)
f (String
k,Value
v) = (,) (a -> a -> (a, a)) -> Matcher a -> Matcher (a -> (a, a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Matcher a
forall a. FromKey a => String -> Matcher a
fromKey String
k Matcher (a -> (a, a)) -> Matcher a -> Matcher (a, a)
forall a b. Matcher (a -> b) -> Matcher a -> Matcher b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Matcher a -> Matcher a
forall a. String -> Matcher a -> Matcher a
inKey String
k (Value -> Matcher a
forall a. FromValue a => Value -> Matcher a
fromValue Value
v)
fromValue Value
v = String -> Value -> Matcher (Map k v)
forall a. String -> Value -> Matcher a
typeError String
"table" Value
v
class FromKey a where
fromKey :: String -> Matcher a
instance a ~ Char => FromKey [a] where
fromKey :: String -> Matcher [a]
fromKey = String -> Matcher [a]
String -> Matcher String
forall a. a -> Matcher a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
instance FromKey Data.Text.Text where
fromKey :: String -> Matcher Text
fromKey = Text -> Matcher Text
forall a. a -> Matcher a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Matcher Text)
-> (String -> Text) -> String -> Matcher Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Data.Text.pack
instance FromKey Data.Text.Lazy.Text where
fromKey :: String -> Matcher Text
fromKey = Text -> Matcher Text
forall a. a -> Matcher a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Matcher Text)
-> (String -> Text) -> String -> Matcher Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Data.Text.Lazy.pack
typeError :: String -> Value -> Matcher a
typeError :: forall a. String -> Value -> Matcher a
typeError String
wanted Value
got = String -> Matcher a
forall a. String -> Matcher a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"type error. wanted: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
wanted String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" got: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Value -> String
valueType Value
got)
parseTableFromValue :: ParseTable a -> Value -> Matcher a
parseTableFromValue :: forall a. ParseTable a -> Value -> Matcher a
parseTableFromValue ParseTable a
p (Table Table
t) = ParseTable a -> Table -> Matcher a
forall a. ParseTable a -> Table -> Matcher a
runParseTable ParseTable a
p Table
t
parseTableFromValue ParseTable a
_ Value
v = String -> Value -> Matcher a
forall a. String -> Value -> Matcher a
typeError String
"table" Value
v
valueType :: Value -> String
valueType :: Value -> String
valueType = \case
Integer {} -> String
"integer"
Float {} -> String
"float"
Array {} -> String
"array"
Table {} -> String
"table"
Bool {} -> String
"boolean"
String {} -> String
"string"
TimeOfDay {} -> String
"local time"
LocalTime {} -> String
"local date-time"
Day {} -> String
"locate date"
ZonedTime {} -> String
"offset date-time"
instance FromValue Integer where
fromValue :: Value -> Matcher Integer
fromValue (Integer Integer
x) = Integer -> Matcher Integer
forall a. a -> Matcher a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
x
fromValue Value
v = String -> Value -> Matcher Integer
forall a. String -> Value -> Matcher a
typeError String
"integer" Value
v
instance FromValue Natural where
fromValue :: Value -> Matcher Natural
fromValue Value
v =
do Integer
i <- Value -> Matcher Integer
forall a. FromValue a => Value -> Matcher a
fromValue Value
v
if Integer
0 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
i then
Natural -> Matcher Natural
forall a. a -> Matcher a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Natural
forall a. Num a => Integer -> a
fromInteger Integer
i)
else
String -> Matcher Natural
forall a. String -> Matcher a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"integer out of range for Natural"
fromValueSized :: forall a. (Bounded a, Integral a) => String -> Value -> Matcher a
fromValueSized :: forall a. (Bounded a, Integral a) => String -> Value -> Matcher a
fromValueSized String
name Value
v =
do Integer
i <- Value -> Matcher Integer
forall a. FromValue a => Value -> Matcher a
fromValue Value
v
if a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
forall a. Bounded a => a
minBound :: a) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
i Bool -> Bool -> Bool
&& Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
forall a. Bounded a => a
maxBound :: a) then
a -> Matcher a
forall a. a -> Matcher a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
i)
else
String -> Matcher a
forall a. String -> Matcher a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"integer out of range for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name)
instance FromValue Int where fromValue :: Value -> Matcher Int
fromValue = String -> Value -> Matcher Int
forall a. (Bounded a, Integral a) => String -> Value -> Matcher a
fromValueSized String
"Int"
instance FromValue Int8 where fromValue :: Value -> Matcher Int8
fromValue = String -> Value -> Matcher Int8
forall a. (Bounded a, Integral a) => String -> Value -> Matcher a
fromValueSized String
"Int8"
instance FromValue Int16 where fromValue :: Value -> Matcher Int16
fromValue = String -> Value -> Matcher Int16
forall a. (Bounded a, Integral a) => String -> Value -> Matcher a
fromValueSized String
"Int16"
instance FromValue Int32 where fromValue :: Value -> Matcher Int32
fromValue = String -> Value -> Matcher Int32
forall a. (Bounded a, Integral a) => String -> Value -> Matcher a
fromValueSized String
"Int32"
instance FromValue Int64 where fromValue :: Value -> Matcher Int64
fromValue = String -> Value -> Matcher Int64
forall a. (Bounded a, Integral a) => String -> Value -> Matcher a
fromValueSized String
"Int64"
instance FromValue Word where fromValue :: Value -> Matcher Word
fromValue = String -> Value -> Matcher Word
forall a. (Bounded a, Integral a) => String -> Value -> Matcher a
fromValueSized String
"Word"
instance FromValue Word8 where fromValue :: Value -> Matcher Word8
fromValue = String -> Value -> Matcher Word8
forall a. (Bounded a, Integral a) => String -> Value -> Matcher a
fromValueSized String
"Word8"
instance FromValue Word16 where fromValue :: Value -> Matcher Word16
fromValue = String -> Value -> Matcher Word16
forall a. (Bounded a, Integral a) => String -> Value -> Matcher a
fromValueSized String
"Word16"
instance FromValue Word32 where fromValue :: Value -> Matcher Word32
fromValue = String -> Value -> Matcher Word32
forall a. (Bounded a, Integral a) => String -> Value -> Matcher a
fromValueSized String
"Word32"
instance FromValue Word64 where fromValue :: Value -> Matcher Word64
fromValue = String -> Value -> Matcher Word64
forall a. (Bounded a, Integral a) => String -> Value -> Matcher a
fromValueSized String
"Word64"
instance FromValue Char where
fromValue :: Value -> Matcher Char
fromValue (String [Char
c]) = Char -> Matcher Char
forall a. a -> Matcher a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
c
fromValue Value
v = String -> Value -> Matcher Char
forall a. String -> Value -> Matcher a
typeError String
"character" Value
v
listFromValue :: Value -> Matcher String
listFromValue (String String
xs) = String -> Matcher String
forall a. a -> Matcher a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
xs
listFromValue Value
v = String -> Value -> Matcher String
forall a. String -> Value -> Matcher a
typeError String
"string" Value
v
instance FromValue Data.Text.Text where
fromValue :: Value -> Matcher Text
fromValue Value
v = String -> Text
Data.Text.pack (String -> Text) -> Matcher String -> Matcher Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Matcher String
forall a. FromValue a => Value -> Matcher a
fromValue Value
v
instance FromValue Data.Text.Lazy.Text where
fromValue :: Value -> Matcher Text
fromValue Value
v = String -> Text
Data.Text.Lazy.pack (String -> Text) -> Matcher String -> Matcher Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Matcher String
forall a. FromValue a => Value -> Matcher a
fromValue Value
v
instance FromValue Double where
fromValue :: Value -> Matcher Double
fromValue (Float Double
x) = Double -> Matcher Double
forall a. a -> Matcher a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Double
x
fromValue (Integer Integer
x) = Double -> Matcher Double
forall a. a -> Matcher a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Double
forall a. Num a => Integer -> a
fromInteger Integer
x)
fromValue Value
v = String -> Value -> Matcher Double
forall a. String -> Value -> Matcher a
typeError String
"float" Value
v
instance FromValue Float where
fromValue :: Value -> Matcher Float
fromValue (Float Double
x) = Float -> Matcher Float
forall a. a -> Matcher a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
x)
fromValue (Integer Integer
x) = Float -> Matcher Float
forall a. a -> Matcher a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Float
forall a. Num a => Integer -> a
fromInteger Integer
x)
fromValue Value
v = String -> Value -> Matcher Float
forall a. String -> Value -> Matcher a
typeError String
"float" Value
v
instance Integral a => FromValue (Ratio a) where
fromValue :: Value -> Matcher (Ratio a)
fromValue (Float Double
x)
| Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
x Bool -> Bool -> Bool
|| Double -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Double
x = String -> Matcher (Ratio a)
forall a. String -> Matcher a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"finite float required"
| Bool
otherwise = Ratio a -> Matcher (Ratio a)
forall a. a -> Matcher a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double -> Ratio a
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
x)
fromValue (Integer Integer
x) = Ratio a -> Matcher (Ratio a)
forall a. a -> Matcher a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Ratio a
forall a. Num a => Integer -> a
fromInteger Integer
x)
fromValue Value
v = String -> Value -> Matcher (Ratio a)
forall a. String -> Value -> Matcher a
typeError String
"float" Value
v
instance FromValue a => FromValue (NonEmpty a) where
fromValue :: Value -> Matcher (NonEmpty a)
fromValue Value
v =
do [a]
xs <- Value -> Matcher [a]
forall a. FromValue a => Value -> Matcher a
fromValue Value
v
case [a] -> Maybe (NonEmpty a)
forall a. [a] -> Maybe (NonEmpty a)
NonEmpty.nonEmpty [a]
xs of
Maybe (NonEmpty a)
Nothing -> String -> Matcher (NonEmpty a)
forall a. String -> Matcher a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"non-empty list required"
Just NonEmpty a
ne -> NonEmpty a -> Matcher (NonEmpty a)
forall a. a -> Matcher a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NonEmpty a
ne
instance FromValue a => FromValue (Seq a) where
fromValue :: Value -> Matcher (Seq a)
fromValue Value
v = [a] -> Seq a
forall a. [a] -> Seq a
Seq.fromList ([a] -> Seq a) -> Matcher [a] -> Matcher (Seq a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Matcher [a]
forall a. FromValue a => Value -> Matcher a
fromValue Value
v
instance FromValue Bool where
fromValue :: Value -> Matcher Bool
fromValue (Bool Bool
x) = Bool -> Matcher Bool
forall a. a -> Matcher a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
x
fromValue Value
v = String -> Value -> Matcher Bool
forall a. String -> Value -> Matcher a
typeError String
"boolean" Value
v
instance FromValue a => FromValue [a] where
fromValue :: Value -> Matcher [a]
fromValue = Value -> Matcher [a]
forall a. FromValue a => Value -> Matcher [a]
listFromValue
instance FromValue Day where
fromValue :: Value -> Matcher Day
fromValue (Day Day
x) = Day -> Matcher Day
forall a. a -> Matcher a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Day
x
fromValue Value
v = String -> Value -> Matcher Day
forall a. String -> Value -> Matcher a
typeError String
"local date" Value
v
instance FromValue TimeOfDay where
fromValue :: Value -> Matcher TimeOfDay
fromValue (TimeOfDay TimeOfDay
x) = TimeOfDay -> Matcher TimeOfDay
forall a. a -> Matcher a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TimeOfDay
x
fromValue Value
v = String -> Value -> Matcher TimeOfDay
forall a. String -> Value -> Matcher a
typeError String
"local time" Value
v
instance FromValue ZonedTime where
fromValue :: Value -> Matcher ZonedTime
fromValue (ZonedTime ZonedTime
x) = ZonedTime -> Matcher ZonedTime
forall a. a -> Matcher a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ZonedTime
x
fromValue Value
v = String -> Value -> Matcher ZonedTime
forall a. String -> Value -> Matcher a
typeError String
"offset date-time" Value
v
instance FromValue LocalTime where
fromValue :: Value -> Matcher LocalTime
fromValue (LocalTime LocalTime
x) = LocalTime -> Matcher LocalTime
forall a. a -> Matcher a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LocalTime
x
fromValue Value
v = String -> Value -> Matcher LocalTime
forall a. String -> Value -> Matcher a
typeError String
"local date-time" Value
v
instance FromValue Value where
fromValue :: Value -> Matcher Value
fromValue = Value -> Matcher Value
forall a. a -> Matcher a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
optKey :: FromValue a => String -> ParseTable (Maybe a)
optKey :: forall a. FromValue a => String -> ParseTable (Maybe a)
optKey String
key = String -> (Value -> Matcher a) -> ParseTable (Maybe a)
forall a. String -> (Value -> Matcher a) -> ParseTable (Maybe a)
optKeyOf String
key Value -> Matcher a
forall a. FromValue a => Value -> Matcher a
fromValue
reqKey :: FromValue a => String -> ParseTable a
reqKey :: forall a. FromValue a => String -> ParseTable a
reqKey String
key = String -> (Value -> Matcher a) -> ParseTable a
forall a. String -> (Value -> Matcher a) -> ParseTable a
reqKeyOf String
key Value -> Matcher a
forall a. FromValue a => Value -> Matcher a
fromValue
optKeyOf ::
String ->
(Value -> Matcher a) ->
ParseTable (Maybe a)
optKeyOf :: forall a. String -> (Value -> Matcher a) -> ParseTable (Maybe a)
optKeyOf String
key Value -> Matcher a
k = [KeyAlt (Maybe a)] -> ParseTable (Maybe a)
forall a. [KeyAlt a] -> ParseTable a
pickKey [String -> (Value -> Matcher (Maybe a)) -> KeyAlt (Maybe a)
forall a. String -> (Value -> Matcher a) -> KeyAlt a
Key String
key ((a -> Maybe a) -> Matcher a -> Matcher (Maybe a)
forall a b. (a -> b) -> Matcher a -> Matcher b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just (Matcher a -> Matcher (Maybe a))
-> (Value -> Matcher a) -> Value -> Matcher (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Matcher a
k), Matcher (Maybe a) -> KeyAlt (Maybe a)
forall a. Matcher a -> KeyAlt a
Else (Maybe a -> Matcher (Maybe a)
forall a. a -> Matcher a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing)]
reqKeyOf ::
String ->
(Value -> Matcher a) ->
ParseTable a
reqKeyOf :: forall a. String -> (Value -> Matcher a) -> ParseTable a
reqKeyOf String
key Value -> Matcher a
k = [KeyAlt a] -> ParseTable a
forall a. [KeyAlt a] -> ParseTable a
pickKey [String -> (Value -> Matcher a) -> KeyAlt a
forall a. String -> (Value -> Matcher a) -> KeyAlt a
Key String
key Value -> Matcher a
k]