-- |
-- Copyright: (c) 2019 Lucas David Traverso
-- License: MPL-2.0
-- Maintainer: Lucas David Traverso <lucas6246@gmail.com>
-- Stability: stable
-- Portability: portable
--
-- Do nothing source
module Conferer.Source.Null where

import Conferer.Source

-- | Stub source that has no keys
data NullSource =
  NullSource
  deriving (Int -> NullSource -> ShowS
[NullSource] -> ShowS
NullSource -> String
(Int -> NullSource -> ShowS)
-> (NullSource -> String)
-> ([NullSource] -> ShowS)
-> Show NullSource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NullSource] -> ShowS
$cshowList :: [NullSource] -> ShowS
show :: NullSource -> String
$cshow :: NullSource -> String
showsPrec :: Int -> NullSource -> ShowS
$cshowsPrec :: Int -> NullSource -> ShowS
Show, NullSource -> NullSource -> Bool
(NullSource -> NullSource -> Bool)
-> (NullSource -> NullSource -> Bool) -> Eq NullSource
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NullSource -> NullSource -> Bool
$c/= :: NullSource -> NullSource -> Bool
== :: NullSource -> NullSource -> Bool
$c== :: NullSource -> NullSource -> Bool
Eq)

instance IsSource NullSource where
  getKeyInSource :: NullSource -> Key -> IO (Maybe Text)
getKeyInSource NullSource
_source Key
_key =
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
  getSubkeysInSource :: NullSource -> Key -> IO [Key]
getSubkeysInSource NullSource
_source Key
_key =
    [Key] -> IO [Key]
forall (m :: * -> *) a. Monad m => a -> m a
return []

-- | Create 'SourceCreator'
fromConfig :: SourceCreator
fromConfig :: SourceCreator
fromConfig Config
_config =
  Source -> IO Source
forall (m :: * -> *) a. Monad m => a -> m a
return Source
empty

-- | Create a 'Source'
empty :: Source
empty :: Source
empty =
  NullSource -> Source
forall s. (IsSource s, Show s) => s -> Source
Source (NullSource -> Source) -> NullSource -> Source
forall a b. (a -> b) -> a -> b
$ NullSource
NullSource