module Toml.FromValue (
FromValue(..),
FromTable(..),
defaultTableFromValue,
Matcher,
Result(..),
runMatcher,
withScope,
warning,
ParseTable,
runParseTable,
optKey,
reqKey,
warnTable,
getTable,
setTable,
) where
import Control.Applicative (Alternative)
import Control.Monad (MonadPlus, zipWithM)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.State.Strict (StateT(..), put, get)
import Data.Int (Int8, Int16, Int32, Int64)
import Data.List (intercalate)
import Data.Map (Map)
import Data.Map qualified as Map
import Data.String (IsString (fromString))
import Data.Time (ZonedTime, LocalTime, Day, TimeOfDay)
import Data.Word (Word8, Word16, Word32, Word64)
import Numeric.Natural (Natural)
import Toml.FromValue.Matcher (Matcher, Result(..), runMatcher, withScope, warning)
import Toml.Pretty (prettySimpleKey, prettyValue)
import Toml.Value (Value(..), Table)
class FromValue a where
fromValue :: Value -> Matcher a
listFromValue :: Value -> Matcher [a]
listFromValue (Array [Value]
xs) = forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (\Int
i Value
v -> forall a. String -> Matcher a -> Matcher a
withScope (String
"[" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
i forall a. [a] -> [a] -> [a]
++ String
"]") (forall a. FromValue a => Value -> Matcher a
fromValue Value
v)) [Int
0::Int ..] [Value]
xs
listFromValue Value
v = forall a. String -> Value -> Matcher a
typeError String
"array" Value
v
class FromValue a => FromTable a where
fromTable :: Table -> Matcher a
instance (Ord k, IsString k, FromValue v) => FromTable (Map k v) where
fromTable :: Table -> Matcher (Map k v)
fromTable Table
t = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall {a} {a}.
(IsString a, FromValue a) =>
(String, Value) -> Matcher (a, a)
f (forall k a. Map k a -> [(k, a)]
Map.assocs Table
t)
where
f :: (String, Value) -> Matcher (a, a)
f (String
k,Value
v) = (,) (forall a. IsString a => String -> a
fromString String
k) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. String -> Matcher a -> Matcher a
withScope (Char
'.'forall a. a -> [a] -> [a]
:forall a. Show a => a -> String
show (forall a. String -> Doc a
prettySimpleKey String
k)) (forall a. FromValue a => Value -> Matcher a
fromValue Value
v)
instance (Ord k, IsString k, FromValue v) => FromValue (Map k v) where
fromValue :: Value -> Matcher (Map k v)
fromValue = forall a. FromTable a => Value -> Matcher a
defaultTableFromValue
defaultTableFromValue :: FromTable a => Value -> Matcher a
defaultTableFromValue :: forall a. FromTable a => Value -> Matcher a
defaultTableFromValue (Table Table
t) = forall a. FromTable a => Table -> Matcher a
fromTable Table
t
defaultTableFromValue Value
v = forall a. String -> Value -> Matcher a
typeError String
"table" Value
v
typeError :: String -> Value -> Matcher a
typeError :: forall a. String -> Value -> Matcher a
typeError String
wanted Value
got = forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Type error. wanted: " forall a. [a] -> [a] -> [a]
++ String
wanted forall a. [a] -> [a] -> [a]
++ String
" got: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Value -> TomlDoc
prettyValue Value
got))
instance FromValue Integer where
fromValue :: Value -> Matcher Integer
fromValue (Integer Integer
x) = forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
x
fromValue Value
v = 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 <- forall a. FromValue a => Value -> Matcher a
fromValue Value
v
if Integer
0 forall a. Ord a => a -> a -> Bool
<= Integer
i then
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Num a => Integer -> a
fromInteger Integer
i)
else
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 <- forall a. FromValue a => Value -> Matcher a
fromValue Value
v
if forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
minBound :: a) forall a. Ord a => a -> a -> Bool
<= Integer
i Bool -> Bool -> Bool
&& Integer
i forall a. Ord a => a -> a -> Bool
<= forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: a) then
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Num a => Integer -> a
fromInteger Integer
i)
else
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"integer out of range for " forall a. [a] -> [a] -> [a]
++ String
name)
instance FromValue Int where fromValue :: Value -> Matcher Int
fromValue = forall a. (Bounded a, Integral a) => String -> Value -> Matcher a
fromValueSized String
"Int"
instance FromValue Int8 where fromValue :: Value -> Matcher Int8
fromValue = forall a. (Bounded a, Integral a) => String -> Value -> Matcher a
fromValueSized String
"Int8"
instance FromValue Int16 where fromValue :: Value -> Matcher Int16
fromValue = forall a. (Bounded a, Integral a) => String -> Value -> Matcher a
fromValueSized String
"Int16"
instance FromValue Int32 where fromValue :: Value -> Matcher Int32
fromValue = forall a. (Bounded a, Integral a) => String -> Value -> Matcher a
fromValueSized String
"Int32"
instance FromValue Int64 where fromValue :: Value -> Matcher Int64
fromValue = forall a. (Bounded a, Integral a) => String -> Value -> Matcher a
fromValueSized String
"Int64"
instance FromValue Word where fromValue :: Value -> Matcher Word
fromValue = forall a. (Bounded a, Integral a) => String -> Value -> Matcher a
fromValueSized String
"Word"
instance FromValue Word8 where fromValue :: Value -> Matcher Word8
fromValue = forall a. (Bounded a, Integral a) => String -> Value -> Matcher a
fromValueSized String
"Word8"
instance FromValue Word16 where fromValue :: Value -> Matcher Word16
fromValue = forall a. (Bounded a, Integral a) => String -> Value -> Matcher a
fromValueSized String
"Word16"
instance FromValue Word32 where fromValue :: Value -> Matcher Word32
fromValue = forall a. (Bounded a, Integral a) => String -> Value -> Matcher a
fromValueSized String
"Word32"
instance FromValue Word64 where fromValue :: Value -> Matcher Word64
fromValue = 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]) = forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
c
fromValue Value
v = forall a. String -> Value -> Matcher a
typeError String
"character" Value
v
listFromValue :: Value -> Matcher String
listFromValue (String String
xs) = forall (f :: * -> *) a. Applicative f => a -> f a
pure String
xs
listFromValue Value
v = forall a. String -> Value -> Matcher a
typeError String
"string" Value
v
instance FromValue Double where
fromValue :: Value -> Matcher Double
fromValue (Float Double
x) = forall (f :: * -> *) a. Applicative f => a -> f a
pure Double
x
fromValue (Integer Integer
x) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Num a => Integer -> a
fromInteger Integer
x)
fromValue Value
v = forall a. String -> Value -> Matcher a
typeError String
"float" Value
v
instance FromValue Float where
fromValue :: Value -> Matcher Float
fromValue (Float Double
x) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
x)
fromValue (Integer Integer
x) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Num a => Integer -> a
fromInteger Integer
x)
fromValue Value
v = forall a. String -> Value -> Matcher a
typeError String
"float" Value
v
instance FromValue Bool where
fromValue :: Value -> Matcher Bool
fromValue (Bool Bool
x) = forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
x
fromValue Value
v = forall a. String -> Value -> Matcher a
typeError String
"boolean" Value
v
instance FromValue a => FromValue [a] where
fromValue :: Value -> Matcher [a]
fromValue = forall a. FromValue a => Value -> Matcher [a]
listFromValue
instance FromValue Day where
fromValue :: Value -> Matcher Day
fromValue (Day Day
x) = forall (f :: * -> *) a. Applicative f => a -> f a
pure Day
x
fromValue Value
v = forall a. String -> Value -> Matcher a
typeError String
"local date" Value
v
instance FromValue TimeOfDay where
fromValue :: Value -> Matcher TimeOfDay
fromValue (TimeOfDay TimeOfDay
x) = forall (f :: * -> *) a. Applicative f => a -> f a
pure TimeOfDay
x
fromValue Value
v = forall a. String -> Value -> Matcher a
typeError String
"local time" Value
v
instance FromValue ZonedTime where
fromValue :: Value -> Matcher ZonedTime
fromValue (ZonedTime ZonedTime
x) = forall (f :: * -> *) a. Applicative f => a -> f a
pure ZonedTime
x
fromValue Value
v = 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) = forall (f :: * -> *) a. Applicative f => a -> f a
pure LocalTime
x
fromValue Value
v = forall a. String -> Value -> Matcher a
typeError String
"local date-time" Value
v
instance FromValue Value where
fromValue :: Value -> Matcher Value
fromValue = forall (f :: * -> *) a. Applicative f => a -> f a
pure
newtype ParseTable a = ParseTable (StateT Table Matcher a)
deriving (forall a b. a -> ParseTable b -> ParseTable a
forall a b. (a -> b) -> ParseTable a -> ParseTable b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> ParseTable b -> ParseTable a
$c<$ :: forall a b. a -> ParseTable b -> ParseTable a
fmap :: forall a b. (a -> b) -> ParseTable a -> ParseTable b
$cfmap :: forall a b. (a -> b) -> ParseTable a -> ParseTable b
Functor, Functor ParseTable
forall a. a -> ParseTable a
forall a b. ParseTable a -> ParseTable b -> ParseTable a
forall a b. ParseTable a -> ParseTable b -> ParseTable b
forall a b. ParseTable (a -> b) -> ParseTable a -> ParseTable b
forall a b c.
(a -> b -> c) -> ParseTable a -> ParseTable b -> ParseTable c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. ParseTable a -> ParseTable b -> ParseTable a
$c<* :: forall a b. ParseTable a -> ParseTable b -> ParseTable a
*> :: forall a b. ParseTable a -> ParseTable b -> ParseTable b
$c*> :: forall a b. ParseTable a -> ParseTable b -> ParseTable b
liftA2 :: forall a b c.
(a -> b -> c) -> ParseTable a -> ParseTable b -> ParseTable c
$cliftA2 :: forall a b c.
(a -> b -> c) -> ParseTable a -> ParseTable b -> ParseTable c
<*> :: forall a b. ParseTable (a -> b) -> ParseTable a -> ParseTable b
$c<*> :: forall a b. ParseTable (a -> b) -> ParseTable a -> ParseTable b
pure :: forall a. a -> ParseTable a
$cpure :: forall a. a -> ParseTable a
Applicative, Applicative ParseTable
forall a. a -> ParseTable a
forall a b. ParseTable a -> ParseTable b -> ParseTable b
forall a b. ParseTable a -> (a -> ParseTable b) -> ParseTable b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> ParseTable a
$creturn :: forall a. a -> ParseTable a
>> :: forall a b. ParseTable a -> ParseTable b -> ParseTable b
$c>> :: forall a b. ParseTable a -> ParseTable b -> ParseTable b
>>= :: forall a b. ParseTable a -> (a -> ParseTable b) -> ParseTable b
$c>>= :: forall a b. ParseTable a -> (a -> ParseTable b) -> ParseTable b
Monad, Applicative ParseTable
forall a. ParseTable a
forall a. ParseTable a -> ParseTable [a]
forall a. ParseTable a -> ParseTable a -> ParseTable a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
many :: forall a. ParseTable a -> ParseTable [a]
$cmany :: forall a. ParseTable a -> ParseTable [a]
some :: forall a. ParseTable a -> ParseTable [a]
$csome :: forall a. ParseTable a -> ParseTable [a]
<|> :: forall a. ParseTable a -> ParseTable a -> ParseTable a
$c<|> :: forall a. ParseTable a -> ParseTable a -> ParseTable a
empty :: forall a. ParseTable a
$cempty :: forall a. ParseTable a
Alternative, Monad ParseTable
Alternative ParseTable
forall a. ParseTable a
forall a. ParseTable a -> ParseTable a -> ParseTable a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
mplus :: forall a. ParseTable a -> ParseTable a -> ParseTable a
$cmplus :: forall a. ParseTable a -> ParseTable a -> ParseTable a
mzero :: forall a. ParseTable a
$cmzero :: forall a. ParseTable a
MonadPlus)
instance MonadFail ParseTable where
fail :: forall a. String -> ParseTable a
fail = forall a. StateT Table Matcher a -> ParseTable a
ParseTable forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadFail m => String -> m a
fail
runParseTable :: ParseTable a -> Table -> Matcher a
runParseTable :: forall a. ParseTable a -> Table -> Matcher a
runParseTable (ParseTable StateT Table Matcher a
p) Table
t =
do (a
x, Table
t') <- forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT Table Matcher a
p Table
t
case forall k a. Map k a -> [k]
Map.keys Table
t' of
[] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
[String
k] -> a
x forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Matcher ()
warning (String
"Unexpected key: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a. String -> Doc a
prettySimpleKey String
k))
[String]
ks -> a
x forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Matcher ()
warning (String
"Unexpected keys: " forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. String -> Doc a
prettySimpleKey) [String]
ks))
getTable :: ParseTable Table
getTable :: ParseTable Table
getTable = forall a. StateT Table Matcher a -> ParseTable a
ParseTable forall (m :: * -> *) s. Monad m => StateT s m s
get
setTable :: Table -> ParseTable ()
setTable :: Table -> ParseTable ()
setTable = forall a. StateT Table Matcher a -> ParseTable a
ParseTable forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put
warnTable :: String -> ParseTable ()
warnTable :: String -> ParseTable ()
warnTable = forall a. StateT Table Matcher a -> ParseTable a
ParseTable forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Matcher ()
warning
optKey :: FromValue a => String -> ParseTable (Maybe a)
optKey :: forall a. FromValue a => String -> ParseTable (Maybe a)
optKey String
key = forall a. StateT Table Matcher a -> ParseTable a
ParseTable forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT \Table
t ->
case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
key Table
t of
Maybe Value
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Maybe a
Nothing, Table
t)
Just Value
v ->
do a
r <- forall a. String -> Matcher a -> Matcher a
withScope (Char
'.' forall a. a -> [a] -> [a]
: forall a. Show a => a -> String
show (forall a. String -> Doc a
prettySimpleKey String
key)) (forall a. FromValue a => Value -> Matcher a
fromValue Value
v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just a
r, forall k a. Ord k => k -> Map k a -> Map k a
Map.delete String
key Table
t)
reqKey :: FromValue a => String -> ParseTable a
reqKey :: forall a. FromValue a => String -> ParseTable a
reqKey String
key =
do Maybe a
mb <- forall a. FromValue a => String -> ParseTable (Maybe a)
optKey String
key
case Maybe a
mb of
Maybe a
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Missing key: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a. String -> Doc a
prettySimpleKey String
key))
Just a
v -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
v