inilist (empty) → 0.1.0.0
raw patch · 6 files changed
+819/−0 lines, 6 filesdep +HUnitdep +basedep +bifunctorssetup-changed
Dependencies added: HUnit, base, bifunctors, containers, deepseq, inilist, safe, tasty, tasty-hunit, testpack, trifecta
Files
- Data/AList.hs +120/−0
- Data/Ini/List.hs +390/−0
- LICENSE +30/−0
- Setup.hs +2/−0
- UnitTest.hs +241/−0
- inilist.cabal +36/−0
+ Data/AList.hs view
@@ -0,0 +1,120 @@+{- |+Module : Data.AList+Description : An association list data type.+Copyright : © Mike Meyer, 2015+License : BSD3+Maintainer : mwm@mired.org+Stability : experimental++A module to encapsulate associative lists.++-}++module Data.AList+ (+ -- * Data+ AList,+ -- * Convert+ fromList,+ toList,+ toMap,+ fromMap,+ -- * Query+ isEmpty,+ lookupAll,+ lookupFirst,+ lookupBy,+ member,+ values,+ keys,+ -- * Modify+ insert,+ append,+ deleteAll,+ deleteFirst,+ deleteBy) where+ ++import Prelude hiding (deleteBy)++import qualified Data.Map as M+import Data.List (delete)+import Data.Monoid ((<>), mappend, mempty, Monoid)+import Safe (headMay)+++-- | An 'AList' is a list of of /(key, value)/ pairs. Such pairs+-- are referred to as an /item/ in the following.+data AList key value = AList [(key, value)] deriving (Show)++instance Monoid (AList k v) where+ mempty = AList []+ mappend (AList a) (AList b) = AList $ a ++ b++-- | 'isEmpty' returns 'True' if the 'AList' is empty.+isEmpty :: AList k v -> Bool+isEmpty (AList al) = null al++-- | 'lookupAll' returns a 'List' of all items with the given key.+lookupAll :: Eq k => k -> AList k v -> [v]+lookupAll k (AList al) = map snd $ filter ((== k) . fst) al++-- | 'lookupFirst' finds the first value with a matching key, if there is one.+lookupFirst :: Eq k => k -> AList k v -> Maybe v+lookupFirst k (AList l) = lookup k l++-- | 'lookupBy' returns an 'AList' of all items with keys matched by the function.+lookupBy :: (k -> Bool) -> AList k v -> AList k v+lookupBy f (AList l) = AList $ filter (f . fst) l++-- | 'member' returns true if the given key is used in the 'AList'.+member :: Eq k => k -> AList k v -> Bool+member k = elem k . keys ++-- | 'values' returns a 'List' of the values in the 'AList'.+values :: AList k v -> [v]+values (AList al) = map snd al++-- | 'keys' returns a 'List' of the keys in the 'AList'.+keys :: AList k v -> [k]+keys (AList al) = map fst al++-- | 'insert' a key, value pair at the head of the 'AList'.+insert :: k -> v -> AList k v -> AList k v+insert k v (AList l) = AList $ (k, v):l++-- | 'append' a key, value pair to the end of the 'AList'.+append :: k -> v -> AList k v -> AList k v+append k v (AList l) = AList $ l ++ [(k, v)]++-- | 'deleteAll' all values associated with a key.+deleteAll :: Eq k => k -> AList k v -> AList k v+deleteAll k = deleteBy (== k)++-- | 'deleteFirst' deletes the first value with a given key.+deleteFirst :: Eq k => k -> AList k v -> AList k v+deleteFirst _ (AList []) = AList []+deleteFirst t (AList ((k, v):is))+ | t == k = AList is+ | otherwise = insert k v . deleteFirst t $ AList is++-- | 'deleteBy' deletes all values with keys matched by the function.+deleteBy :: (k -> Bool) -> AList k v -> AList k v+deleteBy f = lookupBy (not . f)++-- | 'fromList' creates an 'AList' from a 'List' of items.+fromList :: [(k, v)] -> AList k v+fromList = AList++-- | 'toList' returns a 'List' of the items in an 'AList'.+toList :: AList k v -> [(k, v)]+toList (AList l) = l++-- | 'toMap' converts to a 'Map'. Behavior with multiple keys is undefined.+toMap :: Ord k => AList k v -> M.Map k v+toMap (AList l) = M.fromList l++-- | 'fromMap' creates an 'AList' from a 'Map', though I'm not sure why+-- you'd want to do that.+fromMap :: Ord k => M.Map k v -> AList k v+fromMap = AList . M.toList
+ Data/Ini/List.hs view
@@ -0,0 +1,390 @@+{-# Language FlexibleInstances, FunctionalDependencies, OverlappingInstances,+ OverloadedStrings, TupleSections, UndecidableInstances #-}++{- |+Module : Data.Ini.List+Description : Ini config file parser using Lists, not Maps.+Copyright : © Mike Meyer, 2015+License : BSD3+Maintainer : mwm@mired.org+Stability : experimental++Most ini config files turn into 1-1 maps quite nicely. However,+some encode lists of objects, which require having more than one+section of a given name, or more than one value in a section with a+given name - and order matters.++This package parsers Ini files, but instead of creating maps, it+creates a list of sections, each section of which is a list of+values. As a result, the 'get' function can now return a list of+values for options that can occur multiple times, and there are plural+versions of the Option and Section fetchers.++-}++module Data.Ini.List+ (+ -- * Types+ Section,+ Config,+ OptionName,+ SectionName,+ Option,+ SectionItem,+ ConfigItem,+ UpdateValue,+ UpdateOption,+ Value(value, getValue),+ -- * Build+ config,+ setDefault,+ (<+), (+>),+ -- * Convert+ toList,+ fromList,+ -- * Query+ get,+ getDefault,+ getSection,+ getSections,+ getSectionsBy,+ -- * Update+ updateValues,+ updateDefaultValues,+ updateSectionValues,+ updateOptions,+ updateDefaultOptions,+ updateSectionOptions,+ -- * Format+ formatConfig,+ writeConfig,+ writeConfigFile,+ hWriteConfig,+ -- * Parse+ parseConfig,+ parseFile,+ parseFileEx+ ) where+++import Control.Applicative ((<$>), (<|>), (<*>), (<*), (*>), Applicative, + many, optional, pure, some)+import qualified Data.AList as AL+import Data.Bifunctor (second)+import Data.Char (isPrint, isSpace, toLower)+import Data.Maybe (fromMaybe)+import Data.List (isPrefixOf, intercalate)+import Data.Monoid (Monoid, mempty, mappend, (<>))+import Safe (readMay, headMay)+import System.IO+import Text.Trifecta ((<?>), char, CharParsing, eof, manyTill, newline, oneOf,+ option, parseFromFile, parseFromFileEx, parseString,+ Result, runUnlined, satisfy, sepEndBy, sepEndBy1,+ TokenParsing, try, whiteSpace)+++-- My types+-- | A config is an unmaned 'Section' and an 'AList' of 'SectionItem's.+data Config = Config Section (AL.AList SectionName Section) deriving (Show)++type OptionName = String+-- | Names are all 'String's.+type SectionName = String++-- | As are values.+type Option = String++-- | A 'Section' is just an 'AList'.+type Section = AL.AList OptionName Option++type SectionItem = (OptionName, Option)+-- | Convient names for items from a 'Section' or 'Config'+type ConfigItem = (SectionName, Section)++-- | An 'UpdateValue' is a function that takes a 'SectionName',+-- 'OptionName' and 'Option' and returns a Nothing if it doesn't want+-- to change the given 'SectionItem', or 'Just' 'Option' if it does.+type UpdateValue = SectionName -> OptionName -> Option -> Maybe Option++-- | An 'UpdateOption' is like an 'UpdateValue', except it returns a+-- 'Maybe' 'SectionItem', allowing it to change the key as well as the+-- value of the 'SectionItem' in question.+type UpdateOption = SectionName -> OptionName -> Option -> Maybe SectionItem++-- | The 'Value' class is one that the /get/ functions can+-- return. Most notably, names that occur multiple times in a section+-- can become a 'List', returning a singleton or empty 'List' for+-- single or missing names in a context where a 'List' is needed.+--+-- @0/1@, @yes/no@, @on/off@, @true/false@ and @enabled/disabled@ values+-- will be returned as 'Bool' in the appropriate contexts.+--+-- Finally, any value that has a 'Read' instance will be converted+-- if possible, so that integer and floating point values can be+-- used immediately.+class Value a where+ -- | @'getValue' 'Section' 'OptionName'@ gets the value for the+ -- named 'Option' from the 'Section'. + getValue :: Section -> OptionName -> Maybe a+ + -- The default is to just convert the current string.+ getValue s o = value <$> getOption s o++ -- | 'value' converts a single 'Option' 'String' into a value of+ -- the type of the instance.+ value :: Option -> a++instance Value String where+ value v = v++instance Value Bool where+ value v = value' $ map toLower v+ where value' v' | elem v' ["1", "yes", "on", "enabled", "true"] = True+ | elem v' ["0", "no", "off", "disabled", "false"] = False+ value' v' = error $ "couldn't parse '" ++ v' ++ "' as Bool"++instance Value t => Value [t] where+ getValue s o = Just . map value $ getOptions s o + value o = [value o]++instance Read t => Value t where+ value v = fromMaybe (error $ "couldn't parse '" ++ v ++ "'") $ readMay v+++-- Constructors+-- We'd like Config & Section tweaking ops to be polymorphic.+-- Laws? Pragmatism strikes again!+class Cons container item | container -> item where+ -- | 'fromList' creates a 'Config' or 'Section' from a list of items.+ -- A Config gets an empty default section.+ fromList :: [item] -> container+ -- | 'toList' returns the 'AList' in the 'Config' or 'Section' as a list+ -- of items.+ toList :: container -> [item]+ cons :: item -> container -> container+ -- | (+>) and (<+) operators add items to a 'Config' or 'Section'+ (+>) :: item -> container -> container+ (+>) = cons+ (<+) :: container -> item -> container+ (<+) = flip (+>)++infixl 7 <++infixr 7 +>++instance Cons Section SectionItem where+ fromList = AL.fromList+ toList = AL.toList+ cons i os = os <> AL.fromList [i]++instance Cons Config ConfigItem where+ fromList l = Config (AL.fromList []) (AL.fromList l)+ toList (Config _ sl) = AL.toList sl+ cons i (Config d sl)= Config d $ sl <> AL.fromList [i]+++-- | 'Config' as a Monoid is a bit off. The default sections are+-- append to each other. This is required for it to obey the Monoid+-- laws.+instance Monoid Config where+ mempty = Config (AL.fromList []) $ AL.fromList []+ mappend (Config ad al) (Config bd bl) = Config (ad <> bd) $ al <> bl+++-- | 'config' creates a 'Config' from the given default 'Section'+-- and list of 'ConfigItem''s.+config :: Section -> [ConfigItem] -> Config+config s l = Config s $ AL.fromList l++-- | 'setDefault' sets the default 'Section' for the 'Config'.+setDefault :: Config -> Section -> Config+setDefault (Config _ sl) s = Config s sl++-- | 'getDefault' returns the default section from a 'Config'.+getDefault :: Config -> Section+getDefault (Config d _) = d++-- | 'getSections' returns the 'List' of 'Section's with /name/ in the 'Config'.+getSections :: Config -> SectionName -> [Section]+getSections (Config _ sl) n = AL.lookupAll n sl++-- | 'getSection' returns the first 'Section' /name/ from 'Config' if one+-- exists.+getSection :: Config -> SectionName -> Maybe Section+getSection c n = headMay $ getSections c n++-- | 'getSectionsBy' returns a list of 'ConfigItem''s from a 'Config'+-- chosen by the provided function.+getSectionsBy :: Config -> (SectionName -> Bool) -> [ConfigItem]+getSectionsBy (Config _ sl) sel = filter (\(n, _) -> sel n) $ AL.toList sl++-- | 'get' a value from a 'Config' selected by 'Maybe' 'SectionName'+-- and 'OptionName'. 'Nothing' as the 'SectionName' gets 'Option' values+-- from the default 'Section'.+get :: Value a => Config -> Maybe SectionName -> OptionName -> Maybe a+get c s o = get' s >>= (flip getValue) o where+ get' (Just n) = getSection c n+ get' Nothing = Just $ getDefault c+++-- And finally, the things to update a Config++-- So it turns out both types of updaters are also Monoids. Who knew?+emptyUpdate :: SectionName -> OptionName -> Option -> Maybe a+emptyUpdate _ _ _ = Nothing++mappendUpdate :: (SectionName -> OptionName -> Option -> Maybe a)+ -> (SectionName -> OptionName -> Option -> Maybe a)+ -> (SectionName -> OptionName -> Option -> Maybe a)+(a `mappendUpdate` b) s o v = maybe (b s o v) Just $ a s o v++instance Monoid (SectionName -> OptionName -> Option -> Maybe a) where+ mempty = emptyUpdate+ mappend = mappendUpdate++-- | 'updateOptions' uses an 'UpdateOption' to update all the options+-- in the 'Config'.+updateOptions :: UpdateOption -> Config -> Config+updateOptions f (Config d sl) =+ Config d . AL.fromList . map (\(n, s) -> (n, updateSectionOptions (f n) s))+ $ AL.toList sl++-- | 'updateOptions' uses an 'UpdateValue' to update all the values in+-- the 'Config'.+updateValues :: UpdateValue -> Config -> Config+updateValues f (Config d sl) =+ Config d . AL.fromList . map (\(n, s) -> (n, updateSectionValues (f n) s))+ $ AL.toList sl++-- | 'updateDefaultOptions' updates the options in the default+-- 'Section' of the 'Config' with the given function, which is similar+-- to an 'UpdateOption' without the 'SectionName' argument.+updateDefaultOptions :: (OptionName -> Option -> Maybe SectionItem)+ -> Config+ -> Config+updateDefaultOptions f (Config d sl) = Config (updateSectionOptions f d) sl++-- | 'updateDefaultOptions' updates the values in the default+-- 'Section' of the 'Config' with the given function, which is similar+-- to an 'UpdateValue' without the 'SectionName' argument.+updateDefaultValues :: (OptionName -> Option -> Maybe Option) -> Config -> Config+updateDefaultValues f (Config d sl) = Config (updateSectionValues f d) sl++updateSectionOptions :: (OptionName -> Option -> Maybe SectionItem)+ -> Section+ -> Section+-- | 'updateSectionOptions' updates the options in the named 'Section'+-- 'Section' of the 'Config' with the given function, which is similar+-- to an 'UpdateOption' without the 'SectionName' argument.+updateSectionOptions f os = AL.fromList . map (updateOption f) $ AL.toList os where+ updateOption f o@(n, v) = fromMaybe o $ f n v++-- | 'updateSectionValues' updates the values in the named 'Section'+-- of the 'Config' with the given function, which is similar to an+-- 'UpdateValue' without the 'SectionName' argument.+updateSectionValues :: (OptionName -> Option -> Maybe Option) -> Section -> Section+updateSectionValues f s = updateSectionOptions (updateValue f) s where+ updateValue f n o = (n ,) <$> f n o+++-- Internal routines for getting options. Users should use+-- getValue+getOptions :: Section -> OptionName -> [Option]+getOptions os k = map snd . filter (\(n, _) -> n == k) $ AL.toList os++getOption :: Section -> OptionName -> Maybe Option+getOption os n = AL.lookupFirst n os+++-- And output things+formatOption :: SectionItem -> String+formatOption (name, val) = name ++ "=" ++ val++formatSection :: ConfigItem -> String+formatSection (name, section) =+ unlines $ ("[" ++ name ++ "]") : (map formatOption $ AL.toList section)++-- | 'formatConfig' converts a 'Config' to a 'String' representation+-- for use in a @.ini@ file.+formatConfig :: Config -> String+formatConfig (Config options sections) =+ intercalate "\n" $+ (unlines . map formatOption $ AL.toList options)+ :(map formatSection $ AL.toList sections)++-- | 'writeConfigFile' formats a 'Config' and writes it to 'FilePath'.+writeConfigFile :: FilePath -> Config -> IO ()+writeConfigFile f c = writeFile f $ formatConfig c++-- | 'hwriteConfigFile' formats a 'Config' and writes it to a 'Handle'.+hWriteConfig :: Handle -> Config -> IO ()+hWriteConfig h c = hPutStr h $ formatConfig c++-- | 'writeConfig' formats a 'Config' and writes it to 'stdout'.+writeConfig :: Config -> IO ()+writeConfig = hWriteConfig stdout+++-- | 'parseConfig' parses a 'String' into a 'Config', returning the+-- 'Config' wrapped in a a 'Result'+parseConfig :: String -> Result Config+parseConfig = parseString parser mempty++-- | 'parseFile' parses the named @.ini@ file, sending diagnostic messages to+-- the console.+parseFile :: FilePath -> IO (Maybe Config)+parseFile = parseFromFile parser++-- | 'parseFileEx' parses the named @.ini@ file, returning either the+-- 'Config' or diagnostic messages in the 'Result'.+parseFileEx :: FilePath -> IO (Result Config)+parseFileEx = parseFromFileEx parser++parser :: (Monad m, TokenParsing m) => m Config+parser = runUnlined+ $ optional lineSep *>+ (Config <$> (AL.fromList <$> sepEndBy (try optionLine) lineSep)+ <*> (AL.fromList <$> many sectionLine))+ <* many (char '\0') -- Deal with file system oddness+ <* eof+ <?> "config"++sectionLine :: (Monad m, TokenParsing m) => m ConfigItem+sectionLine = (,) <$> sectionName <* lineSep+ <*> (AL.fromList <$> sepEndBy1 (try optionLine) lineSep)+ <?> "section"++sectionName :: (Monad m, TokenParsing m) => m String+sectionName = whiteSpace+ *> char '['+ *> ((:) <$> satisfy (\c -> c /= ']' && isPrint c)+ <*> manyTill printing (char ']')+ <?> "section name") + <* many anyChar+ <?> "section start line"++optionLine :: (Monad m, TokenParsing m) => m SectionItem+optionLine = (,) <$> (strip <$> optionName)+ <*> (unComment <$> many printing <?> "option value")+ <?> "option line" + where -- Handle some context-sensitive bits of the syntax+ strip = reverse . dropWhile isSpace . reverse+ unComment = dropWhile isSpace . reverse . dropWhile isSpace . unComment' ""+ unComment' r v | null v = r+ | isPrefixOf " ;" v = r+ | otherwise = unComment' (head v:r) (tail v)++optionName :: (Monad m, TokenParsing m) => m OptionName+optionName = whiteSpace *> ((:) <$> satisfy (\c -> isPrint c && c /= '[')+ <*> manyTill printing (oneOf ":="))+ <?> "option name"++-- Lines are separated by a newline and zero or more comment lines.+lineSep :: (Monad m, TokenParsing m) => m ()+lineSep = some (whiteSpace <* optional (oneOf ";#" <* many anyChar) <* newline)+ *> pure ()+ <?> "line separator"++-- Some basic character types+printing, anyChar :: CharParsing m => m Char+printing = satisfy isPrint+anyChar = satisfy (/= '\n')
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2015++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Mike Meyer or the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ UnitTest.hs view
@@ -0,0 +1,241 @@+{-# Language OverloadedStrings, FlexibleInstances #-}++module Main where++import Control.DeepSeq (deepseq)+import Control.Exception (ErrorCall(ErrorCall), evaluate)+import Data.List (isInfixOf)+import Data.Monoid ((<>), mconcat, mempty)+import qualified Data.Map as M+import Text.Trifecta (TokenParsing, Result(Success, Failure))++import Test.Tasty+import Test.Tasty.HUnit+import Test.HUnit.Tools++import Data.AList as AL+import Data.Ini.List as IL+++-- Add some Eq instances. Not in general valid, but we want them for testing.+instance Eq a => Eq (Result a) where+ (Success a) == (Success b) = a == b+ _ == _ = False -- Can't test failures for equality.++instance (Eq k, Eq v) => Eq (AL.AList k v) where+ a == b = AL.toList a == AL.toList b++instance Eq Config where+ a == b = getDefault a == getDefault b && IL.toList a == IL.toList b++testError msg err code =+ testCase msg . assertRaises "Check error" (ErrorCall err) . evaluate+ $ deepseq (show code) ()+++testFailure msg err code =+ let expect = "Expected failure containg: " ++ err ++ "\n"+ in testCase msg $ case code of+ Success _ -> assertFailure $ expect ++ "but succeeded"+ Failure x -> let res = show x+ in assertBool (expect ++ "but got " ++ res)+ . isInfixOf err $ res+++trues = ["1", "yes", "on", "enabled", "true"]+falses = ["0", "no", "off", "disabled", "false"]+section1 = IL.fromList [("Value1", "23"), ("Value1", "35"), ("Value 2", "foo bar")]+section2 = IL.fromList [("Value1", "34"), ("Value2", "")]+def = IL.fromList $ ("Value1", "12"):(map (\x -> (x, x)) $ trues ++ falses)+test = config def [("Section1", section1),+ ("Section 2", section2),+ ("Section1", section2)]+++updateValue "Value1" _ = Just "Updated"+updateValue _ _ = Nothing+updateOption "Value1" _ = Just ("Changed", "New")+updateOption _ _ = Nothing+def2 = IL.fromList $ ("Value1", "Updated"):(map (\x -> (x, x)) $ trues ++ falses)+updateSection "Section 2" o v = updateValue o v+updateSection _ _ _ = Nothing+def3 = IL.fromList $ ("Changed", "New"):(map (\x -> (x, x)) $ trues ++ falses)+updateSO "Section 2" o v = updateOption o v+updateSO _ _ _ = Nothing++testString = "Value1=12\n1=1\nyes=yes\non=on\nenabled=enabled\ntrue=true\n0=0\nno=no\noff=off\ndisabled=disabled\nfalse=false\n\n[Section1]\nValue1=23\nValue1=35\nValue 2=foo bar\n\n[Section 2]\nValue1=34\nValue2=\n\n[Section1]\nValue1=34\nValue2=\n"++commentString = ";c\n#c\n ;c\n #c\nValue1=12\n\n1=1 ;c \n#c\nyes=yes\n;\non=on\n ; \nenabled=enabled\n # \ntrue=true\n0=0\nno=no\noff=off\ndisabled=disabled\nfalse=false\n\n[Section1] garbage\nValue1=23\nValue1=35\nValue 2=foo bar ; c\n\n[Section 2]\n\nValue1=34\nValue2=\n\n[Section1]\n;c\n#c\nValue1=34\nValue2=\n"+++testAList = testGroup "AList" [+ testGroup "isEmpty" [+ testCase "True" . assertBool "" . isEmpty $ mempty,+ testCase "False" . assertBool "" . not . isEmpty $ AL.fromList [(1, 2)]+ ],+ testGroup "lookupAll" [+ testCase "empty" $ [] @=? lookupAll 1 (AL.fromList [(2,3)]),+ testCase "singleton" $ [3] @=? lookupAll 2 (AL.fromList [(2,3)]),+ testCase "list"+ $ [3, 5] @=? lookupAll 2 (AL.fromList [(1, 2), (2,3), (3, 4), (2,5)])+ ], + testGroup "lookupFirst" [+ testCase "Something" $ Just 5 @=? lookupFirst 3 (AL.fromList [(3, 5)]),+ testCase "Nothing" $ Nothing @=? lookupFirst 3 (AL.fromList [(2, 5)])+ ],+ testGroup "lookupBy" [+ testCase "empty" $ mempty @=? AL.lookupBy odd (AL.fromList [(2, 3)]),+ testCase "singleton"+ $ AL.fromList [(2, 3)] @=? AL.lookupBy even (AL.fromList [(2, 3)]),+ testCase "list"+ $ lookupBy even (AL.fromList [(1, 2), (2,3), (3, 4), (4, 5)])+ @?= AL.fromList [(2, 3), (4, 5)]+ ],+ testGroup "member" [+ testCase "True" . assertBool "" . member 1 $ AL.fromList [(1, 2)],+ testCase "False" . assertBool "" . not . member 1 $ AL.fromList [(3, 2)]+ ],+ testGroup "values" [+ testCase "empty" $ [] @=? AL.values (mempty :: AList Int Int),+ testCase "singleton" $ [3] @=? AL.values (AL.fromList [(2, 3)]),+ testCase "list" $ [3, 5] @=? AL.values (AL.fromList [(2, 3), (4, 5)])+ ],+ testGroup "keys" [+ testCase "empty" $ [] @=? AL.keys (mempty :: AList Int Int),+ testCase "singleton" $ [2] @=? AL.keys (AL.fromList [(2, 3)]),+ testCase "list" $ [2, 4] @=? AL.keys (AL.fromList [(2, 3), (4, 5)])+ ],+ testGroup "insert" [+ testCase "empty" $ AL.fromList [(1, 2)] @=? insert 1 2 mempty,+ testCase "full"+ $ AL.fromList [(1, 2), (3, 4)] @=? insert 1 2 (AL.fromList [(3, 4)])+ ],+ testGroup "append" [+ testCase "empty" $ AL.fromList [(1, 2)] @=? append 1 2 mempty,+ testCase "full"+ $ AL.fromList [(3, 4), (1, 2)] @=? append 1 2 (AL.fromList [(3, 4)])+ ],+ testGroup "deleteAll" [+ testCase "empty" $ mempty @=? deleteAll 2 (AL.fromList [(2,3)]),+ testCase "singleton"+ $ AL.fromList[(2, 3)] @=? deleteAll 1 (AL.fromList [(2,3)]),+ testCase "list"+ $ deleteAll 2 (AL.fromList [(1, 2), (2,3), (3, 4), (2,5)])+ @?= AL.fromList [(1, 2), (3, 4)]+ ],+ testGroup "deleteFirst" [+ testCase "empty" $ mempty @=? deleteAll 2 (AL.fromList [(2,3)]),+ testCase "singleton"+ $ AL.fromList[(2, 3)] @=? deleteAll 1 (AL.fromList [(2,3)]),+ testCase "list"+ $ deleteFirst 2 (AL.fromList [(1, 2), (2,3), (3, 4), (2,5)])+ @?= AL.fromList [(1, 2), (3, 4), (2, 5)]+ ],+ testGroup "deleteBy" [+ testCase "empty" $ mempty @=? AL.deleteBy even (AL.fromList [(2, 3)]),+ testCase "singleton"+ $ AL.fromList [(2, 3)] @=? AL.deleteBy odd (AL.fromList [(2, 3)]),+ testCase "list"+ $ deleteBy odd (AL.fromList [(1, 2), (2,3), (3, 4), (4, 5)])+ @?= AL.fromList [(2, 3), (4, 5)]+ ],+ testGroup "convert" [+ testCase "fromList"+ $ (AL.insert 1 2 . AL.insert 3 4 $ AL.insert 5 6 mempty)+ @=? AL.fromList [(1, 2), (3, 4), (5, 6)],+ testCase "toList"+ $ AL.toList (AL.insert 1 2 . AL.insert 3 4 $ AL.insert 5 6 mempty)+ @=? [(1, 2), (3, 4), (5, 6)],+ testCase "toMap" $ M.fromList [(1, 2), (3, 4), (5, 6)]+ @=? AL.toMap (AL.fromList[(3, 4), (1, 2), (5, 6)]),+ -- This probably depends on the Map implementation + testCase "fromMap" $ AL.fromMap (M.fromList [(1, 2), (3, 4), (5, 6)])+ @=? (AL.fromList[(1, 2), (3, 4), (5, 6)])+ ]+ ]++testIO = testGroup "IO" [+ testCase "format" $ testString @=? formatConfig test,+ testCase "parse" $ Success test @=? parseConfig testString,+ testCase "comments" $ Success test @=? parseConfig commentString,+ testGroup "errors" [+ testFailure "Missing config" "config" $ parseConfig "=23\n",+ testFailure "Missing section name" "section name" $ parseConfig "[]\nx=23",+ testFailure "Empty section" "option line" $ parseConfig "[a]\n[b]\n",+ testFailure "Broken section name" "\"]\"" $ parseConfig "[a\n",+ testFailure "Missing option name" "new-line" $ parseConfig "[a]\n=23"+ ]+ ]++testCreate = testGroup "create" [+ -- Ought to test config/section/option, but without access to the+ -- constuctors, that would be pointless.+ testCase "default" $ section1 @=? (getDefault $ setDefault test section1),+ testCase "section <+"+ $ section1 @=? mempty <+ ("Value1", "23") <+ ("Value1", "35")+ <+ ("Value 2", "foo bar"),+ testCase "section +>"+ $ section1 @=? ("Value 2", "foo bar") +> ("Value1", "35")+ +> ("Value1", "23") +> mempty,+ testCase "config <+"+ $ test @=? setDefault mempty def <+ ("Section1", section1)+ <+ ("Section 2", section2)+ <+ ("Section1", section2),+ testCase "config +>"+ $ test @=? ("Section1", section2) +> ("Section 2", section2)+ +> ("Section1", section1) +> setDefault mempty def,+ testGroup "update" [+ testCase "defaultValues"+ $ def2 @=? getDefault (updateDefaultValues updateValue test),+ testCase "sectionValues" $ def2 @=? updateSectionValues updateValue def,+ testCase "configValues"+ $ Just ("Updated" :: String) @=? get (updateValues updateSection test)+ (Just "Section 2") "Value1",+ testCase "defaultOptions" + $ def3 @=? getDefault(updateDefaultOptions updateOption test),+ testCase "sectionOptions" $ def3 @=? updateSectionOptions updateOption def,+ testCase "configOptions"+ $ Just ("New" :: String) @=? get (updateOptions updateSO test)+ (Just "Section 2") "Changed"+ ]+ ]++testGet = testGroup "gets" [+ testGroup "get sections" [+ testCase "Default" $ def @=? getDefault test,+ testCase "Section 1" $ Just section2 @=? getSection test "Section 2",+ testCase "Section 2" $ Nothing @=? getSection test "NoSection",+ testCase "Sections 1" $ [] @=? getSections test "NoSection",+ testCase "Sections 2"+ $ [section1, section2] @=? getSections test "Section1",+ testCase "SectionsBy" $+ ["Section 2"] @=? map fst (getSectionsBy test $ elem ' ')+ ],+ testGroup "get" [+ testCase "Nothing" $ (Nothing :: Maybe Int) @=? get test Nothing "NoValue",+ testCase "String"+ $ (Just "12" :: Maybe String) @=? get test Nothing "Value1",+ testGroup "Bool" $ (testError "Error" "couldn't parse '12' as Bool"+ $ (get test Nothing "Value1" :: Maybe Bool)):+ map (\x -> testCase x $ Just True @=? get test Nothing x) trues+ ++ map (\x -> testCase x $ Just False @=? get test Nothing x)+ falses,+ testGroup "List" [+ testCase "[]"+ $ Just ([] :: [Int]) @=? get test (Just "Section1") "NoValue",+ testCase "[x]"+ $ Just ([23, 35] :: [Int])+ @=? get test (Just "Section1") "Value1"+ ],+ testGroup "Num" [+ testCase "Int" $ Just (12 :: Int) @=? get test Nothing "Value1",+ testCase "Float" $ Just (12.0 :: Float) @=? get test Nothing "Value1",+ testError "Error" "couldn't parse 'false'"+ $ (get test Nothing "false" :: Maybe Int)+ ]+ ]+ ]+ ++main :: IO ()+main = defaultMain $ testGroup "All" [testAList, testGet, testCreate, testIO]
+ inilist.cabal view
@@ -0,0 +1,36 @@+name: inilist+version: 0.1.0.0+synopsis: Processing for .ini files with duplicate sections and options+description: Please see README.md+homepage: https://chiselapp.com/user/mwm/repository/inilist+license: BSD3+license-file: LICENSE+author: Mike Meyer+maintainer: mwm@mired.org+-- copyright: +category: Library+build-type: Simple+-- extra-source-files: +cabal-version: >=1.10++library+ hs-source-dirs: .+ exposed-modules: Data.Ini.List, Data.AList+ build-depends: base >= 4.7 && < 5, safe >= 0.3.9, trifecta >= 1.5.1.3,+ bifunctors >= 4.2.1, containers >= 0.5.5.1+ default-language: Haskell2010++test-suite inilist-unittest+ type: exitcode-stdio-1.0+ hs-source-dirs: .+ main-is: UnitTest.hs+ build-depends: tasty >= 0.8, testpack >= 2.1.2.1,+ base >= 4.7, inilist, safe >= 0.3.9, trifecta >= 1.5.1.3,+ deepseq >= 1.3.0.2, HUnit >= 1.2, tasty-hunit >= 0.9,+ bifunctors >= 4.2.1, containers >= 0.5.5.1+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ default-language: Haskell2010++source-repository head+ type: fossil+ location: