{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE ImpredicativeTypes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE OverloadedStrings #-}

-- | A trivial source reading from a @Map Key Value@, only useful as a demonstration or for tests.
module Conftrack.Source.Trivial where

import Conftrack.Value (Key, Value(..), ConfigError(..))
import Conftrack.Source (SomeSource(..), ConfigSource (..))

import Control.Monad.State (get, modify, MonadState (..))
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Data.Function ((&))
import qualified Data.Text as T


newtype Trivial = Trivial (Map Key Value)

mkTrivialSource :: [(Key, Value)] -> SomeSource
mkTrivialSource :: [(Key, Value)] -> SomeSource
mkTrivialSource [(Key, Value)]
pairs = (Trivial, SourceState Trivial) -> SomeSource
forall source.
ConfigSource source =>
(source, SourceState source) -> SomeSource
SomeSource (Trivial
source, [])
  where source :: Trivial
source = Map Key Value -> Trivial
Trivial ([(Key, Value)] -> Map Key Value
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Key, Value)]
pairs)

instance ConfigSource Trivial where
  type SourceState Trivial = [Key]
  fetchValue :: Key
-> Trivial
-> StateT
     (SourceState Trivial) IO (Either ConfigError (Value, Text))
fetchValue Key
key (Trivial Map Key Value
tree) = do
    case Key -> Map Key Value -> Maybe Value
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Key
key Map Key Value
tree of
      Maybe Value
Nothing -> Either ConfigError (Value, Text)
-> StateT
     (SourceState Trivial) IO (Either ConfigError (Value, Text))
forall a. a -> StateT (SourceState Trivial) IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ConfigError (Value, Text)
 -> StateT
      (SourceState Trivial) IO (Either ConfigError (Value, Text)))
-> Either ConfigError (Value, Text)
-> StateT
     (SourceState Trivial) IO (Either ConfigError (Value, Text))
forall a b. (a -> b) -> a -> b
$ ConfigError -> Either ConfigError (Value, Text)
forall a b. a -> Either a b
Left (Key -> ConfigError
NotPresent Key
key)
      Just Value
val -> do
        ([Key] -> [Key]) -> StateT [Key] IO ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Key
key :)
        Either ConfigError (Value, Text)
-> StateT [Key] IO (Either ConfigError (Value, Text))
forall a. a -> StateT [Key] IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ConfigError (Value, Text)
 -> StateT [Key] IO (Either ConfigError (Value, Text)))
-> Either ConfigError (Value, Text)
-> StateT [Key] IO (Either ConfigError (Value, Text))
forall a b. (a -> b) -> a -> b
$ (Value, Text) -> Either ConfigError (Value, Text)
forall a b. b -> Either a b
Right (Value
val, Text
"Trivial source with keys "Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack ([Key] -> String
forall a. Show a => a -> String
show (Map Key Value -> [Key]
forall k a. Map k a -> [k]
M.keys Map Key Value
tree)))

  leftovers :: Trivial -> StateT (SourceState Trivial) IO (Maybe [Key])
leftovers (Trivial Map Key Value
tree) = do
    [Key]
used <- StateT [Key] IO [Key]
forall s (m :: * -> *). MonadState s m => m s
get

    Map Key Value -> [Key]
forall k a. Map k a -> [k]
M.keys Map Key Value
tree
     [Key] -> ([Key] -> [Key]) -> [Key]
forall a b. a -> (a -> b) -> b
& (Key -> Bool) -> [Key] -> [Key]
forall a. (a -> Bool) -> [a] -> [a]
filter (Key -> [Key] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Key]
used)
     [Key] -> ([Key] -> Maybe [Key]) -> Maybe [Key]
forall a b. a -> (a -> b) -> b
& [Key] -> Maybe [Key]
forall a. a -> Maybe a
Just
     Maybe [Key]
-> (Maybe [Key] -> StateT [Key] IO (Maybe [Key]))
-> StateT [Key] IO (Maybe [Key])
forall a b. a -> (a -> b) -> b
& Maybe [Key] -> StateT [Key] IO (Maybe [Key])
forall a. a -> StateT [Key] IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure