    {-|
    Module      : Toml.Schema.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.

    -}
    module Toml.Schema.ParseTable (
        -- * Base interface
        ParseTable,
        KeyAlt(..),
        pickKey,
        parseTable,

        -- * Primitives
        liftMatcher,
        warnTable,
        warnTableAt,
        failTableAt,
        setTable,
        getTable,
        ) where

    import Control.Applicative (Alternative, empty)
    import Control.Monad (MonadPlus)
    import Control.Monad.Trans.Class (lift)
    import Control.Monad.Trans.Reader (ReaderT(..), ask)
    import Control.Monad.Trans.State.Strict (StateT(..), get, put)
    import Data.Foldable (for_)
    import Data.List (intercalate)
    import Data.Map qualified as Map
    import Data.Text (Text)
    import Toml.Schema.Matcher (Matcher, inKey, failAt, warn, warnAt)
    import Toml.Semantics (Table'(..), Value')
    import Toml.Pretty

    -- | Parser that tracks a current set of unmatched key-value
    -- pairs from a table.
    --
    -- Use 'Toml.Schema.optKey' and 'Toml.Schema.reqKey' to extract keys.
    --
    -- Use 'getTable' and 'setTable' to override the table and implement
    -- other primitives.
    newtype ParseTable l a = ParseTable (ReaderT l (StateT (Table' l) (Matcher l)) a)
        deriving ((forall a b. (a -> b) -> ParseTable l a -> ParseTable l b)
    -> (forall a b. a -> ParseTable l b -> ParseTable l a)
    -> Functor (ParseTable l)
    forall a b. a -> ParseTable l b -> ParseTable l a
    forall a b. (a -> b) -> ParseTable l a -> ParseTable l b
    forall l a b. a -> ParseTable l b -> ParseTable l a
    forall l a b. (a -> b) -> ParseTable l a -> ParseTable l b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    $cfmap :: forall l a b. (a -> b) -> ParseTable l a -> ParseTable l b
    fmap :: forall a b. (a -> b) -> ParseTable l a -> ParseTable l b
    $c<$ :: forall l a b. a -> ParseTable l b -> ParseTable l a
    <$ :: forall a b. a -> ParseTable l b -> ParseTable l a
    Functor, Functor (ParseTable l)
    Functor (ParseTable l) =>
    (forall a. a -> ParseTable l a)
    -> (forall a b.
        ParseTable l (a -> b) -> ParseTable l a -> ParseTable l b)
    -> (forall a b c.
        (a -> b -> c)
        -> ParseTable l a -> ParseTable l b -> ParseTable l c)
    -> (forall a b. ParseTable l a -> ParseTable l b -> ParseTable l b)
    -> (forall a b. ParseTable l a -> ParseTable l b -> ParseTable l a)
    -> Applicative (ParseTable l)
    forall l. Functor (ParseTable l)
    forall a. a -> ParseTable l a
    forall l a. a -> ParseTable l a
    forall a b. ParseTable l a -> ParseTable l b -> ParseTable l a
    forall a b. ParseTable l a -> ParseTable l b -> ParseTable l b
    forall a b.
    ParseTable l (a -> b) -> ParseTable l a -> ParseTable l b
    forall l a b. ParseTable l a -> ParseTable l b -> ParseTable l a
    forall l a b. ParseTable l a -> ParseTable l b -> ParseTable l b
    forall l a b.
    ParseTable l (a -> b) -> ParseTable l a -> ParseTable l b
    forall a b c.
    (a -> b -> c) -> ParseTable l a -> ParseTable l b -> ParseTable l c
    forall l a b c.
    (a -> b -> c) -> ParseTable l a -> ParseTable l b -> ParseTable l 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
    $cpure :: forall l a. a -> ParseTable l a
    pure :: forall a. a -> ParseTable l a
    $c<*> :: forall l a b.
    ParseTable l (a -> b) -> ParseTable l a -> ParseTable l b
    <*> :: forall a b.
    ParseTable l (a -> b) -> ParseTable l a -> ParseTable l b
    $cliftA2 :: forall l a b c.
    (a -> b -> c) -> ParseTable l a -> ParseTable l b -> ParseTable l c
    liftA2 :: forall a b c.
    (a -> b -> c) -> ParseTable l a -> ParseTable l b -> ParseTable l c
    $c*> :: forall l a b. ParseTable l a -> ParseTable l b -> ParseTable l b
    *> :: forall a b. ParseTable l a -> ParseTable l b -> ParseTable l b
    $c<* :: forall l a b. ParseTable l a -> ParseTable l b -> ParseTable l a
    <* :: forall a b. ParseTable l a -> ParseTable l b -> ParseTable l a
    Applicative, Applicative (ParseTable l)
    Applicative (ParseTable l) =>
    (forall a b.
     ParseTable l a -> (a -> ParseTable l b) -> ParseTable l b)
    -> (forall a b. ParseTable l a -> ParseTable l b -> ParseTable l b)
    -> (forall a. a -> ParseTable l a)
    -> Monad (ParseTable l)
    forall l. Applicative (ParseTable l)
    forall a. a -> ParseTable l a
    forall l a. a -> ParseTable l a
    forall a b. ParseTable l a -> ParseTable l b -> ParseTable l b
    forall a b.
    ParseTable l a -> (a -> ParseTable l b) -> ParseTable l b
    forall l a b. ParseTable l a -> ParseTable l b -> ParseTable l b
    forall l a b.
    ParseTable l a -> (a -> ParseTable l b) -> ParseTable l 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
    $c>>= :: forall l a b.
    ParseTable l a -> (a -> ParseTable l b) -> ParseTable l b
    >>= :: forall a b.
    ParseTable l a -> (a -> ParseTable l b) -> ParseTable l b
    $c>> :: forall l a b. ParseTable l a -> ParseTable l b -> ParseTable l b
    >> :: forall a b. ParseTable l a -> ParseTable l b -> ParseTable l b
    $creturn :: forall l a. a -> ParseTable l a
    return :: forall a. a -> ParseTable l a
    Monad, Applicative (ParseTable l)
    Applicative (ParseTable l) =>
    (forall a. ParseTable l a)
    -> (forall a. ParseTable l a -> ParseTable l a -> ParseTable l a)
    -> (forall a. ParseTable l a -> ParseTable l [a])
    -> (forall a. ParseTable l a -> ParseTable l [a])
    -> Alternative (ParseTable l)
    forall l. Applicative (ParseTable l)
    forall a. ParseTable l a
    forall a. ParseTable l a -> ParseTable l [a]
    forall a. ParseTable l a -> ParseTable l a -> ParseTable l a
    forall l a. ParseTable l a
    forall l a. ParseTable l a -> ParseTable l [a]
    forall l a. ParseTable l a -> ParseTable l a -> ParseTable l 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
    $cempty :: forall l a. ParseTable l a
    empty :: forall a. ParseTable l a
    $c<|> :: forall l a. ParseTable l a -> ParseTable l a -> ParseTable l a
    <|> :: forall a. ParseTable l a -> ParseTable l a -> ParseTable l a
    $csome :: forall l a. ParseTable l a -> ParseTable l [a]
    some :: forall a. ParseTable l a -> ParseTable l [a]
    $cmany :: forall l a. ParseTable l a -> ParseTable l [a]
    many :: forall a. ParseTable l a -> ParseTable l [a]
    Alternative, Monad (ParseTable l)
    Alternative (ParseTable l)
    (Alternative (ParseTable l), Monad (ParseTable l)) =>
    (forall a. ParseTable l a)
    -> (forall a. ParseTable l a -> ParseTable l a -> ParseTable l a)
    -> MonadPlus (ParseTable l)
    forall l. Monad (ParseTable l)
    forall l. Alternative (ParseTable l)
    forall a. ParseTable l a
    forall a. ParseTable l a -> ParseTable l a -> ParseTable l a
    forall l a. ParseTable l a
    forall l a. ParseTable l a -> ParseTable l a -> ParseTable l a
    forall (m :: * -> *).
    (Alternative m, Monad m) =>
    (forall a. m a) -> (forall a. m a -> m a -> m a) -> MonadPlus m
    $cmzero :: forall l a. ParseTable l a
    mzero :: forall a. ParseTable l a
    $cmplus :: forall l a. ParseTable l a -> ParseTable l a -> ParseTable l a
    mplus :: forall a. ParseTable l a -> ParseTable l a -> ParseTable l a
    MonadPlus)

    -- | Implemented in terms of 'fail' on 'Matcher'
    instance MonadFail (ParseTable l) where
        fail :: forall a. String -> ParseTable l a
    fail = ReaderT l (StateT (Table' l) (Matcher l)) a -> ParseTable l a
    forall l a.
    ReaderT l (StateT (Table' l) (Matcher l)) a -> ParseTable l a
    ParseTable (ReaderT l (StateT (Table' l) (Matcher l)) a -> ParseTable l a)
    -> (String -> ReaderT l (StateT (Table' l) (Matcher l)) a)
    -> String
    -> ParseTable l a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ReaderT l (StateT (Table' l) (Matcher l)) a
    forall a. String -> ReaderT l (StateT (Table' l) (Matcher l)) a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail

    -- | Lift a matcher into the current table parsing context.
    liftMatcher :: Matcher l a -> ParseTable l a
    liftMatcher :: forall l a. Matcher l a -> ParseTable l a
    liftMatcher = ReaderT l (StateT (Table' l) (Matcher l)) a -> ParseTable l a
    forall l a.
    ReaderT l (StateT (Table' l) (Matcher l)) a -> ParseTable l a
    ParseTable (ReaderT l (StateT (Table' l) (Matcher l)) a -> ParseTable l a)
    -> (Matcher l a -> ReaderT l (StateT (Table' l) (Matcher l)) a)
    -> Matcher l a
    -> ParseTable l a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StateT (Table' l) (Matcher l) a
    -> ReaderT l (StateT (Table' l) (Matcher l)) a
    forall (m :: * -> *) a. Monad m => m a -> ReaderT l m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (StateT (Table' l) (Matcher l) a
     -> ReaderT l (StateT (Table' l) (Matcher l)) a)
    -> (Matcher l a -> StateT (Table' l) (Matcher l) a)
    -> Matcher l a
    -> ReaderT l (StateT (Table' l) (Matcher l)) a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Matcher l a -> StateT (Table' l) (Matcher l) a
    forall (m :: * -> *) a. Monad m => m a -> StateT (Table' l) m a
    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.
    parseTable :: ParseTable l a -> l -> Table' l -> Matcher l a
    parseTable :: forall l a. ParseTable l a -> l -> Table' l -> Matcher l a
    parseTable (ParseTable ReaderT l (StateT (Table' l) (Matcher l)) a
    p) l
    l Table' l
    t =
     do (x, MkTable t') <- StateT (Table' l) (Matcher l) a
    -> Table' l -> Matcher l (a, Table' l)
    forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
    runStateT (ReaderT l (StateT (Table' l) (Matcher l)) a
    -> l -> StateT (Table' l) (Matcher l) a
    forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
    runReaderT ReaderT l (StateT (Table' l) (Matcher l)) a
    p l
    l) Table' l
    t
        for_ (Map.assocs t') \(Text
    k, (l
    a, Value' l
    _)) ->
            l -> String -> Matcher l ()
    forall l. l -> String -> Matcher l ()
    warnAt l
    a (String
    "unexpected key: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Doc (ZonkAny 0) -> String
    forall a. Show a => a -> String
    show (Text -> Doc (ZonkAny 0)
    forall a. Text -> Doc a
    prettySimpleKey Text
    k))
        pure x

    -- | Return the remaining portion of the table being matched.
    getTable :: ParseTable l (Table' l)
    getTable :: forall l. ParseTable l (Table' l)
    getTable = ReaderT l (StateT (Table' l) (Matcher l)) (Table' l)
    -> ParseTable l (Table' l)
    forall l a.
    ReaderT l (StateT (Table' l) (Matcher l)) a -> ParseTable l a
    ParseTable (StateT (Table' l) (Matcher l) (Table' l)
    -> ReaderT l (StateT (Table' l) (Matcher l)) (Table' l)
    forall (m :: * -> *) a. Monad m => m a -> ReaderT l m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift StateT (Table' l) (Matcher l) (Table' l)
    forall (m :: * -> *) s. Monad m => StateT s m s
    get)

    -- | Replace the remaining portion of the table being matched.
    setTable :: Table' l -> ParseTable l ()
    setTable :: forall l. Table' l -> ParseTable l ()
    setTable = ReaderT l (StateT (Table' l) (Matcher l)) () -> ParseTable l ()
    forall l a.
    ReaderT l (StateT (Table' l) (Matcher l)) a -> ParseTable l a
    ParseTable (ReaderT l (StateT (Table' l) (Matcher l)) () -> ParseTable l ())
    -> (Table' l -> ReaderT l (StateT (Table' l) (Matcher l)) ())
    -> Table' l
    -> ParseTable l ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StateT (Table' l) (Matcher l) ()
    -> ReaderT l (StateT (Table' l) (Matcher l)) ()
    forall (m :: * -> *) a. Monad m => m a -> ReaderT l m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (StateT (Table' l) (Matcher l) ()
     -> ReaderT l (StateT (Table' l) (Matcher l)) ())
    -> (Table' l -> StateT (Table' l) (Matcher l) ())
    -> Table' l
    -> ReaderT l (StateT (Table' l) (Matcher l)) ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Table' l -> StateT (Table' l) (Matcher l) ()
    forall (m :: * -> *) s. Monad m => s -> StateT s m ()
    put

    -- | Emit a warning without an annotation.
    warnTable :: String -> ParseTable l ()
    warnTable :: forall l. String -> ParseTable l ()
    warnTable = Matcher l () -> ParseTable l ()
    forall l a. Matcher l a -> ParseTable l a
    liftMatcher (Matcher l () -> ParseTable l ())
    -> (String -> Matcher l ()) -> String -> ParseTable l ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Matcher l ()
    forall a. String -> Matcher a ()
    warn

    -- | Emit a warning with the given annotation.
    warnTableAt :: l -> String -> ParseTable l ()
    warnTableAt :: forall l. l -> String -> ParseTable l ()
    warnTableAt l
    l = Matcher l () -> ParseTable l ()
    forall l a. Matcher l a -> ParseTable l a
    liftMatcher (Matcher l () -> ParseTable l ())
    -> (String -> Matcher l ()) -> String -> ParseTable l ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . l -> String -> Matcher l ()
    forall l. l -> String -> Matcher l ()
    warnAt l
    l

    -- | Abort the current table matching with an error message at the given annotation.
    failTableAt :: l -> String -> ParseTable l a
    failTableAt :: forall l a. l -> String -> ParseTable l a
    failTableAt l
    l = Matcher l a -> ParseTable l a
    forall l a. Matcher l a -> ParseTable l a
    liftMatcher (Matcher l a -> ParseTable l a)
    -> (String -> Matcher l a) -> String -> ParseTable l a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . l -> String -> Matcher l a
    forall l a. l -> String -> Matcher l a
    failAt l
    l

    -- | Key and value matching function
    data KeyAlt l a
        = Key Text (Value' l -> Matcher l a) -- ^ pick alternative based on key match
        | Else (Matcher l 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.Schema.reqKey' cases together with 'Control.Applicative.Alternative'
    -- which will fall-through as a result of any failure to the next case.
    pickKey :: [KeyAlt l a] -> ParseTable l a
    pickKey :: forall l a. [KeyAlt l a] -> ParseTable l a
    pickKey [KeyAlt l a]
    xs =
     do MkTable t <- ParseTable l (Table' l)
    forall l. ParseTable l (Table' l)
    getTable
        foldr (f t) errCase xs
        where
            f :: Map Text (l, Value' l)
    -> KeyAlt l a -> ParseTable l a -> ParseTable l a
    f Map Text (l, Value' l)
    _ (Else Matcher l a
    m) ParseTable l a
    _ = Matcher l a -> ParseTable l a
    forall l a. Matcher l a -> ParseTable l a
    liftMatcher Matcher l a
    m
            f Map Text (l, Value' l)
    t (Key Text
    k Value' l -> Matcher l a
    c) ParseTable l a
    continue =
                case Text -> Map Text (l, Value' l) -> Maybe (l, Value' l)
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup Text
    k Map Text (l, Value' l)
    t of
                    Maybe (l, Value' l)
    Nothing -> ParseTable l a
    continue
                    Just (l
    _, Value' l
    v) ->
                     do Table' l -> ParseTable l ()
    forall l. Table' l -> ParseTable l ()
    setTable (Table' l -> ParseTable l ()) -> Table' l -> ParseTable l ()
    forall a b. (a -> b) -> a -> b
    $! Map Text (l, Value' l) -> Table' l
    forall a. Map Text (a, Value' a) -> Table' a
    MkTable (Text -> Map Text (l, Value' l) -> Map Text (l, Value' l)
    forall k a. Ord k => k -> Map k a -> Map k a
    Map.delete Text
    k Map Text (l, Value' l)
    t)
                        Matcher l a -> ParseTable l a
    forall l a. Matcher l a -> ParseTable l a
    liftMatcher (Text -> Matcher l a -> Matcher l a
    forall l a. Text -> Matcher l a -> Matcher l a
    inKey Text
    k (Value' l -> Matcher l a
    c Value' l
    v))

            errCase :: ParseTable a b
    errCase =
             do l <- ReaderT a (StateT (Table' a) (Matcher a)) a -> ParseTable a a
    forall l a.
    ReaderT l (StateT (Table' l) (Matcher l)) a -> ParseTable l a
    ParseTable ReaderT a (StateT (Table' a) (Matcher a)) a
    forall (m :: * -> *) r. Monad m => ReaderT r m r
    ask
                case xs of
                    []        -> ParseTable a b
    forall a. ParseTable a a
    forall (f :: * -> *) a. Alternative f => f a
    empty -- there's nothing a user can do here
                    [Key Text
    k Value' l -> Matcher l a
    _] -> a -> String -> ParseTable a b
    forall l a. l -> String -> ParseTable l a
    failTableAt a
    l (String
    "missing key: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Doc (ZonkAny 1) -> String
    forall a. Show a => a -> String
    show (Text -> Doc (ZonkAny 1)
    forall a. Text -> Doc a
    prettySimpleKey Text
    k))
                    [KeyAlt l a]
    _         -> a -> String -> ParseTable a b
    forall l a. l -> String -> ParseTable l a
    failTableAt a
    l (String
    "possible keys: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    ", " [Doc (ZonkAny 2) -> String
    forall a. Show a => a -> String
    show (Text -> Doc (ZonkAny 2)
    forall a. Text -> Doc a
    prettySimpleKey Text
    k) | Key Text
    k Value' l -> Matcher l a
    _ <- [KeyAlt l a]
    xs])