Section.hs

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

-- | This module provides functions work working with the 'Section' type, i.e.
-- option trees. The style is similar to the APIs for @HashMap@s and @Map@s.
-- You can use these functions to construct a custom settings tree UI. Before
-- you do that, try the "Data.Settings.Interface" module, which may already
-- offer what you need.
module Data.Settings.Section
    ( -- * Construction
      empty
    , singleton
      -- * Observation
    , hasOpts
    , hasSubs
    , null
    , member
    , memberOpt
    , memberSub
    , lookup
    , lookupOpt
    , lookupSub
      -- * Modification
    , insertOpt
    , insertSub
    , deleteOpt
    , deleteSub
    , delete
    )
where

import Data.Either (isRight)
import Data.Settings.Types
import Prelude hiding (lookup, null)

import qualified Data.HashMap.Lazy as M

-- | Construct an empty section, no options and no subsections.
empty :: Section m
empty = Section M.empty M.empty

-- | Construct a section with a single option.
singleton :: SecName -> Option m -> Section m
singleton name opt = Section (M.singleton name opt) M.empty

-- | Return 'True' if this section contains any options, 'False' otherwise.
hasOpts :: Section m -> Bool
hasOpts = not . M.null . secOpts

-- | Return 'True' if this section contains any subsections, 'False' otherwise.
hasSubs :: Section m -> Bool
hasSubs = not . M.null . secSubs

-- | Return 'True' if this section is empty (no options, no subsections),
-- 'False' otherwise.
null :: Section m -> Bool
null s = not $ hasOpts s || hasSubs s

-- | Return 'True' if an option or a subsection is present at the specified
-- path, 'False' otherwise.
member :: OptRoute -> Section m -> (Bool, Bool)
member route sec =
    case lookup route sec of
        Nothing -> (False, False)
        Just e  -> (True, isRight e)

-- | Return 'True' if an option is present at the specified path, 'False'
-- otherwise.
memberOpt :: OptRoute -> Section m -> Bool
memberOpt route sec =
    let (m, o) = member route sec
    in  m && o

-- | Return 'True' if a subsection is present at the specified path, 'False'
-- otherwise.
memberSub :: OptRoute -> Section m -> Bool
memberSub route sec =
    let (m, o) = member route sec
    in  m && not o

-- | Return 'Just' the section or option at the specified route, or 'Nothing'
-- if this section contains no such route.
lookup :: OptRoute -> Section m -> Maybe (Either (Section m) (Option m))
lookup []     sec = Just $ Left sec
lookup [name] sec =
    case (M.lookup name $ secOpts sec, M.lookup name $ secSubs sec) of
        (Just o,  _)       -> Just $ Right o
        (Nothing, Just s)  -> Just $ Left s
        (Nothing, Nothing) -> Nothing
lookup (n:ns) sec =
    case M.lookup n $ secSubs sec of
        Just s  -> lookup ns s
        Nothing -> Nothing

-- | Return 'Just' the option at the specified route, or 'Nothing' if this
-- section doesn't contain an option at this route.
lookupOpt :: OptRoute -> Section m -> Maybe (Option m)
lookupOpt route sec =
    case lookup route sec of
        Just (Right o) -> Just o
        _              -> Nothing

-- | Return 'Just' the section at the specified route, or 'Nothing' if this
-- section doesn't contain a subsection at this route.
lookupSub :: OptRoute -> Section m -> Maybe (Section m)
lookupSub route sec =
    case lookup route sec of
        Just (Left s) -> Just s
        _             -> Nothing

-- | Add the specified option at the specified route under this section. If the
-- section previously contained an option for this route, the old value is
-- replaced.
insertOpt :: OptRoute  -- ^ Route at which to place the option
          -> Option m  -- ^ Option to insert
          -> Section m -- ^ Root section under which to insert
          -> Section m
insertOpt route opt s@(Section opts subs) =
    case route of
        []     -> s
        [name] -> Section (M.insert name opt opts) subs
        (n:ns) ->
                -- Find the section or make a new one
            let sub   = M.lookupDefault empty n subs
                -- Insert the option there, applying recursively
                sub'  = insertOpt ns opt sub
                -- Put the result back into the subsection map
                subs' = M.insert n sub' subs
            in  Section opts subs'

-- | Add the specified subsection at the specified route under this section. If
-- the section previously contained a subsection for this route, the old value
-- is replaced.
insertSub :: OptRoute  -- ^ Route at which to place the subsection
          -> Section m -- ^ Subsection to insert
          -> Section m -- ^ Root section under which to insert
          -> Section m
insertSub route sec s@(Section opts subs) =
    case route of
        []     -> s
        [name] -> Section opts (M.insert name sec subs)
        (n:ns) ->
                -- Find the section or make a new one
            let sub   = M.lookupDefault empty n subs
                -- Insert the subsection there, applying recursively
                sub'  = insertSub ns sec sub
                -- Put the result back into the subsection map
                subs' = M.insert n sub' subs
            in  Section opts subs'

deleteImpl :: Bool -> Bool -> OptRoute -> Section m -> Section m
deleteImpl delO delS = d
    where
    d route sec@(Section opts subs) =
        case route of
            []     -> sec
            [name] -> Section
                        (if delO then M.delete name opts else opts)
                        (if delS then M.delete name subs else subs)
            (n:ns) -> Section opts $ M.adjust (d ns) n subs

-- | Remove the option at the specified route, if present. If there is a
-- section under this route, it won't be removed.
deleteOpt :: OptRoute -> Section m -> Section m
deleteOpt = deleteImpl True False

-- | Remove the section at the specified route, if present. If there is an
-- option under this route, it won't be removed.
deleteSub :: OptRoute -> Section m -> Section m
deleteSub = deleteImpl False True

-- | Remove the option or section at the specified route, if present.
delete :: OptRoute -> Section m -> Section m
delete = deleteImpl True True