{- This file is part of settings. - - Written in 2015 by fr33domlover . - - ♡ 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 - . -} -- | 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