-- |
-- Copyright: (c) 2019 Lucas David Traverso
-- License: MPL-2.0
-- Maintainer: Lucas David Traverso <lucas6246@gmail.com>
-- Stability: stable
-- Portability: portable
--
-- In memory source mostly used for testing
{-# LANGUAGE RecordWildCards #-}
module Conferer.Source.InMemory where

import Data.Map (Map)
import qualified Data.Map as Map
import Data.Text (Text)

import Conferer.Source

-- | A 'Source' mostly use for mocking which is configured directly using a
-- 'Map'
newtype InMemorySource =
  InMemorySource
  { InMemorySource -> Map Key Text
configMap :: Map Key Text
  } deriving (Int -> InMemorySource -> ShowS
[InMemorySource] -> ShowS
InMemorySource -> String
(Int -> InMemorySource -> ShowS)
-> (InMemorySource -> String)
-> ([InMemorySource] -> ShowS)
-> Show InMemorySource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InMemorySource] -> ShowS
$cshowList :: [InMemorySource] -> ShowS
show :: InMemorySource -> String
$cshow :: InMemorySource -> String
showsPrec :: Int -> InMemorySource -> ShowS
$cshowsPrec :: Int -> InMemorySource -> ShowS
Show, InMemorySource -> InMemorySource -> Bool
(InMemorySource -> InMemorySource -> Bool)
-> (InMemorySource -> InMemorySource -> Bool) -> Eq InMemorySource
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InMemorySource -> InMemorySource -> Bool
$c/= :: InMemorySource -> InMemorySource -> Bool
== :: InMemorySource -> InMemorySource -> Bool
$c== :: InMemorySource -> InMemorySource -> Bool
Eq)

instance IsSource InMemorySource where
  getKeyInSource :: InMemorySource -> Key -> IO (Maybe Text)
getKeyInSource InMemorySource {Map Key Text
configMap :: Map Key Text
configMap :: InMemorySource -> Map Key Text
..} Key
key =
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text -> IO (Maybe Text)) -> Maybe Text -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Key -> Map Key Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Key
key Map Key Text
configMap
  getSubkeysInSource :: InMemorySource -> Key -> IO [Key]
getSubkeysInSource InMemorySource {Map Key Text
configMap :: Map Key Text
configMap :: InMemorySource -> Map Key Text
..} Key
key = do
    [Key] -> IO [Key]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Key] -> IO [Key]) -> [Key] -> IO [Key]
forall a b. (a -> b) -> a -> b
$ (Key -> Bool) -> [Key] -> [Key]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Key
k -> Key
key Key -> Key -> Bool
`isKeyPrefixOf` Key
k Bool -> Bool -> Bool
&& Key
key Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
/= Key
k) ([Key] -> [Key]) -> [Key] -> [Key]
forall a b. (a -> b) -> a -> b
$ Map Key Text -> [Key]
forall k a. Map k a -> [k]
Map.keys Map Key Text
configMap

-- | Create a 'SourceCreator' from a list of associations
fromConfig :: [(Key, Text)] -> SourceCreator
fromConfig :: [(Key, Text)] -> SourceCreator
fromConfig [(Key, Text)]
configMap Config
_config =
  Source -> IO Source
forall (m :: * -> *) a. Monad m => a -> m a
return (Source -> IO Source) -> Source -> IO Source
forall a b. (a -> b) -> a -> b
$ [(Key, Text)] -> Source
fromAssociations [(Key, Text)]
configMap

-- | Create a 'Source' from a 'Map'
fromMap :: Map Key Text -> Source
fromMap :: Map Key Text -> Source
fromMap Map Key Text
configMap =
  InMemorySource -> Source
forall s. (IsSource s, Show s) => s -> Source
Source (InMemorySource -> Source)
-> (Map Key Text -> InMemorySource) -> Map Key Text -> Source
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Key Text -> InMemorySource
InMemorySource (Map Key Text -> Source) -> Map Key Text -> Source
forall a b. (a -> b) -> a -> b
$ Map Key Text
configMap

-- | Create a 'Source' from a list of associations
fromAssociations :: [(Key, Text)] -> Source
fromAssociations :: [(Key, Text)] -> Source
fromAssociations =
  Map Key Text -> Source
fromMap (Map Key Text -> Source)
-> ([(Key, Text)] -> Map Key Text) -> [(Key, Text)] -> Source
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Key, Text)] -> Map Key Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList