module Toml.FromValue.ParseTable (
ParseTable,
KeyAlt(..),
pickKey,
runParseTable,
liftMatcher,
warnTable,
setTable,
getTable,
) where
import Control.Applicative (Alternative, empty)
import Control.Monad (MonadPlus)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.State.Strict (StateT(..), get, put)
import Data.List (intercalate)
import Data.Map qualified as Map
import Toml.FromValue.Matcher (warning, Matcher, inKey)
import Toml.Pretty (prettySimpleKey)
import Toml.Value (Table, Value)
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
liftMatcher :: Matcher a -> ParseTable a
liftMatcher :: forall a. Matcher a -> ParseTable a
liftMatcher = 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
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
data KeyAlt a
= Key String (Value -> Matcher a)
| Else (Matcher a)
pickKey :: [KeyAlt a] -> ParseTable a
pickKey :: forall a. [KeyAlt a] -> ParseTable a
pickKey [KeyAlt a]
xs =
do Table
t <- ParseTable Table
getTable
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall {a}. Table -> KeyAlt a -> ParseTable a -> ParseTable a
f Table
t) forall a. ParseTable a
errCase [KeyAlt a]
xs
where
f :: Table -> KeyAlt a -> ParseTable a -> ParseTable a
f Table
t (Else Matcher a
m) ParseTable a
_ = forall a. Matcher a -> ParseTable a
liftMatcher Matcher a
m
f Table
t (Key String
k Value -> Matcher a
c) ParseTable a
continue =
case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
k Table
t of
Maybe Value
Nothing -> ParseTable a
continue
Just Value
v ->
do Table -> ParseTable ()
setTable forall a b. (a -> b) -> a -> b
$! forall k a. Ord k => k -> Map k a -> Map k a
Map.delete String
k Table
t
forall a. Matcher a -> ParseTable a
liftMatcher (forall a. String -> Matcher a -> Matcher a
inKey String
k (Value -> Matcher a
c Value
v))
errCase :: ParseTable a
errCase =
case [KeyAlt a]
xs of
[] -> forall (f :: * -> *) a. Alternative f => f a
empty
[Key String
k Value -> Matcher a
_] -> 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
k))
[KeyAlt a]
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"possible keys: " forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
", " [forall a. Show a => a -> String
show (forall a. String -> Doc a
prettySimpleKey String
k) | Key String
k Value -> Matcher a
_ <- [KeyAlt a]
xs])