summaryrefslogtreecommitdiff
path: root/src/Conftrack/Source.hs
blob: df6f82c0699647e1c96eed653e4e452aba11f2e4 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE ImpredicativeTypes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE OverloadedStrings #-}

module Conftrack.Source (ConfigSource(..), SomeSource(..), Trivial(..)) where

import Conftrack.Value (Key, Value(..), ConfigError(..), Origin)

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


class ConfigSource s where
  type ConfigState s
  fetchValue :: Key ->  s -> StateT (ConfigState s) IO (Either ConfigError (Value, Text))
  leftovers ::  s -> StateT (ConfigState s) IO (Maybe [Key])

data SomeSource = forall source. ConfigSource source
   => SomeSource (source, ConfigState source)


newtype Trivial = Trivial (Map Key Value)

instance ConfigSource Trivial where
  type ConfigState Trivial = [Key]
  fetchValue key (Trivial tree) = do
    case M.lookup key tree of
      Nothing -> pure $ Left NotPresent
      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