-- |
-- Copyright: (c) 2019 Lucas David Traverso
-- License: MPL-2.0
-- Maintainer: Lucas David Traverso <lucas6246@gmail.com>
-- Stability: stable
-- Portability: portable
--
-- Source that namespaces an inner source
{-# LANGUAGE RecordWildCards #-}
module Conferer.Source.Namespaced where

import Conferer.Source

-- | This source takes a source and returns a new source that
-- always checks that the 'Key' given always starts with certain 'Key'
-- and then strips that prefix before consulting its inner Source
data NamespacedSource =
  NamespacedSource
  { NamespacedSource -> Key
scopeKey :: Key
  , NamespacedSource -> Source
innerSource :: Source
  } deriving (Int -> NamespacedSource -> ShowS
[NamespacedSource] -> ShowS
NamespacedSource -> String
(Int -> NamespacedSource -> ShowS)
-> (NamespacedSource -> String)
-> ([NamespacedSource] -> ShowS)
-> Show NamespacedSource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NamespacedSource] -> ShowS
$cshowList :: [NamespacedSource] -> ShowS
show :: NamespacedSource -> String
$cshow :: NamespacedSource -> String
showsPrec :: Int -> NamespacedSource -> ShowS
$cshowsPrec :: Int -> NamespacedSource -> ShowS
Show)

instance IsSource NamespacedSource where
  getKeyInSource :: NamespacedSource -> Key -> IO (Maybe Text)
getKeyInSource NamespacedSource{Key
Source
innerSource :: Source
scopeKey :: Key
innerSource :: NamespacedSource -> Source
scopeKey :: NamespacedSource -> Key
..} Key
key = do
    case Key -> Key -> Maybe Key
stripKeyPrefix Key
scopeKey Key
key of
      Just Key
innerKey -> Source -> Key -> IO (Maybe Text)
forall s. IsSource s => s -> Key -> IO (Maybe Text)
getKeyInSource Source
innerSource Key
innerKey
      Maybe Key
Nothing -> Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
  getSubkeysInSource :: NamespacedSource -> Key -> IO [Key]
getSubkeysInSource NamespacedSource{Key
Source
innerSource :: Source
scopeKey :: Key
innerSource :: NamespacedSource -> Source
scopeKey :: NamespacedSource -> Key
..} Key
key = do
    case Key -> Key -> Maybe Key
stripKeyPrefix Key
scopeKey Key
key of
      Just Key
innerKey -> do
        (Key -> Key) -> [Key] -> [Key]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Key
scopeKey Key -> Key -> Key
/.) ([Key] -> [Key]) -> IO [Key] -> IO [Key]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Source -> Key -> IO [Key]
forall s. IsSource s => s -> Key -> IO [Key]
getSubkeysInSource Source
innerSource Key
innerKey
      Maybe Key
Nothing -> [Key] -> IO [Key]
forall (m :: * -> *) a. Monad m => a -> m a
return []

-- | Create a 'SourceCreator' from a prefix and another 'SourceCreator'
fromConfig :: Key -> SourceCreator -> SourceCreator
fromConfig :: Key -> SourceCreator -> SourceCreator
fromConfig Key
scopeKey SourceCreator
configCreator = \Config
config -> do
  Source
innerSource <- SourceCreator
configCreator 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 -> Source -> Source
fromInner Key
scopeKey Source
innerSource

-- | Create a 'Source' from a prefix and another 'Source'
fromInner :: Key -> Source -> Source
fromInner :: Key -> Source -> Source
fromInner Key
scopeKey Source
innerSource = do
  NamespacedSource -> Source
forall s. (IsSource s, Show s) => s -> Source
Source (NamespacedSource -> Source) -> NamespacedSource -> Source
forall a b. (a -> b) -> a -> b
$ NamespacedSource :: Key -> Source -> NamespacedSource
NamespacedSource{Key
Source
innerSource :: Source
scopeKey :: Key
innerSource :: Source
scopeKey :: Key
..}