{-|
Module      : Toml.FromValue.ParseTable
Description : A type for matching keys out of a table
Copyright   : (c) Eric Mertens, 2023
License     : ISC
Maintainer  : emertens@gmail.com

This module provides utilities for matching key-value pairs
out of tables while building up application-specific values.

It will help generate warnings for unused keys, help select
between multiple possible keys, and emit location-specific
error messages when keys are unavailable.

This module provides the 'ParseTable' implementation, but
most of the basic functionality is exported directly from
"Toml.FromValue".

-}
module Toml.FromValue.ParseTable (
    -- * Base interface
    ParseTable,
    KeyAlt(..),
    pickKey,
    runParseTable,

    -- * Primitives
    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)

-- | A 'Matcher' that tracks a current set of unmatched key-value
-- pairs from a table.
--
-- Use 'Toml.FromValue.optKey' and 'Toml.FromValue.reqKey' to extract keys.
--
-- Use 'getTable' and 'setTable' to override the table and implement
-- other primitives.
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)

-- | Implemented in terms of 'fail' on 'Matcher'
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

-- | Lift a matcher into the current table parsing context.
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

-- | Run a 'ParseTable' computation with a given starting 'Table'.
-- Unused tables will generate a warning. To change this behavior
-- 'getTable' and 'setTable' can be used to discard or generate
-- error messages.
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))

-- | Return the remaining portion of the table being matched.
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

-- | Replace the remaining portion of the table being matched.
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

-- | Emit a warning at the current location.
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


-- | Key and value matching function
--
-- @since 1.2.0.0
data KeyAlt a
    = Key String (Value -> Matcher a) -- ^ pick alternative based on key match
    | Else (Matcher a) -- ^ default case when no previous cases matched

-- | Take the first option from a list of table keys and matcher functions.
-- This operation will commit to the first table key that matches. If the
-- associated matcher fails, only that error will be propagated and the
-- other alternatives will not be matched.
--
-- If no keys match, an error message is generated explaining which keys
-- would have been accepted.
--
-- This is provided as an alternative to chaining multiple
-- 'Toml.FromValue.reqKey' cases together with @('<|>')@ because that will
-- generate one error message for each unmatched alternative as well as
-- the error associate with the matched alternative.
--
-- @since 1.2.0.0
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 -- there's nothing a user can do here
                [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])