{- This file is part of settings.
 -
 - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.
 -
 - ♡ Copying is an act of love. Please copy, reuse and share.
 -
 - The author(s) have dedicated all copyright and related and neighboring
 - rights to this software to the public domain worldwide. This software is
 - distributed without any warranty.
 -
 - You should have received a copy of the CC0 Public Domain Dedication along
 - with this software. If not, see
 - <http://creativecommons.org/publicdomain/zero/1.0/>.
 -}

module Data.Settings.Interface
    ( -- * By Route
      queryR
    , querySectionR
    , queryOptionR
    , updateOptionR
    , resetOptionR
      -- * By Path
    , query
    , querySection
    , queryOption
    , updateOption
    , resetOption
    )
where

import Control.Monad (liftM)
import Data.HashMap.Lazy (keys)
import Data.Settings.Route
import Data.Settings.Section
import Data.Settings.Types
import Prelude hiding (lookup)

import qualified Data.Text as T

-------------------------------------------------------------------------------
-- By Route
-------------------------------------------------------------------------------

-- | Get what the settings tree contains at the given route.
--
-- * Return an error description if there is no such route in the tree.
-- * If there is a section at the route, return a list of subsection and option
--   names under it.
-- * If there is an option at the route, return its value.
queryR :: MonadSettings m s
       => OptRoute
       -> m (Either SettingsError (Either ([SecName], [OptName]) T.Text))
queryR route = do
    t <- getSTree
    case lookup route t of
        Just (Left sec)  ->
            return $ Right $ Left (keys $ secSubs sec, keys $ secOpts sec)
        Just (Right opt) -> liftM (Right . Right) $ optGet opt
        Nothing          -> return . Left $ NoSuchNode route

-- | Get info about a settings section at the given route, if there is one.
--
-- * Return an error description if there is no such route in the tree or it
--   doesn't point to a section.
-- * If there is a section at the route, return a list of subsection and option
--   names under it.
querySectionR :: MonadSettings m s
              => OptRoute
              -> m (Either SettingsError ([SecName], [OptName]))
querySectionR route = do
    result <- queryR route
    return $ case result of
        Left err              -> Left err
        Right (Left secsOpts) -> Right secsOpts
        Right (Right _val)    -> Left $ NoSuchSection route

-- | Get the value of the option at the given route.
--
-- * Return an error description if there is no such route in the tree or it
--   doesn't point to an option.
-- * If there is an option at the route, return its value.
queryOptionR :: MonadSettings m s
             => OptRoute
             -> m (Either SettingsError T.Text)
queryOptionR route = do
    result <- queryR route
    return $ case result of
        Left err               -> Left err
        Right (Left _secsOpts) -> Left $ NoSuchOption route
        Right (Right val)      -> Right val

-- | Change the value of the option at the given route. Return an error
-- description if there is no such route in the tree, or it doesn't point to an
-- option, or the value given is invalid.
updateOptionR :: MonadSettings m s
              => OptRoute
              -> T.Text
              -> m (Maybe SettingsError)
updateOptionR route val = do
    t <- getSTree
    case lookupOpt route t of
        Just opt -> optSet opt val
        Nothing  -> return $ Just $ NoSuchOption route

-- | Reset the value of the option at the given route to the default. Return an
-- error description if there is no such route in the tree or it doesn't point
-- to an option.
resetOptionR :: MonadSettings m s => OptRoute -> m (Maybe SettingsError)
resetOptionR route = do
    t <- getSTree
    case lookupOpt route t of
        Just opt -> optReset opt >> return Nothing
        Nothing  -> return $ Just $ NoSuchOption route

-------------------------------------------------------------------------------
-- By Path
-------------------------------------------------------------------------------

byPathMaybe :: Monad m
            => (OptRoute -> m (Maybe SettingsError))
            -> OptPath
            -> m (Maybe SettingsError)
byPathMaybe f path =
    case parseRoute path of
        Just route -> f route
        Nothing    -> return $ Just $ InvalidPath path

byPathEither :: Monad m
             => (OptRoute -> m (Either SettingsError a))
             -> OptPath
             -> m (Either SettingsError a)
byPathEither f path =
    case parseRoute path of
        Just route -> f route
        Nothing    -> return $ Left $ InvalidPath path

-- | Like 'queryR', but takes a path and first tries to parse it into a route,
-- returning an error description if the path is invalid.
query :: MonadSettings m s
      => OptPath
      -> m (Either SettingsError (Either ([SecName], [OptName]) T.Text))
query = byPathEither queryR

-- | Like 'querySectionR', but takes a path and first tries to parse it into a
-- route, returning an error description if the path is invalid.
querySection :: MonadSettings m s
             => OptPath
             -> m (Either SettingsError ([SecName], [OptName]))
querySection = byPathEither querySectionR

-- | Like 'queryOptionR', but takes a path and first tries to parse it into a
-- route, returning an error description if the path is invalid.
queryOption :: MonadSettings m s => OptPath -> m (Either SettingsError T.Text)
queryOption = byPathEither queryOptionR

-- | Like 'updateOptionR', but takes a path and first tries to parse it into a
-- route, returning an error description if the path is invalid.
updateOption :: MonadSettings m s
             => OptPath
             -> T.Text
             -> m (Maybe SettingsError)
updateOption path val = byPathMaybe (flip updateOptionR val) path

-- | Like 'resetOptionR', but takes a path and first tries to parse it into a
-- route, returning an error description if the path is invalid.
resetOption :: MonadSettings m s => OptPath -> m (Maybe SettingsError)
resetOption = byPathMaybe resetOptionR