Trivial.hs

{-# 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 pairs = SomeSource (source, [])
  where source = Trivial (M.fromList pairs)

instance ConfigSource Trivial where
  type SourceState Trivial = [Key]
  fetchValue key (Trivial tree) = do
    case M.lookup key tree of
      Nothing -> pure $ Left (NotPresent key)
      Just val -> do
        modify (key :)
        pure $ Right (val, "Trivial source with keys "<> T.pack (show (M.keys tree)))

  leftovers (Trivial tree) = do
    used <- get

    M.keys tree
     & filter (`notElem` used)
     & Just
     & pure