{- 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 qualified Data.HashMap.Lazy as M

-- | 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
    { -- |
      optGet   :: m String
      -- |
    , optSet   :: String -> m (Maybe SettingsError)
      -- |
    , optReset :: m ()
    }

data Section m = Section
    { secOpts :: M.HashMap String (Option m)
    , secSubs :: M.HashMap String (Section m)
    }

type OptName = String

type SecName = String

type OptPath = String

type OptRoute = [String]

data SettingsError
    = InvalidPath OptPath
    | NoSuchOption OptRoute
    | NoSuchSection OptRoute
    | NoSuchNode OptRoute
    | InvalidValueForType String -- the value as a string
    | InvalidValue String        -- error description

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

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