{- 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/>.
 -}

{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}

module Data.Settings.Types
    ( Option (..)
    , Section (..)
    , OptName
    , SecName
    , OptPath
    , OptRoute
    , SettingsError (..)
    , OptionValue (..)
    , MonadSettings (..)
    )
where

import Data.HashMap.Lazy (HashMap)
import Data.Text (Text)

-- | A settings option. The option value itself is held as usual in regular
-- application state, not here. What is held here is /functions/ applied to
-- that state to get or set the value.
data Option m = Option
    { -- | A monadic action which returns the value of the option.
      optGet   :: m Text
      -- | A monadic action which tries to set the option to the given valie,
      -- and returns whether it succeeded.
    , optSet   :: Text -> m (Maybe SettingsError)
      -- | A monadic action which resets the option to its default value.
    , optReset :: m ()
    }

-- | A settings section in the settings UI tree.
data Section m = Section
    { -- | The options located under this section.
      secOpts :: HashMap Text (Option m)
      -- | Subsections located under this section.
    , secSubs :: HashMap Text (Section m)
    }

-- | An opion name.
type OptName = Text

-- | A section name.
type SecName = Text

-- | An option path string.
type OptPath = Text

-- | An option route, i.e. a list of section names ending with an option name,
-- which describes a path in the settings UI tree leading to that option.
type OptRoute = [Text]

-- | An error occuring during an operation on the settings.
data SettingsError
    = InvalidPath OptPath
    | NoSuchOption OptRoute
    | NoSuchSection OptRoute
    | NoSuchNode OptRoute
    | InvalidValueForType Text -- the value as a string
    | InvalidValue Text        -- error description

class OptionValue v where
    readOption :: Text -> Maybe v
    showOption :: v -> Text
    typeName   :: v -> Text

class Monad m => MonadSettings m s | m -> s where
    getSettings    :: m s
    putSettings    :: s -> m ()
    modifySettings :: (s -> s) -> m ()
    getSTree       :: m (Section m)