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 (a -> ParseTable b -> ParseTable a
(a -> b) -> ParseTable a -> ParseTable b
(forall a b. (a -> b) -> ParseTable a -> ParseTable b)
-> (forall a b. a -> ParseTable b -> ParseTable a)
-> Functor ParseTable
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
<$ :: a -> ParseTable b -> ParseTable a
$c<$ :: forall a b. a -> ParseTable b -> ParseTable a
fmap :: (a -> b) -> ParseTable a -> ParseTable b
$cfmap :: forall a b. (a -> b) -> ParseTable a -> ParseTable b
Functor, Functor ParseTable
a -> ParseTable a
Functor ParseTable
-> (forall a. a -> ParseTable a)
-> (forall a b.
ParseTable (a -> b) -> ParseTable a -> ParseTable b)
-> (forall a b c.
(a -> b -> c) -> ParseTable a -> ParseTable b -> ParseTable c)
-> (forall a b. ParseTable a -> ParseTable b -> ParseTable b)
-> (forall a b. ParseTable a -> ParseTable b -> ParseTable a)
-> Applicative ParseTable
ParseTable a -> ParseTable b -> ParseTable b
ParseTable a -> ParseTable b -> ParseTable a
ParseTable (a -> b) -> ParseTable a -> ParseTable b
(a -> b -> c) -> ParseTable a -> ParseTable b -> ParseTable c
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
<* :: ParseTable a -> ParseTable b -> ParseTable a
$c<* :: forall a b. ParseTable a -> ParseTable b -> ParseTable a
*> :: ParseTable a -> ParseTable b -> ParseTable b
$c*> :: forall a b. ParseTable a -> ParseTable b -> ParseTable b
liftA2 :: (a -> b -> c) -> ParseTable a -> ParseTable b -> ParseTable c
$cliftA2 :: forall a b c.
(a -> b -> c) -> ParseTable a -> ParseTable b -> ParseTable c
<*> :: ParseTable (a -> b) -> ParseTable a -> ParseTable b
$c<*> :: forall a b. ParseTable (a -> b) -> ParseTable a -> ParseTable b
pure :: a -> ParseTable a
$cpure :: forall a. a -> ParseTable a
$cp1Applicative :: Functor ParseTable
Applicative, Applicative ParseTable
a -> ParseTable a
Applicative ParseTable
-> (forall a b.
ParseTable a -> (a -> ParseTable b) -> ParseTable b)
-> (forall a b. ParseTable a -> ParseTable b -> ParseTable b)
-> (forall a. a -> ParseTable a)
-> Monad ParseTable
ParseTable a -> (a -> ParseTable b) -> ParseTable b
ParseTable a -> ParseTable b -> ParseTable b
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 :: a -> ParseTable a
$creturn :: forall a. a -> ParseTable a
>> :: ParseTable a -> ParseTable b -> ParseTable b
$c>> :: forall a b. ParseTable a -> ParseTable b -> ParseTable b
>>= :: ParseTable a -> (a -> ParseTable b) -> ParseTable b
$c>>= :: forall a b. ParseTable a -> (a -> ParseTable b) -> ParseTable b
$cp1Monad :: Applicative ParseTable
Monad, Applicative ParseTable
ParseTable a
Applicative ParseTable
-> (forall a. ParseTable a)
-> (forall a. ParseTable a -> ParseTable a -> ParseTable a)
-> (forall a. ParseTable a -> ParseTable [a])
-> (forall a. ParseTable a -> ParseTable [a])
-> Alternative ParseTable
ParseTable a -> ParseTable a -> ParseTable a
ParseTable a -> ParseTable [a]
ParseTable a -> ParseTable [a]
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 :: ParseTable a -> ParseTable [a]
$cmany :: forall a. ParseTable a -> ParseTable [a]
some :: ParseTable a -> ParseTable [a]
$csome :: forall a. ParseTable a -> ParseTable [a]
<|> :: ParseTable a -> ParseTable a -> ParseTable a
$c<|> :: forall a. ParseTable a -> ParseTable a -> ParseTable a
empty :: ParseTable a
$cempty :: forall a. ParseTable a
$cp1Alternative :: Applicative ParseTable
Alternative, Monad ParseTable
Alternative ParseTable
ParseTable a
Alternative ParseTable
-> Monad ParseTable
-> (forall a. ParseTable a)
-> (forall a. ParseTable a -> ParseTable a -> ParseTable a)
-> MonadPlus ParseTable
ParseTable a -> ParseTable a -> ParseTable a
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 :: ParseTable a -> ParseTable a -> ParseTable a
$cmplus :: forall a. ParseTable a -> ParseTable a -> ParseTable a
mzero :: ParseTable a
$cmzero :: forall a. ParseTable a
$cp2MonadPlus :: Monad ParseTable
$cp1MonadPlus :: Alternative ParseTable
MonadPlus)
instance MonadFail ParseTable where
fail :: String -> ParseTable a
fail = StateT Table Matcher a -> ParseTable a
forall a. StateT Table Matcher a -> ParseTable a
ParseTable (StateT Table Matcher a -> ParseTable a)
-> (String -> StateT Table Matcher a) -> String -> ParseTable a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StateT Table Matcher a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
liftMatcher :: Matcher a -> ParseTable a
liftMatcher :: Matcher a -> ParseTable a
liftMatcher = StateT Table Matcher a -> ParseTable a
forall a. StateT Table Matcher a -> ParseTable a
ParseTable (StateT Table Matcher a -> ParseTable a)
-> (Matcher a -> StateT Table Matcher a)
-> Matcher a
-> ParseTable a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Matcher a -> StateT Table Matcher a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
runParseTable :: ParseTable a -> Table -> Matcher a
runParseTable :: ParseTable a -> Table -> Matcher a
runParseTable (ParseTable StateT Table Matcher a
p) Table
t =
do (a
x, Table
t') <- StateT Table Matcher a -> Table -> Matcher (a, Table)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT Table Matcher a
p Table
t
case Table -> [String]
forall k a. Map k a -> [k]
Map.keys Table
t' of
[] -> a -> Matcher a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
[String
k] -> a
x a -> Matcher () -> Matcher a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Matcher ()
warning (String
"unexpected key: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Doc Any -> String
forall a. Show a => a -> String
show (String -> Doc Any
forall a. String -> Doc a
prettySimpleKey String
k))
[String]
ks -> a
x a -> Matcher () -> Matcher a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Matcher ()
warning (String
"unexpected keys: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Doc Any -> String
forall a. Show a => a -> String
show (Doc Any -> String) -> (String -> Doc Any) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc Any
forall a. String -> Doc a
prettySimpleKey) [String]
ks))
getTable :: ParseTable Table
getTable :: ParseTable Table
getTable = StateT Table Matcher Table -> ParseTable Table
forall a. StateT Table Matcher a -> ParseTable a
ParseTable StateT Table Matcher Table
forall (m :: * -> *) s. Monad m => StateT s m s
get
setTable :: Table -> ParseTable ()
setTable :: Table -> ParseTable ()
setTable = StateT Table Matcher () -> ParseTable ()
forall a. StateT Table Matcher a -> ParseTable a
ParseTable (StateT Table Matcher () -> ParseTable ())
-> (Table -> StateT Table Matcher ()) -> Table -> ParseTable ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Table -> StateT Table Matcher ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put
warnTable :: String -> ParseTable ()
warnTable :: String -> ParseTable ()
warnTable = StateT Table Matcher () -> ParseTable ()
forall a. StateT Table Matcher a -> ParseTable a
ParseTable (StateT Table Matcher () -> ParseTable ())
-> (String -> StateT Table Matcher ()) -> String -> ParseTable ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Matcher () -> StateT Table Matcher ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Matcher () -> StateT Table Matcher ())
-> (String -> Matcher ()) -> String -> StateT Table Matcher ()
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 :: [KeyAlt a] -> ParseTable a
pickKey [KeyAlt a]
xs =
do Table
t <- ParseTable Table
getTable
(KeyAlt a -> ParseTable a -> ParseTable a)
-> ParseTable a -> [KeyAlt a] -> ParseTable a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Table -> KeyAlt a -> ParseTable a -> ParseTable a
forall a. Table -> KeyAlt a -> ParseTable a -> ParseTable a
f Table
t) ParseTable a
forall a. ParseTable a
errCase [KeyAlt a]
xs
where
f :: Table -> KeyAlt a -> ParseTable a -> ParseTable a
f Table
_ (Else Matcher a
m) ParseTable a
_ = Matcher a -> 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 String -> Table -> Maybe Value
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 (Table -> ParseTable ()) -> Table -> ParseTable ()
forall a b. (a -> b) -> a -> b
$! String -> Table -> Table
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete String
k Table
t
Matcher a -> ParseTable a
forall a. Matcher a -> ParseTable a
liftMatcher (String -> Matcher a -> Matcher a
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
[] -> ParseTable a
forall (f :: * -> *) a. Alternative f => f a
empty
[Key String
k Value -> Matcher a
_] -> String -> ParseTable a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"missing key: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Doc Any -> String
forall a. Show a => a -> String
show (String -> Doc Any
forall a. String -> Doc a
prettySimpleKey String
k))
[KeyAlt a]
_ -> String -> ParseTable a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"possible keys: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " [Doc Any -> String
forall a. Show a => a -> String
show (String -> Doc Any
forall a. String -> Doc a
prettySimpleKey String
k) | Key String
k Value -> Matcher a
_ <- [KeyAlt a]
xs])