config-ini 0.2.4.0 → 0.2.5.0
raw patch · 8 files changed
+1424/−1323 lines, 8 filesdep ~inidep ~textdep ~transformersPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependency ranges changed: ini, text, transformers
API changes (from Hackage documentation)
- Data.Ini.Config.Bidir: (&) :: () => a -> (a -> b) -> b
+ Data.Ini.Config.Bidir: (&) :: a -> (a -> b) -> b
Files
- config-ini.cabal +5/−4
- src/Data/Ini/Config.hs +201/−177
- src/Data/Ini/Config/Bidir.hs +992/−938
- src/Data/Ini/Config/Raw.hs +144/−133
- test/doctest/Main.hs +1/−1
- test/ini-compat/Main.hs +54/−44
- test/prewritten/Main.hs +20/−19
- test/prewritten/cases/basic.hs +7/−7
config-ini.cabal view
@@ -1,5 +1,5 @@ name: config-ini-version: 0.2.4.0+version: 0.2.5.0 synopsis: A library for simple INI-based configuration files. homepage: https://github.com/aisamanra/config-ini bug-reports: https://github.com/aisamanra/config-ini/issues@@ -22,6 +22,7 @@ category: Configuration build-type: Simple cabal-version: 1.18+tested-with: GHC == 8.8.4, GHC == 8.10.7, GHC == 9.0.2, GHC == 9.2.4, GHC == 9.4.2 extra-source-files: README.md, CHANGELOG.md,@@ -46,10 +47,10 @@ ghc-options: -fno-warn-redundant-constraints build-depends: base >=4.8 && <5 , containers >=0.5 && <0.7- , text >=1.2.2 && <1.3+ , text >=1.2.2 && <2.1 , unordered-containers >=0.2.7 && <0.3 , transformers >=0.4.1 && <0.6- , megaparsec >=7 && <8+ , megaparsec >=7 && <10 default-language: Haskell2010 test-suite test-ini-compat@@ -59,7 +60,7 @@ hs-source-dirs: test/ini-compat main-is: Main.hs build-depends: base- , ini+ , ini >=0.4 , config-ini , hedgehog , containers
src/Data/Ini/Config.hs view
@@ -1,125 +1,131 @@-{-|-Module : Data.Ini.Config-Copyright : (c) Getty Ritter, 2017-License : BSD-Maintainer : Getty Ritter <config-ini@infinitenegativeutility.com>-Stability : experimental--The 'config-ini' library exports some simple monadic functions to-make parsing INI-like configuration easier. INI files have a-two-level structure: the top-level named chunks of configuration,-and the individual key-value pairs contained within those chunks.-For example, the following INI file has two sections, @NETWORK@-and @LOCAL@, and each contains its own key-value pairs. Comments,-which begin with @#@ or @;@, are ignored:--> [NETWORK]-> host = example.com-> port = 7878->-> # here is a comment-> [LOCAL]-> user = terry--The combinators provided here are designed to write quick and-idiomatic parsers for files of this form. Sections are parsed by-'IniParser' computations, like 'section' and its variations,-while the fields within sections are parsed by 'SectionParser'-computations, like 'field' and its variations. If we want to-parse an INI file like the one above, treating the entire-@LOCAL@ section as optional, we can write it like this:--> data Config = Config-> { cfNetwork :: NetworkConfig, cfLocal :: Maybe LocalConfig }-> deriving (Eq, Show)->-> data NetworkConfig = NetworkConfig-> { netHost :: String, netPort :: Int }-> deriving (Eq, Show)->-> data LocalConfig = LocalConfig-> { localUser :: Text }-> deriving (Eq, Show)->-> configParser :: IniParser Config-> configParser = do-> netCf <- section "NETWORK" $ do-> host <- fieldOf "host" string-> port <- fieldOf "port" number-> return NetworkConfig { netHost = host, netPort = port }-> locCf <- sectionMb "LOCAL" $-> LocalConfig <$> field "user"-> return Config { cfNetwork = netCf, cfLocal = locCf }-+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-} -We can run our computation with 'parseIniFile', which,-when run on our example file above, would produce the-following:+-- |+-- Module : Data.Ini.Config+-- Copyright : (c) Getty Ritter, 2017+-- License : BSD+-- Maintainer : Getty Ritter <config-ini@infinitenegativeutility.com>+-- Stability : experimental+--+-- The 'config-ini' library exports some simple monadic functions to+-- make parsing INI-like configuration easier. INI files have a+-- two-level structure: the top-level named chunks of configuration,+-- and the individual key-value pairs contained within those chunks.+-- For example, the following INI file has two sections, @NETWORK@+-- and @LOCAL@, and each contains its own key-value pairs. Comments,+-- which begin with @#@ or @;@, are ignored:+--+-- > [NETWORK]+-- > host = example.com+-- > port = 7878+-- >+-- > # here is a comment+-- > [LOCAL]+-- > user = terry+--+-- The combinators provided here are designed to write quick and+-- idiomatic parsers for files of this form. Sections are parsed by+-- 'IniParser' computations, like 'section' and its variations,+-- while the fields within sections are parsed by 'SectionParser'+-- computations, like 'field' and its variations. If we want to+-- parse an INI file like the one above, treating the entire+-- @LOCAL@ section as optional, we can write it like this:+--+-- > data Config = Config+-- > { cfNetwork :: NetworkConfig, cfLocal :: Maybe LocalConfig }+-- > deriving (Eq, Show)+-- >+-- > data NetworkConfig = NetworkConfig+-- > { netHost :: String, netPort :: Int }+-- > deriving (Eq, Show)+-- >+-- > data LocalConfig = LocalConfig+-- > { localUser :: Text }+-- > deriving (Eq, Show)+-- >+-- > configParser :: IniParser Config+-- > configParser = do+-- > netCf <- section "NETWORK" $ do+-- > host <- fieldOf "host" string+-- > port <- fieldOf "port" number+-- > return NetworkConfig { netHost = host, netPort = port }+-- > locCf <- sectionMb "LOCAL" $+-- > LocalConfig <$> field "user"+-- > return Config { cfNetwork = netCf, cfLocal = locCf }+--+--+-- We can run our computation with 'parseIniFile', which,+-- when run on our example file above, would produce the+-- following:+--+-- >>> parseIniFile example configParser+-- Right (Config {cfNetwork = NetworkConfig {netHost = "example.com", netPort = 7878}, cfLocal = Just (LocalConfig {localUser = "terry"})})+module Data.Ini.Config+ ( -- * Parsing Files+ parseIniFile, ->>> parseIniFile example configParser-Right (Config {cfNetwork = NetworkConfig {netHost = "example.com", netPort = 7878}, cfLocal = Just (LocalConfig {localUser = "terry"})})+ -- * Parser Types+ IniParser,+ SectionParser, --}+ -- * Section-Level Parsing+ section,+ sections,+ sectionOf,+ sectionsOf,+ sectionMb,+ sectionDef, -{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}+ -- * Field-Level Parsing+ field,+ fieldOf,+ fieldMb,+ fieldMbOf,+ fieldDef,+ fieldDefOf,+ fieldFlag,+ fieldFlagDef, -module Data.Ini.Config-(--- * Parsing Files- parseIniFile--- * Parser Types-, IniParser-, SectionParser--- * Section-Level Parsing-, section-, sections-, sectionOf-, sectionsOf-, sectionMb-, sectionDef--- * Field-Level Parsing-, field-, fieldOf-, fieldMb-, fieldMbOf-, fieldDef-, fieldDefOf-, fieldFlag-, fieldFlagDef--- * Reader Functions-, readable-, number-, string-, flag-, listWithSeparator-) where+ -- * Reader Functions+ readable,+ number,+ string,+ flag,+ listWithSeparator,+ )+where -import Control.Applicative (Alternative(..))-import Control.Monad.Trans.Except-import Data.Ini.Config.Raw-import Data.Sequence (Seq)+import Control.Applicative (Alternative (..))+import Control.Monad.Trans.Except+import Data.Ini.Config.Raw+import Data.Sequence (Seq) import qualified Data.Sequence as Seq-import Data.String (IsString(..))-import Data.Text (Text)+import Data.String (IsString (..))+import Data.Text (Text) import qualified Data.Text as T-import Data.Typeable (Typeable, Proxy(..), typeRep)-import GHC.Exts (IsList(..))-import Text.Read (readMaybe)+import Data.Typeable (Proxy (..), Typeable, typeRep)+import GHC.Exts (IsList (..))+import Text.Read (readMaybe) lkp :: NormalizedText -> Seq (NormalizedText, a) -> Maybe a lkp t = go . Seq.viewl- where go ((t', x) Seq.:< rs)- | t == t' = Just x- | otherwise = go (Seq.viewl rs)- go Seq.EmptyL = Nothing+ where+ go ((t', x) Seq.:< rs)+ | t == t' = Just x+ | otherwise = go (Seq.viewl rs)+ go Seq.EmptyL = Nothing addLineInformation :: Int -> Text -> StParser s a -> StParser s a addLineInformation lineNo sec = withExceptT go- where go e = "Line " ++ show lineNo ++- ", in section " ++ show sec ++- ": " ++ e+ where+ go e =+ "Line " ++ show lineNo+ ++ ", in section "+ ++ show sec+ ++ ": "+ ++ e type StParser s a = ExceptT String ((->) s) a @@ -149,10 +155,11 @@ -- >>> parseIniFile "[ONE]\nx = hello\n" $ section "TWO" (field "x") -- Left "No top-level section named \"TWO\"" section :: Text -> SectionParser a -> IniParser a-section name (SectionParser thunk) = IniParser $ ExceptT $ \(RawIni ini) ->- case lkp (normalize name) ini of- Nothing -> Left ("No top-level section named " ++ show name)- Just sec -> runExceptT thunk sec+section name (SectionParser thunk) = IniParser $+ ExceptT $ \(RawIni ini) ->+ case lkp (normalize name) ini of+ Nothing -> Left ("No top-level section named " ++ show name)+ Just sec -> runExceptT thunk sec -- | Find multiple named sections in the INI file and parse them all -- with the provided section parser. In order to support classic INI@@ -164,10 +171,12 @@ -- >>> parseIniFile "[ONE]\nx = hello\n" $ sections "TWO" (field "x") -- Right (fromList []) sections :: Text -> SectionParser a -> IniParser (Seq a)-sections name (SectionParser thunk) = IniParser $ ExceptT $ \(RawIni ini) ->- let name' = normalize name- in mapM (runExceptT thunk . snd)- (Seq.filter (\ (t, _) -> t == name') ini)+sections name (SectionParser thunk) = IniParser $+ ExceptT $ \(RawIni ini) ->+ let name' = normalize name+ in mapM+ (runExceptT thunk . snd)+ (Seq.filter (\(t, _) -> t == name') ini) -- | A call to @sectionOf f@ will apply @f@ to each section name and, -- if @f@ produces a "Just" value, pass the extracted value in order@@ -180,15 +189,15 @@ -- >>> parseIniFile "[BAR]\nx = hello\n" $ sectionOf (T.stripSuffix "OO") (\ l -> fmap ((,) l) (field "x")) -- Left "No matching top-level section" sectionOf :: (Text -> Maybe b) -> (b -> SectionParser a) -> IniParser a-sectionOf fn sectionParser = IniParser $ ExceptT $ \(RawIni ini) ->- let go Seq.EmptyL = Left "No matching top-level section"- go ((t, sec) Seq.:< rs)- | Just v <- fn (actualText t) =+sectionOf fn sectionParser = IniParser $+ ExceptT $ \(RawIni ini) ->+ let go Seq.EmptyL = Left "No matching top-level section"+ go ((t, sec) Seq.:< rs)+ | Just v <- fn (actualText t) = let SectionParser thunk = sectionParser v- in runExceptT thunk sec- | otherwise = go (Seq.viewl rs)- in go (Seq.viewl ini)-+ in runExceptT thunk sec+ | otherwise = go (Seq.viewl rs)+ in go (Seq.viewl ini) -- | A call to @sectionsOf f@ will apply @f@ to each section name and, -- if @f@ produces a @Just@ value, pass the extracted value in order@@ -201,17 +210,18 @@ -- >>> parseIniFile "[BAR]\nx = hello\n" $ sectionsOf (T.stripSuffix "OO") (\ l -> fmap ((,) l) (field "x")) -- Right (fromList []) sectionsOf :: (Text -> Maybe b) -> (b -> SectionParser a) -> IniParser (Seq a)-sectionsOf fn sectionParser = IniParser $ ExceptT $ \(RawIni ini) ->- let go Seq.EmptyL = return Seq.empty- go ((t, sec) Seq.:< rs)- | Just v <- fn (actualText t) =+sectionsOf fn sectionParser = IniParser $+ ExceptT $ \(RawIni ini) ->+ let go Seq.EmptyL = return Seq.empty+ go ((t, sec) Seq.:< rs)+ | Just v <- fn (actualText t) = let SectionParser thunk = sectionParser v- in do- x <- runExceptT thunk sec- xs <- go (Seq.viewl rs)- return (x Seq.<| xs)- | otherwise = go (Seq.viewl rs)- in go (Seq.viewl ini)+ in do+ x <- runExceptT thunk sec+ xs <- go (Seq.viewl rs)+ return (x Seq.<| xs)+ | otherwise = go (Seq.viewl rs)+ in go (Seq.viewl ini) -- | Find a named section in the INI file and parse it with the provided -- section parser, returning 'Nothing' if the section does not exist.@@ -224,10 +234,11 @@ -- >>> parseIniFile "[ONE]\nx = hello\n" $ sectionMb "TWO" (field "x") -- Right Nothing sectionMb :: Text -> SectionParser a -> IniParser (Maybe a)-sectionMb name (SectionParser thunk) = IniParser $ ExceptT $ \(RawIni ini) ->- case lkp (normalize name) ini of- Nothing -> return Nothing- Just sec -> Just `fmap` runExceptT thunk sec+sectionMb name (SectionParser thunk) = IniParser $+ ExceptT $ \(RawIni ini) ->+ case lkp (normalize name) ini of+ Nothing -> return Nothing+ Just sec -> Just `fmap` runExceptT thunk sec -- | Find a named section in the INI file and parse it with the provided -- section parser, returning a default value if the section does not exist.@@ -240,18 +251,19 @@ -- >>> parseIniFile "[ONE]\nx = hello\n" $ sectionDef "TWO" "def" (field "x") -- Right "def" sectionDef :: Text -> a -> SectionParser a -> IniParser a-sectionDef name def (SectionParser thunk) = IniParser $ ExceptT $ \(RawIni ini) ->- case lkp (normalize name) ini of- Nothing -> return def- Just sec -> runExceptT thunk sec+sectionDef name def (SectionParser thunk) = IniParser $+ ExceptT $ \(RawIni ini) ->+ case lkp (normalize name) ini of+ Nothing -> return def+ Just sec -> runExceptT thunk sec --- throw :: String -> StParser s a-throw msg = ExceptT $ (\ _ -> Left msg)+throw msg = ExceptT (\_ -> Left msg) getSectionName :: StParser IniSection Text-getSectionName = ExceptT $ (\ m -> return (isName m))+getSectionName = ExceptT (return . isName) rawFieldMb :: Text -> StParser IniSection (Maybe IniValue) rawFieldMb name = ExceptT $ \m ->@@ -259,12 +271,16 @@ rawField :: Text -> StParser IniSection IniValue rawField name = do- sec <- getSectionName+ sec <- getSectionName valMb <- rawFieldMb name case valMb of- Nothing -> throw ("Missing field " ++ show name ++- " in section " ++ show sec)- Just x -> return x+ Nothing ->+ throw+ ( "Missing field " ++ show name+ ++ " in section "+ ++ show sec+ )+ Just x -> return x getVal :: IniValue -> Text getVal = T.strip . vValue@@ -294,7 +310,7 @@ val <- rawField name case parse (getVal val) of Left err -> addLineInformation (vLineNo val) sec (throw err)- Right x -> return x+ Right x -> return x -- | Retrieve a field, returning a @Nothing@ value if it does not exist. --@@ -320,10 +336,10 @@ sec <- getSectionName mb <- rawFieldMb name case mb of- Nothing -> return Nothing+ Nothing -> return Nothing Just v -> case parse (getVal v) of Left err -> addLineInformation (vLineNo v) sec (throw err)- Right x -> return (Just x)+ Right x -> return (Just x) -- | Retrieve a field and supply a default value for if it doesn't exist. --@@ -332,10 +348,11 @@ -- >>> parseIniFile "[MAIN]\nx = hello\n" $ section "MAIN" (fieldDef "y" "def") -- Right "def" fieldDef :: Text -> Text -> SectionParser Text-fieldDef name def = SectionParser $ ExceptT $ \m ->- case lkp (normalize name) (isVals m) of- Nothing -> return def- Just x -> return (getVal x)+fieldDef name def = SectionParser $+ ExceptT $ \m ->+ case lkp (normalize name) (isVals m) of+ Nothing -> return def+ Just x -> return (getVal x) -- | Retrieve a field, parsing it according to the given parser, and returning -- a default value if it does not exist. If the parser fails, then this will@@ -352,10 +369,10 @@ sec <- getSectionName mb <- rawFieldMb name case mb of- Nothing -> return def+ Nothing -> return def Just v -> case parse (getVal v) of Left err -> addLineInformation (vLineNo v) sec (throw err)- Right x -> return x+ Right x -> return x -- | Retrieve a field and treat it as a boolean, failing if it -- does not exist.@@ -377,7 +394,7 @@ -- >>> parseIniFile "[MAIN]\nx = yes\n" $ section "MAIN" (fieldFlagDef "y" False) -- Right False fieldFlagDef :: Text -> Bool -> SectionParser Bool-fieldFlagDef name def = fieldDefOf name flag def+fieldFlagDef name = fieldDefOf name flag --- @@ -390,13 +407,18 @@ -- Left "Unable to parse \"hello\" as a value of type (Int,Int)" readable :: forall a. (Read a, Typeable a) => Text -> Either String a readable t = case readMaybe str of- Just v -> Right v- Nothing -> Left ("Unable to parse " ++ show str ++- " as a value of type " ++ show typ)- where str = T.unpack t- typ = typeRep prx- prx :: Proxy a- prx = Proxy+ Just v -> Right v+ Nothing ->+ Left+ ( "Unable to parse " ++ show str+ ++ " as a value of type "+ ++ show typ+ )+ where+ str = T.unpack t+ typ = typeRep prx+ prx :: Proxy a+ prx = Proxy -- | Try to use the "Read" instance for a numeric type to parse a value, -- failing with a human-readable error message if reading fails.@@ -434,15 +456,15 @@ -- Left "Unable to parse \"That's a secret!\" as a boolean" flag :: Text -> Either String Bool flag s = case T.toLower s of- "true" -> Right True- "yes" -> Right True- "t" -> Right True- "y" -> Right True+ "true" -> Right True+ "yes" -> Right True+ "t" -> Right True+ "y" -> Right True "false" -> Right False- "no" -> Right False- "f" -> Right False- "n" -> Right False- _ -> Left ("Unable to parse " ++ show s ++ " as a boolean")+ "no" -> Right False+ "f" -> Right False+ "n" -> Right False+ _ -> Left ("Unable to parse " ++ show s ++ " as a boolean") -- | Convert a reader for a value into a reader for a list of those -- values, separated by a chosen separator. This will split apart@@ -462,10 +484,12 @@ -- Right ["/bin","/usr/bin"] -- >>> listWithSeparator "," number "7 8 9" :: Either String [Int] -- Left "Unable to parse \"7 8 9\" as a value of type Int"-listWithSeparator :: (IsList l)- => Text- -> (Text -> Either String (Item l))- -> Text -> Either String l+listWithSeparator ::+ (IsList l) =>+ Text ->+ (Text -> Either String (Item l)) ->+ Text ->+ Either String l listWithSeparator sep rd = fmap fromList . mapM (rd . T.strip) . T.splitOn sep
src/Data/Ini/Config/Bidir.hs view
@@ -1,941 +1,995 @@-{-|-Module : Data.Ini.Config.Bidir-Copyright : (c) Getty Ritter, 2017-License : BSD-Maintainer : Getty Ritter <config-ini@infinitenegativeutility.com>-Stability : experimental--This module presents an alternate API for parsing INI files. Unlike-the standard API, it is bidirectional: the same declarative structure-can be used to parse an INI file to a value, serialize an INI file-from a value, or even /update/ an INI file by comparing it against a-value and serializing in a way that minimizes the differences between-revisions of the file.--This API does make some extra assumptions about your configuration-type and the way you interact with it: in particular, it assumes that-you have lenses for all the fields you're parsing and that you have-some kind of sensible default value of that configuration-type. Instead of providing combinators which can extract and parse a-field of an INI file into a value, the bidirectional API allows you to-declaratively associate a lens into your structure with a field of the-INI file.--Consider the following example INI file:--> [NETWORK]-> host = example.com-> port = 7878->-> [LOCAL]-> user = terry--We'd like to parse this INI file into a @Config@ type which we've-defined like this, using-<https://hackage.haskell.org/package/lens lens> or a similar library-to provide lenses:--> data Config = Config-> { _cfHost :: String-> , _cfPort :: Int-> , _cfUser :: Maybe Text-> } deriving (Eq, Show)->-> ''makeLenses Config--We can now define a basic specification of the type @'IniSpec' Config-()@ by using the provided operations to declare our top-level-sections, and then within those sections we can associate fields with-@Config@ lenses.--@-'configSpec' :: 'IniSpec' Config ()-'configSpec' = do- 'section' \"NETWORK\" $ do- cfHost '.=' 'field' \"host\" 'string'- cfPost '.=' 'field' \"port\" 'number'- 'sectionOpt' \"LOCAL\" $ do- cfUser '.=?' 'field' \"user\" 'text'-@--There are two operators used to associate lenses with fields:--['.='] Associates a lens of type @Lens' s a@ with a field description- of type @FieldDescription a@. By default, this will raise an- error when parsing if the field described is missing, but we- can mark it as optional, as we'll see.--['.=?'] Associates a lens of type @Lens' s (Maybe a)@ with a field- description of type @FieldDescription a@. During parsing, if- the value does not appear in an INI file, then the lens will- be set to 'Nothing'; similarly, during serializing, if the- value is 'Nothing', then the field will not be serialized in- the file.--Each field must include the field's name as well as a 'FieldValue',-which describes how to both parse and serialize a value of a given-type. Several built-in 'FieldValue' descriptions are provided, but you-can always build your own by providing parsing and serialization-functions for individual fields.--We can also provide extra metadata about a field, allowing it to be-skipped durin parsing, or to provide an explicit default value, or to-include an explanatory comment for that value to be used when we-serialize an INI file. These are conventionally applied to the field-using the '&' operator:--@-configSpec :: 'IniSpec' Config ()-configSpec = do- 'section' \"NETWORK\" $ do- cfHost '.=' 'field' \"host\" 'string'- & 'comment' [\"The desired hostname (optional)\"]- & 'optional'- cfPost '.=' 'field' \"port\" 'number'- & 'comment' [\"The port number\"]- 'sectionOpt' \"LOCAL\" $ do- cfUser '.=?' 'field' \"user\" 'text'-@--When we want to use this specification, we need to create a value of-type 'Ini', which is an abstract representation of an INI-specification. To create an 'Ini' value, we need to use the 'ini'-function, which combines the spec with the default version of our-configuration value.--Once we have a value of type 'Ini', we can use it for three basic-operations:--* We can parse a textual INI file with 'parseIni', which will- systematically walk the spec and use the provided lens/field- associations to create a parsed configuration file. This will give- us a new value of type 'Ini' that represents the parsed- configuration, and we can extract the actual configuration value- with 'getIniValue'.--* We can update the value contained in an 'Ini' value. If the 'Ini'- value is the result of a previous call to 'parseIni', then this- update will attempt to retain as much of the incidental structure of- the parsed file as it can: for example, it will attempt to retain- comments, whitespace, and ordering. The general strategy is to make- the resulting INI file "diff-minimal": the diff between the older- INI file and the updated INI file should contain as little noise as- possible. Small cosmetic choices such as how to treat generated- comments are controlled by a configurable 'UpdatePolicy' value.--* We can serialize an 'Ini' value to a textual INI file. This will- produce the specified INI file (either a default fresh INI, or a- modified existing INI) as a textual value.---}--{-# LANGUAGE CPP #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE MultiWayIf #-}--module Data.Ini.Config.Bidir-(--- * Parsing, Serializing, and Updating Files--- $using- Ini-, ini-, getIniValue-, iniValueL-, getRawIni--- ** Parsing INI files-, parseIni--- ** Serializing INI files-, serializeIni--- ** Updating INI Files-, updateIni-, setIniUpdatePolicy-, UpdatePolicy(..)-, UpdateCommentPolicy(..)-, defaultUpdatePolicy--- * Bidirectional Parser Types--- $types-, IniSpec-, SectionSpec---- * Section-Level Parsing--- $sections-, section-, allOptional---- * Field-Level Parsing--- $fields-, FieldDescription-, (.=)-, (.=?)-, field-, flag-, comment-, placeholderValue-, optional---- * FieldValues--- $fieldvalues-, FieldValue(..)-, text-, string-, number-, bool-, readable-, listWithSeparator-, pairWithSeparator---- * Miscellaneous Helpers--- $misc-, (&)-, Lens--) where--import Control.Monad.Trans.State.Strict (State, runState, modify)-import qualified Control.Monad.Trans.State.Strict as State-import qualified Data.Foldable as F-#if __GLASGOW_HASKELL__ >= 710-import Data.Function ((&))-#endif-import Data.Monoid ((<>))-import Data.Sequence ((<|), Seq, ViewL(..), ViewR(..))-import qualified Data.Sequence as Seq-import Data.Text (Text)-import qualified Data.Text as T-import qualified Data.Traversable as F-import Data.Typeable (Typeable, Proxy(..), typeRep)-import GHC.Exts (IsList(..))-import Text.Read (readMaybe)--import Data.Ini.Config.Raw---- * Utility functions + lens stuffs---- | This is a--- <https://hackage.haskell.org/package/lens lens>-compatible--- type alias-type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t---- These are some inline reimplementations of "lens" operators. We--- need the identity functor to implement 'set':-newtype I a = I { fromI :: a }-instance Functor I where fmap f (I x) = I (f x)--set :: Lens s t a b -> b -> s -> t-set lns x a = fromI (lns (const (I x)) a)---- ... and we need the const functor to implement 'get':-newtype C a b = C { fromC :: a }-instance Functor (C a) where fmap _ (C x) = C x--get :: Lens s t a b -> s -> a-get lns a = fromC (lns C a)--lkp :: NormalizedText -> Seq (NormalizedText, a) -> Maybe a-lkp t = fmap snd . F.find (\ (t', _) -> t' == t)--rmv :: NormalizedText -> Seq (Field s) -> Seq (Field s)-rmv n = Seq.filter (\ f -> fieldName f /= n)---- The & operator is really useful here, but it didn't show up in--- earlier versions, so it gets redefined here.-#if __GLASGOW_HASKELL__ < 710-{- | '&' is a reverse application operator. This provides notational- convenience. Its precedence is one higher than that of the- forward application operator '$', which allows '&' to be nested- in '$'. -}-(&) :: a -> (a -> b) -> b-a & f = f a-infixl 1 &-#endif---- * The 'Ini' type---- | An 'Ini' is an abstract representation of an INI file, including--- both its textual representation and the Haskell value it--- represents.-data Ini s = Ini- { iniSpec :: Spec s- , iniCurr :: s- , iniDef :: s- , iniLast :: Maybe RawIni- , iniPol :: UpdatePolicy- }---- | Create a basic 'Ini' value from a default value and a spec.-ini :: s -> IniSpec s () -> Ini s-ini def (IniSpec spec) = Ini- { iniSpec = runBidirM spec- , iniCurr = def- , iniDef = def- , iniLast = Nothing- , iniPol = defaultUpdatePolicy- }---- | Get the underlying Haskell value associated with the 'Ini'.-getIniValue :: Ini s -> s-getIniValue = iniCurr--mkLens :: (a -> b) -> (b -> a -> a) -> Lens a a b b-mkLens get' set' f a = (`set'` a) `fmap` f (get' a)---- | The lens equivalent of 'getIniValue'-iniValueL :: Lens (Ini s) (Ini s) s s-iniValueL = mkLens iniCurr (\ i v -> v { iniCurr = i })---- | Get the textual representation of an 'Ini' value. If this 'Ini'--- value is the result of 'parseIni', then it will attempt to retain--- the textual characteristics of the parsed version as much as--- possible (e.g. by retaining comments, ordering, and whitespace in a--- way that will minimize the overall diff footprint.) If the 'Ini'--- value was created directly from a value and a specification, then--- it will pretty-print an initial version of the file with the--- comments and placeholder text specified in the spec.-serializeIni :: Ini s -> Text-serializeIni = printRawIni . getRawIni---- | Get the underlying 'RawIni' value for the file.-getRawIni :: Ini s -> RawIni-getRawIni (Ini { iniLast = Just raw }) = raw-getRawIni (Ini { iniCurr = s- , iniSpec = spec- }) = emitIniFile s spec---- | Parse a textual representation of an 'Ini' file. If the file is--- malformed or if an obligatory field is not found, this will produce--- a human-readable error message. If an optional field is not found,--- then it will fall back on the existing value contained in the--- provided 'Ini' structure.-parseIni :: Text -> Ini s -> Either String (Ini s)-parseIni t i@Ini { iniSpec = spec- , iniCurr = def- } = do- RawIni raw <- parseRawIni t- s <- parseSections def (Seq.viewl spec) raw- return $ i- { iniCurr = s- , iniLast = Just (RawIni raw)- }---- | Update the internal value of an 'Ini' file. If this 'Ini' value--- is the result of 'parseIni', then the resulting 'Ini' value will--- attempt to retain the textual characteristics of the parsed version--- as much as possible (e.g. by retaining comments, ordering, and--- whitespace in a way that will minimize the overall diff footprint.)-updateIni :: s -> Ini s -> Ini s-updateIni new i =- case doUpdateIni new i of- Left err -> error err- Right i' -> i'---- | Use the provided 'UpdatePolicy' as a guide when creating future--- updated versions of the given 'Ini' value.-setIniUpdatePolicy :: UpdatePolicy -> Ini s -> Ini s-setIniUpdatePolicy pol i = i { iniPol = pol }---- * Type definitions---- | A value of type 'FieldValue' packages up a parser and emitter--- function into a single value. These are used for bidirectional--- parsing and emitting of the value of a field.-data FieldValue a = FieldValue- { fvParse :: Text -> Either String a- -- ^ The function to use when parsing the value of a field; if- -- the parser fails, then the string will be shown as an error- -- message to the user.- , fvEmit :: a -> Text- -- ^ The function to use when serializing a value into an INI- -- file.- }---- This is actually being used as a writer monad, but using a state--- monad lets us avoid the space leaks. Not that those are likely to--- be a problem in this application, but it's not like it cost us--- none.-type BidirM s a = State (Seq s) a--runBidirM :: BidirM s a -> Seq s-runBidirM = snd . flip runState Seq.empty--type Spec s = Seq (Section s)---- | An 'IniSpec' value represents the structure of an entire--- INI-format file in a declarative way. The @s@ parameter represents--- the type of a Haskell structure which is being serialized to or--- from.-newtype IniSpec s a = IniSpec (BidirM (Section s) a)- deriving (Functor, Applicative, Monad)---- | A 'SectionSpec' value represents the structure of a single--- section of an INI-format file in a declarative way. The @s@--- parameter represents the type of a Haskell structure which is being--- serialized to or from.-newtype SectionSpec s a = SectionSpec (BidirM (Field s) a)- deriving (Functor, Applicative, Monad)---- * Sections---- | Define the specification of a top-level INI section.-section :: Text -> SectionSpec s () -> IniSpec s ()-section name (SectionSpec mote) = IniSpec $ do- let fields = runBidirM mote- modify (Seq.|> Section (normalize name) fields (allFieldsOptional fields))--allFieldsOptional :: (Seq (Field s)) -> Bool-allFieldsOptional = all isOptional- where isOptional (Field _ fd) = fdSkipIfMissing fd- isOptional (FieldMb _ _) = True---- | Treat an entire section as containing entirely optional fields.-allOptional- :: (SectionSpec s () -> IniSpec s ())- -> (SectionSpec s () -> IniSpec s ())-allOptional k spec = IniSpec $ do- let IniSpec comp = k spec- comp- modify (\ s -> case Seq.viewr s of- EmptyR -> s- rs :> Section name fields _ ->- rs Seq.|> Section name (fmap makeOptional fields) True)--makeOptional :: Field s -> Field s-makeOptional (Field l d) = Field l d { fdSkipIfMissing = True }-makeOptional (FieldMb l d) = FieldMb l d { fdSkipIfMissing = True }--data Section s = Section NormalizedText (Seq (Field s)) Bool---- * Fields---- | A "Field" is a description of-data Field s- = forall a. Eq a => Field (Lens s s a a) (FieldDescription a)- | forall a. Eq a => FieldMb (Lens s s (Maybe a) (Maybe a)) (FieldDescription a)---- convenience accessors for things in a Field-fieldName :: Field s -> NormalizedText-fieldName (Field _ FieldDescription { fdName = n }) = n-fieldName (FieldMb _ FieldDescription { fdName = n }) = n--fieldComment :: Field s -> Seq Text-fieldComment (Field _ FieldDescription { fdComment = n }) = n-fieldComment (FieldMb _ FieldDescription { fdComment = n }) = n---- | A 'FieldDescription' is a declarative representation of the--- structure of a field. This includes the name of the field and the--- 'FieldValue' used to parse and serialize values of that field, as--- well as other metadata that might be needed in the course of--- parsing or serializing a structure.-data FieldDescription t = FieldDescription- { fdName :: NormalizedText- , fdValue :: FieldValue t- , fdComment :: Seq Text- , fdDummy :: Maybe Text- , fdSkipIfMissing :: Bool- }---- ** Field operators--{- |-Associate a field description with a field. If this field-is not present when parsing, it will attempt to fall back-on a default, and if no default value is present, it will-fail to parse.--When serializing an INI file, this will produce all the-comments associated with the field description followed-by the value of the field in the.--}-(.=) :: Eq t => Lens s s t t -> FieldDescription t -> SectionSpec s ()-l .= f = SectionSpec $ modify (Seq.|> fd)- where fd = Field l f--{- |-Associate a field description with a field of type "Maybe a".-When parsing, this field will be initialized to "Nothing" if-it is not found, and to a "Just" value if it is. When-serializing an INI file, this will try to serialize a value--}-(.=?) :: Eq t => Lens s s (Maybe t) (Maybe t) -> FieldDescription t -> SectionSpec s ()-l .=? f = SectionSpec $ modify (Seq.|> fd)- where fd = FieldMb l f---- ** Field metadata--{- |-Associate a multiline comment with a "FieldDescription". When-serializing a field that has a comment associated, the comment will-appear before the field.--}-comment :: [Text] -> FieldDescription t -> FieldDescription t-comment cmt fd = fd { fdComment = Seq.fromList cmt }---- | Choose a placeholder value to be displayed for optional fields.--- This is used when serializing an optional Ini field: the--- field will appear commented out in the output using the--- placeholder text as a value, so a spec that includes------ @--- myLens .=? field "x" & placeholderValue "\<val\>"--- @------ will serialize into an INI file that contains the line------ @--- # x = \<val\>--- @------ A placeholder value will only appear in the serialized output if--- the field is optional, but will be preferred over serializing the--- default value for an optional field. This will not affect INI--- file updates.-placeholderValue :: Text -> FieldDescription t -> FieldDescription t-placeholderValue t fd = fd { fdDummy = Just t }---- | If the field is not found in parsing, simply skip instead of--- raising an error or setting anything.-optional :: FieldDescription t -> FieldDescription t-optional fd = fd { fdSkipIfMissing = True }--infixr 0 .=-infixr 0 .=?---- ** Creating fields---- | Create a description of a field by a combination of the name of--- the field and a "FieldValue" describing how to parse and emit--- values associated with that field.-field :: Text -> FieldValue a -> FieldDescription a-field name value = FieldDescription- { fdName = normalize (name <> " ")- , fdValue = value- , fdComment = Seq.empty- , fdDummy = Nothing- , fdSkipIfMissing = False- }---- | Create a description of a 'Bool'-valued field.-flag :: Text -> FieldDescription Bool-flag name = field name bool---- ** FieldValues---- | A "FieldValue" for parsing and serializing values according to--- the logic of the "Read" and "Show" instances for that type,--- providing a convenient human-readable error message if the--- parsing step fails.-readable :: forall a. (Show a, Read a, Typeable a) => FieldValue a-readable = FieldValue { fvParse = parse, fvEmit = emit }- where emit = T.pack . show- parse t = case readMaybe (T.unpack t) of- Just v -> Right v- Nothing -> Left ("Unable to parse " ++ show t ++- " as a value of type " ++ show typ)- typ = typeRep (prx)- prx :: Proxy a- prx = Proxy---- | Represents a numeric field whose value is parsed according to the--- 'Read' implementation for that type, and is serialized according to--- the 'Show' implementation for that type.-number :: (Show a, Read a, Num a, Typeable a) => FieldValue a-number = readable---- | Represents a field whose value is a 'Text' value-text :: FieldValue Text-text = FieldValue { fvParse = Right, fvEmit = id }---- | Represents a field whose value is a 'String' value-string :: FieldValue String-string = FieldValue { fvParse = Right . T.unpack, fvEmit = T.pack }---- | Represents a field whose value is a 'Bool' value. This parser is--- case-insensitive, and matches the words @true@, @false@, @yes@, and--- @no@, as well as single-letter abbreviations for all of the--- above. This will serialize as @true@ for 'True' and @false@ for--- 'False'.-bool :: FieldValue Bool-bool = FieldValue { fvParse = parse, fvEmit = emit }- where parse s = case T.toLower s of- "true" -> Right True- "yes" -> Right True- "t" -> Right True- "y" -> Right True- "false" -> Right False- "no" -> Right False- "f" -> Right False- "n" -> Right False- _ -> Left ("Unable to parse " ++ show s ++ " as a boolean")- emit True = "true"- emit False = "false"---- | Represents a field whose value is a sequence of other values--- which are delimited by a given string, and whose individual values--- are described by another 'FieldValue' value. This uses GHC's--- `IsList` typeclass to convert back and forth between sequence--- types.-listWithSeparator :: IsList l => Text -> FieldValue (Item l) -> FieldValue l-listWithSeparator sep fv = FieldValue- { fvParse = fmap fromList . mapM (fvParse fv . T.strip) . T.splitOn sep- , fvEmit = T.intercalate sep . map (fvEmit fv) . toList- }---- | Represents a field whose value is a pair of two other values--- separated by a given string, whose individual values are described--- by two different 'FieldValue' values.-pairWithSeparator :: FieldValue l -> Text -> FieldValue r -> FieldValue (l, r)-pairWithSeparator left sep right = FieldValue- { fvParse = \ t ->- let (leftChunk, rightChunk) = T.breakOn sep t- in do- x <- fvParse left leftChunk- y <- fvParse right rightChunk- return (x, y)- , fvEmit = \ (x, y) -> fvEmit left x <> sep <> fvEmit right y- }---- * Parsing INI files---- Are you reading this source code? It's not even that gross--- yet. Just you wait. This is just the regular part. 'runSpec' is--- easy: we walk the spec, and for each section, find the--- corresponding section in the INI file and call runFields.-parseSections- :: s- -> Seq.ViewL (Section s)- -> Seq (NormalizedText, IniSection)- -> Either String s-parseSections s Seq.EmptyL _ = Right s-parseSections s (Section name fs opt Seq.:< rest) i- | Just v <- lkp name i = do- s' <- parseFields s (Seq.viewl fs) v- parseSections s' (Seq.viewl rest) i- | opt = parseSections s (Seq.viewl rest) i- | otherwise = Left ("Unable to find section " ++- show (normalizedText name))---- Now that we've got 'set', we can walk the field descriptions and--- find them. There's some fiddly logic, but the high-level idea is--- that we try to look up a field, and if it exists, parse it using--- the provided parser and use the provided lens to add it to the--- value. We have to decide what to do if it's not there, which--- depends on lens metadata and whether it's an optional field or not.-parseFields :: s -> Seq.ViewL (Field s) -> IniSection -> Either String s-parseFields s Seq.EmptyL _ = Right s-parseFields s (Field l descr Seq.:< fs) sect- | Just v <- lkp (fdName descr) (isVals sect) = do- value <- fvParse (fdValue descr) (T.strip (vValue v))- parseFields (set l value s) (Seq.viewl fs) sect- | fdSkipIfMissing descr =- parseFields s (Seq.viewl fs) sect- | otherwise = Left ("Unable to find field " ++- show (normalizedText (fdName descr)))-parseFields s (FieldMb l descr Seq.:< fs) sect- | Just v <- lkp (fdName descr) (isVals sect) = do- value <- fvParse (fdValue descr) (T.strip (vValue v))- parseFields (set l (Just value) s) (Seq.viewl fs) sect- | otherwise =- parseFields (set l Nothing s) (Seq.viewl fs) sect---- | Serialize a value as an INI file according to a provided--- 'IniSpec'.-emitIniFile :: s -> Spec s -> RawIni-emitIniFile s spec =- RawIni $- fmap (\ (Section name fs _) ->- (name, toSection s (actualText name) fs)) spec--mkComments :: Seq Text -> Seq BlankLine-mkComments comments =- fmap (\ ln -> CommentLine '#' (" " <> ln)) comments--toSection :: s -> Text -> Seq (Field s) -> IniSection-toSection s name fs = IniSection- { isName = name- , isVals = fmap toVal fs- , isStartLine = 0- , isEndLine = 0- , isComments = Seq.empty- } where mkIniValue val descr opt =- ( fdName descr- , IniValue- { vLineNo = 0- , vName = actualText (fdName descr)- , vValue = " " <> val- , vComments = mkComments (fdComment descr)- , vCommentedOut = opt- , vDelimiter = '='- }- )- toVal (Field l descr)- | Just dummy <- fdDummy descr =- mkIniValue dummy descr False- | otherwise =- mkIniValue (fvEmit (fdValue descr) (get l s)) descr False- toVal (FieldMb l descr)- | Just dummy <- fdDummy descr =- mkIniValue dummy descr True- | Just v <- get l s =- mkIniValue (fvEmit (fdValue descr) v) descr True- | otherwise =- mkIniValue "" descr True---- | An 'UpdatePolicy' guides certain choices made when an 'Ini' file--- is updated: for example, how to add comments to the generated--- fields, or how to treat fields which are optional.-data UpdatePolicy = UpdatePolicy- { updateAddOptionalFields :: Bool- -- ^ If 'True', then optional fields not included in the INI file- -- will be included in the updated INI file. Defaults to 'False'.- , updateIgnoreExtraneousFields :: Bool- -- ^ If 'True', then fields in the INI file that have no- -- corresponding description in the 'IniSpec' will be ignored; if- -- 'False', then those fields will return an error value. Defaults- -- to 'True'.- , updateGeneratedCommentPolicy :: UpdateCommentPolicy- -- ^ The policy for what to do to comments associated with- -- modified fields during an update. Defaults to- -- 'CommentPolicyNone'.- } deriving (Eq, Show)---- | A set of sensible 'UpdatePolicy' defaults which keep the diffs--- between file versions minimal.-defaultUpdatePolicy :: UpdatePolicy-defaultUpdatePolicy = UpdatePolicy- { updateAddOptionalFields = False- , updateIgnoreExtraneousFields = True- , updateGeneratedCommentPolicy = CommentPolicyNone- }---- | An 'UpdateCommentPolicy' describes what comments should accompany--- a field added to or modified in an existing INI file when using--- 'updateIni'.-data UpdateCommentPolicy- = CommentPolicyNone- -- ^ Do not add comments to new fields- | CommentPolicyAddFieldComment- -- ^ Add the same comment which appears in the 'IniSpec' value for- -- the field we're adding or modifying.- | CommentPolicyAddDefaultComment (Seq Text)- -- ^ Add a common comment to all new fields added or modified- -- by an 'updateIni' call.- deriving (Eq, Show)--getComments :: FieldDescription s -> UpdateCommentPolicy -> (Seq BlankLine)-getComments _ CommentPolicyNone = Seq.empty-getComments f CommentPolicyAddFieldComment =- mkComments (fdComment f)-getComments _ (CommentPolicyAddDefaultComment cs) =- mkComments cs---- | Given a value, an 'IniSpec', and a 'Text' form of an INI file,--- parse 'Text' as INI and then selectively modify the file whenever--- the provided value differs from the file. This is designed to help--- applications update a user's configuration automatically while--- retaining the structure and comments of a user's application,--- ideally in a way which produces as few changes as possible to the--- resulting file (so that, for example, the diff between the two--- should be as small as possible.)------ A field is considered to have "changed" if the parsed--- representation of the field as extracted from the textual INI file--- is not equal to the corresponding value in the provided--- structure. Changed fields will retain their place in the overall--- file, while newly added fields (for example, fields which have--- been changed from a default value) will be added to the end of the--- section in which they appear.---doUpdateIni :: s -> s -> Spec s -> RawIni -> UpdatePolicy -> Either String (Ini s)-doUpdateIni :: s -> Ini s -> Either String (Ini s)-doUpdateIni s i@Ini { iniSpec = spec- , iniDef = def- , iniPol = pol- } = do -- spec (RawIni ini) pol = do- let RawIni ini' = getRawIni i- res <- updateSections s def ini' spec pol- return $ i- { iniCurr = s- , iniLast = Just (RawIni res)- }--updateSections- :: s- -> s- -> Seq (NormalizedText, IniSection)- -> Seq (Section s)- -> UpdatePolicy- -> Either String (Seq (NormalizedText, IniSection))-updateSections s def sections fields pol = do- -- First, we process all the sections that actually appear in the- -- INI file in order- existingSections <- F.for sections $ \ (name, sec) -> do- let err = Left ("Unexpected top-level section: " ++ show name)- Section _ spec _ <- maybe err Right- (F.find (\ (Section n _ _) -> n == name) fields)- newVals <- updateFields s (isVals sec) spec pol- return (name, sec { isVals = newVals })- -- And then- let existingSectionNames = fmap fst existingSections- newSections <- F.for fields $- \ (Section nm spec _) ->- if | nm `elem` existingSectionNames -> return mempty- | otherwise ->- let rs = emitNewFields s def spec pol- in if Seq.null rs- then return mempty- else return $ Seq.singleton- ( nm- , IniSection (actualText nm) rs 0 0 mempty- )- return (existingSections <> F.asum newSections)---- We won't emit a section if everything in the section is also--- missing-emitNewFields- :: s -> s- -> Seq (Field s)- -> UpdatePolicy ->- Seq (NormalizedText, IniValue)-emitNewFields s def fields pol = go (Seq.viewl fields) where- go EmptyL = Seq.empty- go (Field l d :< fs)- -- If a field is not present but is also the same as the default,- -- then we can safely omit it- | get l s == get l def && not (updateAddOptionalFields pol) =- go (Seq.viewl fs)- -- otherwise, we should add it to the result- | otherwise =- let cs = getComments d (updateGeneratedCommentPolicy pol)- new = ( fdName d- , IniValue- { vLineNo = 0- , vName = actualText (fdName d)- , vValue = " " <> fvEmit (fdValue d) (get l s)- , vComments = cs- , vCommentedOut = False- , vDelimiter = '='- }- )- in new <| go (Seq.viewl fs)- go (FieldMb l d :< fs) =- case get l s of- Nothing -> go (Seq.viewl fs)- Just v ->- let cs = getComments d (updateGeneratedCommentPolicy pol)- new = ( fdName d- , IniValue- { vLineNo = 0- , vName = actualText (fdName d)- , vValue = fvEmit (fdValue d) v- , vComments = cs- , vCommentedOut = False- , vDelimiter = '='- }- )- in new <| go (Seq.viewl fs)---updateFields :: s -> Seq (NormalizedText, IniValue) -> Seq (Field s)- -> UpdatePolicy -> Either String (Seq (NormalizedText, IniValue))-updateFields s values fields pol = go (Seq.viewl values) fields- where go ((t, val) :< vs) fs =- -- For each field, we need to fetch the description of the- -- field in the spec- case F.find (\ f -> fieldName f == t) fs of- Just f@(Field l descr) ->- -- if it does exist, then we need to find out whether- -- the field has changed at all. We can do this with the- -- provided lens, and check it against the INI file- -- we've got. There's a minor complication: there's- -- nothing that forces the user to provide the same INI- -- file we originally parsed! One side-effect means that- -- the parsed INI file might not actually have a valid- -- field according to the field parser the user- -- provides. In that case, we'll assume the field is- -- outdated, and update it with the value in the- -- provided structure.- if Right (get l s) == fvParse (fdValue descr) (T.strip (vValue val))- -- if the value in the INI file parses the same as- -- the one in the structure we were passed, then it- -- doesn't need any updating, and we keep going,- -- removing the field from our list- then ((t, val) <|) `fmap` go (Seq.viewl vs) (rmv t fs)- -- otherwise, we've got a new updated value! Let's- -- synthesize a new element, using our comment policy- -- to comment it accordingly. (This pattern is- -- partial, but we should never have a situation- -- where it returns Nothing, because we already know- -- that we've matched a Field!)- else let Just nv = mkValue t f (vDelimiter val)- in ((t, nv) <|) `fmap` go (Seq.viewl vs) (rmv t fs)- -- And we have to replicate the logic for the FieldMb- -- case, because (as an existential) it doesn't really- -- permit us usable abstractions here. See the previous- -- comments for descriptions of the cases.- Just f@(FieldMb l descr) ->- let parsed = fvParse (fdValue descr) (T.strip (vValue val))- in if Right (get l s) == fmap Just parsed- then ((t, val) <|) `fmap` go (Seq.viewl vs) (rmv t fs)- -- this is in the only case where the FieldMb case- -- differs: we might NOT have a value in the- -- structure. In that case, we remove the value- -- from the file, as well!- else case mkValue t f (vDelimiter val) of- Just nv -> ((t, nv) <|) `fmap` go (Seq.viewl vs) (rmv t fs)- Nothing -> go (Seq.viewl vs) (rmv t fs)- -- Finally, if we can't find any description of the field,- -- then we might skip it or throw an error, depending on- -- the policy the user wants.- Nothing- | updateIgnoreExtraneousFields pol ->- ((t, val) <|) `fmap` go (Seq.viewl vs) fs- | otherwise -> Left ("Unexpected field: " ++ show t)- -- Once we've gone through all the fields in the file, we need- -- to see if there's anything left over that should be in the- -- file. We might want to include dummy values for things that- -- were left out, but if we have any non-optional fields left- -- over, then we definitely need to include them.- go EmptyL fs = return (finish (Seq.viewl fs))- finish (f@(Field {}) :< fs)- | updateAddOptionalFields pol- , Just val <- mkValue (fieldName f) f '=' =- (fieldName f, val) <| finish (Seq.viewl fs)- | otherwise = finish (Seq.viewl fs)- finish (f@(FieldMb _ descr) :< fs)- | not (fdSkipIfMissing descr)- , Just val <- mkValue (fieldName f) f '=' =- (fieldName f, val) <| finish (Seq.viewl fs)- | updateAddOptionalFields pol- , Just val <- mkValue (fieldName f) f '=' =- (fieldName f, val) <| finish (Seq.viewl fs)- | otherwise = finish (Seq.viewl fs)- -- If there's nothing left, then we can return a final value!- finish EmptyL = Seq.empty- mkValue t fld delim =- let comments = case updateGeneratedCommentPolicy pol of- CommentPolicyNone -> Seq.empty- CommentPolicyAddFieldComment ->- mkComments (fieldComment fld)- CommentPolicyAddDefaultComment cs ->- mkComments cs- val = IniValue- { vLineNo = 0- , vName = actualText t- , vValue = ""- , vComments = comments- , vCommentedOut = False- , vDelimiter = delim- }- in case fld of- Field l descr ->- Just (val { vValue = " " <> fvEmit (fdValue descr) (get l s) })- FieldMb l descr ->- case get l s of- Just v -> Just (val { vValue = " " <> fvEmit (fdValue descr) v })- Nothing -> Nothing-+{-# LANGUAGE CPP #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- |+-- Module : Data.Ini.Config.Bidir+-- Copyright : (c) Getty Ritter, 2017+-- License : BSD+-- Maintainer : Getty Ritter <config-ini@infinitenegativeutility.com>+-- Stability : experimental+--+-- This module presents an alternate API for parsing INI files. Unlike+-- the standard API, it is bidirectional: the same declarative structure+-- can be used to parse an INI file to a value, serialize an INI file+-- from a value, or even /update/ an INI file by comparing it against a+-- value and serializing in a way that minimizes the differences between+-- revisions of the file.+--+-- This API does make some extra assumptions about your configuration+-- type and the way you interact with it: in particular, it assumes that+-- you have lenses for all the fields you're parsing and that you have+-- some kind of sensible default value of that configuration+-- type. Instead of providing combinators which can extract and parse a+-- field of an INI file into a value, the bidirectional API allows you to+-- declaratively associate a lens into your structure with a field of the+-- INI file.+--+-- Consider the following example INI file:+--+-- > [NETWORK]+-- > host = example.com+-- > port = 7878+-- >+-- > [LOCAL]+-- > user = terry+--+-- We'd like to parse this INI file into a @Config@ type which we've+-- defined like this, using+-- <https://hackage.haskell.org/package/lens lens> or a similar library+-- to provide lenses:+--+-- > data Config = Config+-- > { _cfHost :: String+-- > , _cfPort :: Int+-- > , _cfUser :: Maybe Text+-- > } deriving (Eq, Show)+-- >+-- > ''makeLenses Config+--+-- We can now define a basic specification of the type @'IniSpec' Config+-- ()@ by using the provided operations to declare our top-level+-- sections, and then within those sections we can associate fields with+-- @Config@ lenses.+--+-- @+-- 'configSpec' :: 'IniSpec' Config ()+-- 'configSpec' = do+-- 'section' \"NETWORK\" $ do+-- cfHost '.=' 'field' \"host\" 'string'+-- cfPost '.=' 'field' \"port\" 'number'+-- 'sectionOpt' \"LOCAL\" $ do+-- cfUser '.=?' 'field' \"user\" 'text'+-- @+--+-- There are two operators used to associate lenses with fields:+--+-- ['.='] Associates a lens of type @Lens' s a@ with a field description+-- of type @FieldDescription a@. By default, this will raise an+-- error when parsing if the field described is missing, but we+-- can mark it as optional, as we'll see.+--+-- ['.=?'] Associates a lens of type @Lens' s (Maybe a)@ with a field+-- description of type @FieldDescription a@. During parsing, if+-- the value does not appear in an INI file, then the lens will+-- be set to 'Nothing'; similarly, during serializing, if the+-- value is 'Nothing', then the field will not be serialized in+-- the file.+--+-- Each field must include the field's name as well as a 'FieldValue',+-- which describes how to both parse and serialize a value of a given+-- type. Several built-in 'FieldValue' descriptions are provided, but you+-- can always build your own by providing parsing and serialization+-- functions for individual fields.+--+-- We can also provide extra metadata about a field, allowing it to be+-- skipped durin parsing, or to provide an explicit default value, or to+-- include an explanatory comment for that value to be used when we+-- serialize an INI file. These are conventionally applied to the field+-- using the '&' operator:+--+-- @+-- configSpec :: 'IniSpec' Config ()+-- configSpec = do+-- 'section' \"NETWORK\" $ do+-- cfHost '.=' 'field' \"host\" 'string'+-- & 'comment' [\"The desired hostname (optional)\"]+-- & 'optional'+-- cfPost '.=' 'field' \"port\" 'number'+-- & 'comment' [\"The port number\"]+-- 'sectionOpt' \"LOCAL\" $ do+-- cfUser '.=?' 'field' \"user\" 'text'+-- @+--+-- When we want to use this specification, we need to create a value of+-- type 'Ini', which is an abstract representation of an INI+-- specification. To create an 'Ini' value, we need to use the 'ini'+-- function, which combines the spec with the default version of our+-- configuration value.+--+-- Once we have a value of type 'Ini', we can use it for three basic+-- operations:+--+-- * We can parse a textual INI file with 'parseIni', which will+-- systematically walk the spec and use the provided lens/field+-- associations to create a parsed configuration file. This will give+-- us a new value of type 'Ini' that represents the parsed+-- configuration, and we can extract the actual configuration value+-- with 'getIniValue'.+--+-- * We can update the value contained in an 'Ini' value. If the 'Ini'+-- value is the result of a previous call to 'parseIni', then this+-- update will attempt to retain as much of the incidental structure of+-- the parsed file as it can: for example, it will attempt to retain+-- comments, whitespace, and ordering. The general strategy is to make+-- the resulting INI file "diff-minimal": the diff between the older+-- INI file and the updated INI file should contain as little noise as+-- possible. Small cosmetic choices such as how to treat generated+-- comments are controlled by a configurable 'UpdatePolicy' value.+--+-- * We can serialize an 'Ini' value to a textual INI file. This will+-- produce the specified INI file (either a default fresh INI, or a+-- modified existing INI) as a textual value.+module Data.Ini.Config.Bidir+ ( -- * Parsing, Serializing, and Updating Files+ -- $using+ Ini,+ ini,+ getIniValue,+ iniValueL,+ getRawIni,++ -- ** Parsing INI files+ parseIni,++ -- ** Serializing INI files+ serializeIni,++ -- ** Updating INI Files+ updateIni,+ setIniUpdatePolicy,+ UpdatePolicy (..),+ UpdateCommentPolicy (..),+ defaultUpdatePolicy,++ -- * Bidirectional Parser Types+ -- $types+ IniSpec,+ SectionSpec,++ -- * Section-Level Parsing+ -- $sections+ section,+ allOptional,++ -- * Field-Level Parsing+ -- $fields+ FieldDescription,+ (.=),+ (.=?),+ field,+ flag,+ comment,+ placeholderValue,+ optional,++ -- * FieldValues+ -- $fieldvalues+ FieldValue (..),+ text,+ string,+ number,+ bool,+ readable,+ listWithSeparator,+ pairWithSeparator,++ -- * Miscellaneous Helpers+ -- $misc+ (&),+ Lens,+ )+where++import Control.Monad.Trans.State.Strict (State, modify, runState)+import qualified Control.Monad.Trans.State.Strict as State+import qualified Data.Foldable as F+#if __GLASGOW_HASKELL__ >= 710+import Data.Function ((&))+#endif++import Data.Ini.Config.Raw+import Data.Monoid ((<>))+import Data.Sequence (Seq, ViewL (..), ViewR (..), (<|))+import qualified Data.Sequence as Seq+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Traversable as F+import Data.Typeable (Proxy (..), Typeable, typeRep)+import GHC.Exts (IsList (..))+import Text.Read (readMaybe)++-- * Utility functions + lens stuffs++-- | This is a+-- <https://hackage.haskell.org/package/lens lens>-compatible+-- type alias+type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t++-- These are some inline reimplementations of "lens" operators. We+-- need the identity functor to implement 'set':+newtype I a = I {fromI :: a}++instance Functor I where fmap f (I x) = I (f x)++set :: Lens s t a b -> b -> s -> t+set lns x a = fromI (lns (const (I x)) a)++-- ... and we need the const functor to implement 'get':+newtype C a b = C {fromC :: a}++instance Functor (C a) where fmap _ (C x) = C x++get :: Lens s t a b -> s -> a+get lns a = fromC (lns C a)++lkp :: NormalizedText -> Seq (NormalizedText, a) -> Maybe a+lkp t = fmap snd . F.find (\(t', _) -> t' == t)++rmv :: NormalizedText -> Seq (Field s) -> Seq (Field s)+rmv n = Seq.filter (\f -> fieldName f /= n)++-- The & operator is really useful here, but it didn't show up in+-- earlier versions, so it gets redefined here.+#if __GLASGOW_HASKELL__ < 710+{- | '&' is a reverse application operator. This provides notational+ convenience. Its precedence is one higher than that of the+ forward application operator '$', which allows '&' to be nested+ in '$'. -}+(&) :: a -> (a -> b) -> b+a & f = f a+infixl 1 &+#endif++-- * The 'Ini' type++-- | An 'Ini' is an abstract representation of an INI file, including+-- both its textual representation and the Haskell value it+-- represents.+data Ini s = Ini+ { iniSpec :: Spec s,+ iniCurr :: s,+ iniDef :: s,+ iniLast :: Maybe RawIni,+ iniPol :: UpdatePolicy+ }++-- | Create a basic 'Ini' value from a default value and a spec.+ini :: s -> IniSpec s () -> Ini s+ini def (IniSpec spec) =+ Ini+ { iniSpec = runBidirM spec,+ iniCurr = def,+ iniDef = def,+ iniLast = Nothing,+ iniPol = defaultUpdatePolicy+ }++-- | Get the underlying Haskell value associated with the 'Ini'.+getIniValue :: Ini s -> s+getIniValue = iniCurr++mkLens :: (a -> b) -> (b -> a -> a) -> Lens a a b b+mkLens get' set' f a = (`set'` a) `fmap` f (get' a)++-- | The lens equivalent of 'getIniValue'+iniValueL :: Lens (Ini s) (Ini s) s s+iniValueL = mkLens iniCurr (\i v -> v {iniCurr = i})++-- | Get the textual representation of an 'Ini' value. If this 'Ini'+-- value is the result of 'parseIni', then it will attempt to retain+-- the textual characteristics of the parsed version as much as+-- possible (e.g. by retaining comments, ordering, and whitespace in a+-- way that will minimize the overall diff footprint.) If the 'Ini'+-- value was created directly from a value and a specification, then+-- it will pretty-print an initial version of the file with the+-- comments and placeholder text specified in the spec.+serializeIni :: Ini s -> Text+serializeIni = printRawIni . getRawIni++-- | Get the underlying 'RawIni' value for the file.+getRawIni :: Ini s -> RawIni+getRawIni Ini {iniLast = Just raw} = raw+getRawIni+ Ini+ { iniCurr = s,+ iniSpec = spec+ } =+ emitIniFile s spec++-- | Parse a textual representation of an 'Ini' file. If the file is+-- malformed or if an obligatory field is not found, this will produce+-- a human-readable error message. If an optional field is not found,+-- then it will fall back on the existing value contained in the+-- provided 'Ini' structure.+parseIni :: Text -> Ini s -> Either String (Ini s)+parseIni+ t+ i@Ini+ { iniSpec = spec,+ iniCurr = def+ } = do+ RawIni raw <- parseRawIni t+ s <- parseSections def (Seq.viewl spec) raw+ return $+ i+ { iniCurr = s,+ iniLast = Just (RawIni raw)+ }++-- | Update the internal value of an 'Ini' file. If this 'Ini' value+-- is the result of 'parseIni', then the resulting 'Ini' value will+-- attempt to retain the textual characteristics of the parsed version+-- as much as possible (e.g. by retaining comments, ordering, and+-- whitespace in a way that will minimize the overall diff footprint.)+updateIni :: s -> Ini s -> Ini s+updateIni new i =+ case doUpdateIni new i of+ Left err -> error err+ Right i' -> i'++-- | Use the provided 'UpdatePolicy' as a guide when creating future+-- updated versions of the given 'Ini' value.+setIniUpdatePolicy :: UpdatePolicy -> Ini s -> Ini s+setIniUpdatePolicy pol i = i {iniPol = pol}++-- * Type definitions++-- | A value of type 'FieldValue' packages up a parser and emitter+-- function into a single value. These are used for bidirectional+-- parsing and emitting of the value of a field.+data FieldValue a = FieldValue+ { -- | The function to use when parsing the value of a field; if+ -- the parser fails, then the string will be shown as an error+ -- message to the user.+ fvParse :: Text -> Either String a,+ -- | The function to use when serializing a value into an INI+ -- file.+ fvEmit :: a -> Text+ }++-- This is actually being used as a writer monad, but using a state+-- monad lets us avoid the space leaks. Not that those are likely to+-- be a problem in this application, but it's not like it cost us+-- none.+type BidirM s a = State (Seq s) a++runBidirM :: BidirM s a -> Seq s+runBidirM = snd . flip runState Seq.empty++type Spec s = Seq (Section s)++-- | An 'IniSpec' value represents the structure of an entire+-- INI-format file in a declarative way. The @s@ parameter represents+-- the type of a Haskell structure which is being serialized to or+-- from.+newtype IniSpec s a = IniSpec (BidirM (Section s) a)+ deriving (Functor, Applicative, Monad)++-- | A 'SectionSpec' value represents the structure of a single+-- section of an INI-format file in a declarative way. The @s@+-- parameter represents the type of a Haskell structure which is being+-- serialized to or from.+newtype SectionSpec s a = SectionSpec (BidirM (Field s) a)+ deriving (Functor, Applicative, Monad)++-- * Sections++-- | Define the specification of a top-level INI section.+section :: Text -> SectionSpec s () -> IniSpec s ()+section name (SectionSpec mote) = IniSpec $ do+ let fields = runBidirM mote+ modify (Seq.|> Section (normalize name) fields (allFieldsOptional fields))++allFieldsOptional :: Seq (Field s) -> Bool+allFieldsOptional = all isOptional+ where+ isOptional (Field _ fd) = fdSkipIfMissing fd+ isOptional (FieldMb _ _) = True++-- | Treat an entire section as containing entirely optional fields.+allOptional ::+ (SectionSpec s () -> IniSpec s ()) ->+ (SectionSpec s () -> IniSpec s ())+allOptional k spec = IniSpec $ do+ let IniSpec comp = k spec+ comp+ modify+ ( \s -> case Seq.viewr s of+ EmptyR -> s+ rs :> Section name fields _ ->+ rs Seq.|> Section name (fmap makeOptional fields) True+ )++makeOptional :: Field s -> Field s+makeOptional (Field l d) = Field l d {fdSkipIfMissing = True}+makeOptional (FieldMb l d) = FieldMb l d {fdSkipIfMissing = True}++data Section s = Section NormalizedText (Seq (Field s)) Bool++-- * Fields++-- | A "Field" is a description of+data Field s+ = forall a. Eq a => Field (Lens s s a a) (FieldDescription a)+ | forall a. Eq a => FieldMb (Lens s s (Maybe a) (Maybe a)) (FieldDescription a)++-- convenience accessors for things in a Field+fieldName :: Field s -> NormalizedText+fieldName (Field _ FieldDescription {fdName = n}) = n+fieldName (FieldMb _ FieldDescription {fdName = n}) = n++fieldComment :: Field s -> Seq Text+fieldComment (Field _ FieldDescription {fdComment = n}) = n+fieldComment (FieldMb _ FieldDescription {fdComment = n}) = n++-- | A 'FieldDescription' is a declarative representation of the+-- structure of a field. This includes the name of the field and the+-- 'FieldValue' used to parse and serialize values of that field, as+-- well as other metadata that might be needed in the course of+-- parsing or serializing a structure.+data FieldDescription t = FieldDescription+ { fdName :: NormalizedText,+ fdValue :: FieldValue t,+ fdComment :: Seq Text,+ fdDummy :: Maybe Text,+ fdSkipIfMissing :: Bool+ }++-- ** Field operators++-- |+-- Associate a field description with a field. If this field+-- is not present when parsing, it will attempt to fall back+-- on a default, and if no default value is present, it will+-- fail to parse.+--+-- When serializing an INI file, this will produce all the+-- comments associated with the field description followed+-- by the value of the field in the.+(.=) :: Eq t => Lens s s t t -> FieldDescription t -> SectionSpec s ()+l .= f = SectionSpec $ modify (Seq.|> fd)+ where+ fd = Field l f++-- |+-- Associate a field description with a field of type "Maybe a".+-- When parsing, this field will be initialized to "Nothing" if+-- it is not found, and to a "Just" value if it is. When+-- serializing an INI file, this will try to serialize a value+(.=?) :: Eq t => Lens s s (Maybe t) (Maybe t) -> FieldDescription t -> SectionSpec s ()+l .=? f = SectionSpec $ modify (Seq.|> fd)+ where+ fd = FieldMb l f++-- ** Field metadata++-- |+-- Associate a multiline comment with a "FieldDescription". When+-- serializing a field that has a comment associated, the comment will+-- appear before the field.+comment :: [Text] -> FieldDescription t -> FieldDescription t+comment cmt fd = fd {fdComment = Seq.fromList cmt}++-- | Choose a placeholder value to be displayed for optional fields.+-- This is used when serializing an optional Ini field: the+-- field will appear commented out in the output using the+-- placeholder text as a value, so a spec that includes+--+-- @+-- myLens .=? field "x" & placeholderValue "\<val\>"+-- @+--+-- will serialize into an INI file that contains the line+--+-- @+-- # x = \<val\>+-- @+--+-- A placeholder value will only appear in the serialized output if+-- the field is optional, but will be preferred over serializing the+-- default value for an optional field. This will not affect INI+-- file updates.+placeholderValue :: Text -> FieldDescription t -> FieldDescription t+placeholderValue t fd = fd {fdDummy = Just t}++-- | If the field is not found in parsing, simply skip instead of+-- raising an error or setting anything.+optional :: FieldDescription t -> FieldDescription t+optional fd = fd {fdSkipIfMissing = True}++infixr 0 .=++infixr 0 .=?++-- ** Creating fields++-- | Create a description of a field by a combination of the name of+-- the field and a "FieldValue" describing how to parse and emit+-- values associated with that field.+field :: Text -> FieldValue a -> FieldDescription a+field name value =+ FieldDescription+ { fdName = normalize (name <> " "),+ fdValue = value,+ fdComment = Seq.empty,+ fdDummy = Nothing,+ fdSkipIfMissing = False+ }++-- | Create a description of a 'Bool'-valued field.+flag :: Text -> FieldDescription Bool+flag name = field name bool++-- ** FieldValues++-- | A "FieldValue" for parsing and serializing values according to+-- the logic of the "Read" and "Show" instances for that type,+-- providing a convenient human-readable error message if the+-- parsing step fails.+readable :: forall a. (Show a, Read a, Typeable a) => FieldValue a+readable = FieldValue {fvParse = parse, fvEmit = emit}+ where+ emit = T.pack . show+ parse t = case readMaybe (T.unpack t) of+ Just v -> Right v+ Nothing ->+ Left+ ( "Unable to parse " ++ show t+ ++ " as a value of type "+ ++ show typ+ )+ typ = typeRep prx+ prx :: Proxy a+ prx = Proxy++-- | Represents a numeric field whose value is parsed according to the+-- 'Read' implementation for that type, and is serialized according to+-- the 'Show' implementation for that type.+number :: (Show a, Read a, Num a, Typeable a) => FieldValue a+number = readable++-- | Represents a field whose value is a 'Text' value+text :: FieldValue Text+text = FieldValue {fvParse = Right, fvEmit = id}++-- | Represents a field whose value is a 'String' value+string :: FieldValue String+string = FieldValue {fvParse = Right . T.unpack, fvEmit = T.pack}++-- | Represents a field whose value is a 'Bool' value. This parser is+-- case-insensitive, and matches the words @true@, @false@, @yes@, and+-- @no@, as well as single-letter abbreviations for all of the+-- above. This will serialize as @true@ for 'True' and @false@ for+-- 'False'.+bool :: FieldValue Bool+bool = FieldValue {fvParse = parse, fvEmit = emit}+ where+ parse s = case T.toLower s of+ "true" -> Right True+ "yes" -> Right True+ "t" -> Right True+ "y" -> Right True+ "false" -> Right False+ "no" -> Right False+ "f" -> Right False+ "n" -> Right False+ _ -> Left ("Unable to parse " ++ show s ++ " as a boolean")+ emit True = "true"+ emit False = "false"++-- | Represents a field whose value is a sequence of other values+-- which are delimited by a given string, and whose individual values+-- are described by another 'FieldValue' value. This uses GHC's+-- `IsList` typeclass to convert back and forth between sequence+-- types.+listWithSeparator :: IsList l => Text -> FieldValue (Item l) -> FieldValue l+listWithSeparator sep fv =+ FieldValue+ { fvParse = fmap fromList . mapM (fvParse fv . T.strip) . T.splitOn sep,+ fvEmit = T.intercalate sep . map (fvEmit fv) . toList+ }++-- | Represents a field whose value is a pair of two other values+-- separated by a given string, whose individual values are described+-- by two different 'FieldValue' values.+pairWithSeparator :: FieldValue l -> Text -> FieldValue r -> FieldValue (l, r)+pairWithSeparator left sep right =+ FieldValue+ { fvParse = \t ->+ let (leftChunk, rightChunk) = T.breakOn sep t+ in do+ x <- fvParse left leftChunk+ y <- fvParse right rightChunk+ return (x, y),+ fvEmit = \(x, y) -> fvEmit left x <> sep <> fvEmit right y+ }++-- * Parsing INI files++-- Are you reading this source code? It's not even that gross+-- yet. Just you wait. This is just the regular part. 'runSpec' is+-- easy: we walk the spec, and for each section, find the+-- corresponding section in the INI file and call runFields.+parseSections ::+ s ->+ Seq.ViewL (Section s) ->+ Seq (NormalizedText, IniSection) ->+ Either String s+parseSections s Seq.EmptyL _ = Right s+parseSections s (Section name fs opt Seq.:< rest) i+ | Just v <- lkp name i = do+ s' <- parseFields s (Seq.viewl fs) v+ parseSections s' (Seq.viewl rest) i+ | opt = parseSections s (Seq.viewl rest) i+ | otherwise =+ Left+ ( "Unable to find section "+ ++ show (normalizedText name)+ )++-- Now that we've got 'set', we can walk the field descriptions and+-- find them. There's some fiddly logic, but the high-level idea is+-- that we try to look up a field, and if it exists, parse it using+-- the provided parser and use the provided lens to add it to the+-- value. We have to decide what to do if it's not there, which+-- depends on lens metadata and whether it's an optional field or not.+parseFields :: s -> Seq.ViewL (Field s) -> IniSection -> Either String s+parseFields s Seq.EmptyL _ = Right s+parseFields s (Field l descr Seq.:< fs) sect+ | Just v <- lkp (fdName descr) (isVals sect) = do+ value <- fvParse (fdValue descr) (T.strip (vValue v))+ parseFields (set l value s) (Seq.viewl fs) sect+ | fdSkipIfMissing descr =+ parseFields s (Seq.viewl fs) sect+ | otherwise =+ Left+ ( "Unable to find field "+ ++ show (normalizedText (fdName descr))+ )+parseFields s (FieldMb l descr Seq.:< fs) sect+ | Just v <- lkp (fdName descr) (isVals sect) = do+ value <- fvParse (fdValue descr) (T.strip (vValue v))+ parseFields (set l (Just value) s) (Seq.viewl fs) sect+ | otherwise =+ parseFields (set l Nothing s) (Seq.viewl fs) sect++-- | Serialize a value as an INI file according to a provided+-- 'IniSpec'.+emitIniFile :: s -> Spec s -> RawIni+emitIniFile s spec =+ RawIni $+ fmap+ ( \(Section name fs _) ->+ (name, toSection s (actualText name) fs)+ )+ spec++mkComments :: Seq Text -> Seq BlankLine+mkComments = fmap (\ln -> CommentLine '#' (" " <> ln))++toSection :: s -> Text -> Seq (Field s) -> IniSection+toSection s name fs =+ IniSection+ { isName = name,+ isVals = fmap toVal fs,+ isStartLine = 0,+ isEndLine = 0,+ isComments = Seq.empty+ }+ where+ mkIniValue val descr opt =+ ( fdName descr,+ IniValue+ { vLineNo = 0,+ vName = actualText (fdName descr),+ vValue = " " <> val,+ vComments = mkComments (fdComment descr),+ vCommentedOut = opt,+ vDelimiter = '='+ }+ )+ toVal (Field l descr)+ | Just dummy <- fdDummy descr =+ mkIniValue dummy descr False+ | otherwise =+ mkIniValue (fvEmit (fdValue descr) (get l s)) descr False+ toVal (FieldMb l descr)+ | Just dummy <- fdDummy descr =+ mkIniValue dummy descr True+ | Just v <- get l s =+ mkIniValue (fvEmit (fdValue descr) v) descr True+ | otherwise =+ mkIniValue "" descr True++-- | An 'UpdatePolicy' guides certain choices made when an 'Ini' file+-- is updated: for example, how to add comments to the generated+-- fields, or how to treat fields which are optional.+data UpdatePolicy = UpdatePolicy+ { -- | If 'True', then optional fields not included in the INI file+ -- will be included in the updated INI file. Defaults to 'False'.+ updateAddOptionalFields :: Bool,+ -- | If 'True', then fields in the INI file that have no+ -- corresponding description in the 'IniSpec' will be ignored; if+ -- 'False', then those fields will return an error value. Defaults+ -- to 'True'.+ updateIgnoreExtraneousFields :: Bool,+ -- | The policy for what to do to comments associated with+ -- modified fields during an update. Defaults to+ -- 'CommentPolicyNone'.+ updateGeneratedCommentPolicy :: UpdateCommentPolicy+ }+ deriving (Eq, Show)++-- | A set of sensible 'UpdatePolicy' defaults which keep the diffs+-- between file versions minimal.+defaultUpdatePolicy :: UpdatePolicy+defaultUpdatePolicy =+ UpdatePolicy+ { updateAddOptionalFields = False,+ updateIgnoreExtraneousFields = True,+ updateGeneratedCommentPolicy = CommentPolicyNone+ }++-- | An 'UpdateCommentPolicy' describes what comments should accompany+-- a field added to or modified in an existing INI file when using+-- 'updateIni'.+data UpdateCommentPolicy+ = -- | Do not add comments to new fields+ CommentPolicyNone+ | -- | Add the same comment which appears in the 'IniSpec' value for+ -- the field we're adding or modifying.+ CommentPolicyAddFieldComment+ | -- | Add a common comment to all new fields added or modified+ -- by an 'updateIni' call.+ CommentPolicyAddDefaultComment (Seq Text)+ deriving (Eq, Show)++getComments :: FieldDescription s -> UpdateCommentPolicy -> Seq BlankLine+getComments _ CommentPolicyNone = Seq.empty+getComments f CommentPolicyAddFieldComment =+ mkComments (fdComment f)+getComments _ (CommentPolicyAddDefaultComment cs) =+ mkComments cs++-- | Given a value, an 'IniSpec', and a 'Text' form of an INI file,+-- parse 'Text' as INI and then selectively modify the file whenever+-- the provided value differs from the file. This is designed to help+-- applications update a user's configuration automatically while+-- retaining the structure and comments of a user's application,+-- ideally in a way which produces as few changes as possible to the+-- resulting file (so that, for example, the diff between the two+-- should be as small as possible.)+--+-- A field is considered to have "changed" if the parsed+-- representation of the field as extracted from the textual INI file+-- is not equal to the corresponding value in the provided+-- structure. Changed fields will retain their place in the overall+-- file, while newly added fields (for example, fields which have+-- been changed from a default value) will be added to the end of the+-- section in which they appear.+-- doUpdateIni :: s -> s -> Spec s -> RawIni -> UpdatePolicy -> Either String (Ini s)+doUpdateIni :: s -> Ini s -> Either String (Ini s)+doUpdateIni+ s+ i@Ini+ { iniSpec = spec,+ iniDef = def,+ iniPol = pol+ } = do+ -- spec (RawIni ini) pol = do+ let RawIni ini' = getRawIni i+ res <- updateSections s def ini' spec pol+ return $+ i+ { iniCurr = s,+ iniLast = Just (RawIni res)+ }++updateSections ::+ s ->+ s ->+ Seq (NormalizedText, IniSection) ->+ Seq (Section s) ->+ UpdatePolicy ->+ Either String (Seq (NormalizedText, IniSection))+updateSections s def sections fields pol = do+ -- First, we process all the sections that actually appear in the+ -- INI file in order+ existingSections <- F.for sections $ \(name, sec) -> do+ let err = Left ("Unexpected top-level section: " ++ show name)+ Section _ spec _ <-+ maybe+ err+ Right+ (F.find (\(Section n _ _) -> n == name) fields)+ newVals <- updateFields s (isVals sec) spec pol+ return (name, sec {isVals = newVals})+ -- And then+ let existingSectionNames = fmap fst existingSections+ newSections <- F.for fields $+ \(Section nm spec _) ->+ if nm `elem` existingSectionNames+ then return mempty+ else+ let rs = emitNewFields s def spec pol+ in if Seq.null rs+ then return mempty+ else+ return $+ Seq.singleton+ ( nm,+ IniSection (actualText nm) rs 0 0 mempty+ )+ return (existingSections <> F.asum newSections)++-- We won't emit a section if everything in the section is also+-- missing+emitNewFields ::+ s ->+ s ->+ Seq (Field s) ->+ UpdatePolicy ->+ Seq (NormalizedText, IniValue)+emitNewFields s def fields pol = go (Seq.viewl fields)+ where+ go EmptyL = Seq.empty+ go (Field l d :< fs)+ -- If a field is not present but is also the same as the default,+ -- then we can safely omit it+ | get l s == get l def && not (updateAddOptionalFields pol) =+ go (Seq.viewl fs)+ -- otherwise, we should add it to the result+ | otherwise =+ let cs = getComments d (updateGeneratedCommentPolicy pol)+ new =+ ( fdName d,+ IniValue+ { vLineNo = 0,+ vName = actualText (fdName d),+ vValue = " " <> fvEmit (fdValue d) (get l s),+ vComments = cs,+ vCommentedOut = False,+ vDelimiter = '='+ }+ )+ in new <| go (Seq.viewl fs)+ go (FieldMb l d :< fs) =+ case get l s of+ Nothing -> go (Seq.viewl fs)+ Just v ->+ let cs = getComments d (updateGeneratedCommentPolicy pol)+ new =+ ( fdName d,+ IniValue+ { vLineNo = 0,+ vName = actualText (fdName d),+ vValue = fvEmit (fdValue d) v,+ vComments = cs,+ vCommentedOut = False,+ vDelimiter = '='+ }+ )+ in new <| go (Seq.viewl fs)++updateFields ::+ s ->+ Seq (NormalizedText, IniValue) ->+ Seq (Field s) ->+ UpdatePolicy ->+ Either String (Seq (NormalizedText, IniValue))+updateFields s values fields pol = go (Seq.viewl values) fields+ where+ go ((t, val) :< vs) fs =+ -- For each field, we need to fetch the description of the+ -- field in the spec+ case F.find (\f -> fieldName f == t) fs of+ Just f@(Field l descr) ->+ -- if it does exist, then we need to find out whether+ -- the field has changed at all. We can do this with the+ -- provided lens, and check it against the INI file+ -- we've got. There's a minor complication: there's+ -- nothing that forces the user to provide the same INI+ -- file we originally parsed! One side-effect means that+ -- the parsed INI file might not actually have a valid+ -- field according to the field parser the user+ -- provides. In that case, we'll assume the field is+ -- outdated, and update it with the value in the+ -- provided structure.+ if Right (get l s) == fvParse (fdValue descr) (T.strip (vValue val))+ then -- if the value in the INI file parses the same as+ -- the one in the structure we were passed, then it+ -- doesn't need any updating, and we keep going,+ -- removing the field from our list+ ((t, val) <|) `fmap` go (Seq.viewl vs) (rmv t fs)+ else -- otherwise, we've got a new updated value! Let's+ -- synthesize a new element, using our comment policy+ -- to comment it accordingly. (This pattern is+ -- partial, but we should never have a situation+ -- where it returns Nothing, because we already know+ -- that we've matched a Field!)++ let Just nv = mkValue t f (vDelimiter val)+ in ((t, nv) <|) `fmap` go (Seq.viewl vs) (rmv t fs)+ -- And we have to replicate the logic for the FieldMb+ -- case, because (as an existential) it doesn't really+ -- permit us usable abstractions here. See the previous+ -- comments for descriptions of the cases.+ Just f@(FieldMb l descr) ->+ let parsed = fvParse (fdValue descr) (T.strip (vValue val))+ in if Right (get l s) == fmap Just parsed+ then ((t, val) <|) `fmap` go (Seq.viewl vs) (rmv t fs)+ else -- this is in the only case where the FieldMb case+ -- differs: we might NOT have a value in the+ -- structure. In that case, we remove the value+ -- from the file, as well!+ case mkValue t f (vDelimiter val) of+ Just nv -> ((t, nv) <|) `fmap` go (Seq.viewl vs) (rmv t fs)+ Nothing -> go (Seq.viewl vs) (rmv t fs)+ -- Finally, if we can't find any description of the field,+ -- then we might skip it or throw an error, depending on+ -- the policy the user wants.+ Nothing+ | updateIgnoreExtraneousFields pol ->+ ((t, val) <|) `fmap` go (Seq.viewl vs) fs+ | otherwise -> Left ("Unexpected field: " ++ show t)+ -- Once we've gone through all the fields in the file, we need+ -- to see if there's anything left over that should be in the+ -- file. We might want to include dummy values for things that+ -- were left out, but if we have any non-optional fields left+ -- over, then we definitely need to include them.+ go EmptyL fs = return (finish (Seq.viewl fs))+ finish (f@Field {} :< fs)+ | updateAddOptionalFields pol,+ Just val <- mkValue (fieldName f) f '=' =+ (fieldName f, val) <| finish (Seq.viewl fs)+ | otherwise = finish (Seq.viewl fs)+ finish (f@(FieldMb _ descr) :< fs)+ | not (fdSkipIfMissing descr),+ Just val <- mkValue (fieldName f) f '=' =+ (fieldName f, val) <| finish (Seq.viewl fs)+ | updateAddOptionalFields pol,+ Just val <- mkValue (fieldName f) f '=' =+ (fieldName f, val) <| finish (Seq.viewl fs)+ | otherwise = finish (Seq.viewl fs)+ -- If there's nothing left, then we can return a final value!+ finish EmptyL = Seq.empty+ mkValue t fld delim =+ let comments = case updateGeneratedCommentPolicy pol of+ CommentPolicyNone -> Seq.empty+ CommentPolicyAddFieldComment ->+ mkComments (fieldComment fld)+ CommentPolicyAddDefaultComment cs ->+ mkComments cs+ val =+ IniValue+ { vLineNo = 0,+ vName = actualText t,+ vValue = "",+ vComments = comments,+ vCommentedOut = False,+ vDelimiter = delim+ }+ in case fld of+ Field l descr ->+ Just (val {vValue = " " <> fvEmit (fdValue descr) (get l s)})+ FieldMb l descr ->+ case get l s of+ Just v -> Just (val {vValue = " " <> fvEmit (fdValue descr) v})+ Nothing -> Nothing -- $using -- Functions for parsing, serializing, and updating INI files.
src/Data/Ini/Config/Raw.hs view
@@ -1,43 +1,44 @@-{-|-Module : Data.Ini.Config.Raw-Copyright : (c) Getty Ritter, 2017-License : BSD-Maintainer : Getty Ritter <config-ini@infinitenegativeutility.com>-Stability : experimental+-- |+-- Module : Data.Ini.Config.Raw+-- Copyright : (c) Getty Ritter, 2017+-- License : BSD+-- Maintainer : Getty Ritter <config-ini@infinitenegativeutility.com>+-- Stability : experimental+--+-- __Warning!__ This module is subject to change in the future, and therefore should+-- not be relied upon to have a consistent API.+module Data.Ini.Config.Raw+ ( -- * INI types+ RawIni (..),+ IniSection (..),+ IniValue (..),+ BlankLine (..),+ NormalizedText (..),+ normalize, -__Warning!__ This module is subject to change in the future, and therefore should-not be relied upon to have a consistent API.+ -- * serializing and deserializing+ parseRawIni,+ printRawIni, --}-module Data.Ini.Config.Raw-( -- * INI types- RawIni(..)-, IniSection(..)-, IniValue(..)-, BlankLine(..)-, NormalizedText(..)-, normalize- -- * serializing and deserializing-, parseRawIni-, printRawIni- -- * inspection-, lookupInSection-, lookupSection-, lookupValue-) where+ -- * inspection+ lookupInSection,+ lookupSection,+ lookupValue,+ )+where -import Control.Monad (void)+import Control.Monad (void) import qualified Data.Foldable as F-import Data.Monoid ((<>))-import Data.Sequence (Seq)+import Data.Monoid ((<>))+import Data.Sequence (Seq) import qualified Data.Sequence as Seq-import Data.Text (Text)+import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Lazy as LazyText import qualified Data.Text.Lazy.Builder as Builder-import Data.Void (Void)-import Text.Megaparsec-import Text.Megaparsec.Char+import Data.Void (Void)+import Text.Megaparsec+import Text.Megaparsec.Char type Parser = Parsec Void Text @@ -53,9 +54,10 @@ -- -- This type is used to store section and key names in the data NormalizedText = NormalizedText- { actualText :: Text- , normalizedText :: Text- } deriving (Show)+ { actualText :: Text,+ normalizedText :: Text+ }+ deriving (Show) -- | The constructor function to build a 'NormalizedText' value. You -- probably shouldn't be using this module directly, but if for some@@ -78,7 +80,8 @@ -- sequence retains the ordering of the original source file. newtype RawIni = RawIni { fromRawIni :: Seq (NormalizedText, IniSection)- } deriving (Eq, Show)+ }+ deriving (Eq, Show) -- | An 'IniSection' consists of a name, a mapping of key-value pairs, -- and metadata about where the section starts and ends in the@@ -86,29 +89,30 @@ -- to lower-case or stripped of whitespace, and thus should appear -- exactly as they appear in the original source file. data IniSection = IniSection- { isName :: Text- -- ^ The name of the section, as it appears in the- -- original INI source- , isVals :: Seq (NormalizedText, IniValue)- -- ^ The key-value mapping within that section. Key- -- names here are normalized to lower-case and- -- stripped of whitespace. This sequence retains- -- the ordering of the original source file.- , isStartLine :: Int- -- ^ The line on which the section begins. This- -- field is ignored when serializing, and is only- -- used for error messages produced when parsing- -- and deserializing an INI structure.- , isEndLine :: Int- -- ^ The line on which the section ends. This field- -- is ignored when serializing, and is only used- -- for error messages produced when parsing and- -- deserializing an INI structure.- , isComments :: Seq BlankLine- -- ^ The blank lines and comments that appear prior- -- to the section head declaration, retained for- -- pretty-printing identical INI files.- } deriving (Eq, Show)+ { -- | The name of the section, as it appears in the+ -- original INI source+ isName :: Text,+ -- | The key-value mapping within that section. Key+ -- names here are normalized to lower-case and+ -- stripped of whitespace. This sequence retains+ -- the ordering of the original source file.+ isVals :: Seq (NormalizedText, IniValue),+ -- | The line on which the section begins. This+ -- field is ignored when serializing, and is only+ -- used for error messages produced when parsing+ -- and deserializing an INI structure.+ isStartLine :: Int,+ -- | The line on which the section ends. This field+ -- is ignored when serializing, and is only used+ -- for error messages produced when parsing and+ -- deserializing an INI structure.+ isEndLine :: Int,+ -- | The blank lines and comments that appear prior+ -- to the section head declaration, retained for+ -- pretty-printing identical INI files.+ isComments :: Seq BlankLine+ }+ deriving (Eq, Show) -- | An 'IniValue' represents a key-value mapping, and also stores the -- line number where it appears. The key names and values found in@@ -116,23 +120,24 @@ -- lower-case or stripped of whitespace, and thus should appear -- exactly as they appear in the original source file. data IniValue = IniValue- { vLineNo :: Int- -- ^ The line on which the key/value mapping- -- appears. This field is ignored when- -- serializing, and is only used for error- -- messages produced when parsing and- -- deserializing an INI structure.- , vName :: Text- -- ^ The name of the key, as it appears in the INI source.- , vValue :: Text- -- ^ The value of the key- , vComments :: Seq BlankLine- , vCommentedOut :: Bool- -- ^ Right now, this will never show up in a parsed INI file, but+ { -- | The line on which the key/value mapping+ -- appears. This field is ignored when+ -- serializing, and is only used for error+ -- messages produced when parsing and+ -- deserializing an INI structure.+ vLineNo :: Int,+ -- | The name of the key, as it appears in the INI source.+ vName :: Text,+ -- | The value of the key+ vValue :: Text,+ vComments :: Seq BlankLine,+ -- | Right now, this will never show up in a parsed INI file, but -- it's used when emitting a default INI file: it causes the -- key-value line to include a leading comment as well.- , vDelimiter :: Char- } deriving (Eq, Show)+ vCommentedOut :: Bool,+ vDelimiter :: Char+ }+ deriving (Eq, Show) -- | We want to keep track of the whitespace/comments in between KV -- lines, so this allows us to track those lines in a reproducible@@ -140,14 +145,14 @@ data BlankLine = CommentLine Char Text | BlankLine- deriving (Eq, Show)+ deriving (Eq, Show) -- | Parse a 'Text' value into an 'Ini' value, retaining a maximal -- amount of structure as needed to reconstruct the original INI file. parseRawIni :: Text -> Either String RawIni parseRawIni t = case runParser pIni "ini file" t of Left err -> Left (errorBundlePretty err)- Right v -> Right v+ Right v -> Right v pIni :: Parser RawIni pIni = do@@ -177,13 +182,14 @@ comments <- sBlanks pPairs (T.strip name) start leading prevs comments Seq.empty -pPairs :: Text- -> Int- -> Seq BlankLine- -> Seq (NormalizedText, IniSection)- -> Seq BlankLine- -> Seq (NormalizedText, IniValue)- -> Parser RawIni+pPairs ::+ Text ->+ Int ->+ Seq BlankLine ->+ Seq (NormalizedText, IniSection) ->+ Seq BlankLine ->+ Seq (NormalizedText, IniValue) ->+ Parser RawIni pPairs name start leading prevs comments pairs = newPair <|> finishedSection where newPair = do@@ -192,13 +198,14 @@ pPairs name start leading prevs rs (pairs Seq.|> (n, pair)) finishedSection = do end <- getCurrentLine- let newSection = IniSection- { isName = name- , isVals = pairs- , isStartLine = start- , isEndLine = end- , isComments = leading- }+ let newSection =+ IniSection+ { isName = name,+ isVals = pairs,+ isStartLine = start,+ isEndLine = end,+ isComments = leading+ } pSections comments (prevs Seq.|> (normalize name, newSection)) pPair :: Seq BlankLine -> Parser (NormalizedText, IniValue)@@ -207,20 +214,21 @@ key <- T.pack `fmap` some (noneOf "[]=:") delim <- oneOf ":=" val <- T.pack `fmap` manyTill anySingle eol- return ( normalize key- , IniValue- { vLineNo = pos- , vName = key- , vValue = val- , vComments = leading- , vCommentedOut = False- , vDelimiter = delim- } )+ return+ ( normalize key,+ IniValue+ { vLineNo = pos,+ vName = key,+ vValue = val,+ vComments = leading,+ vCommentedOut = False,+ vDelimiter = delim+ }+ ) getCurrentLine :: Parser Int getCurrentLine = (fromIntegral . unPos . sourceLine) `fmap` getSourcePos - -- | Serialize an INI file to text, complete with any comments which -- appear in the INI structure, and retaining the aesthetic details -- which are present in the INI file.@@ -228,52 +236,55 @@ printRawIni = LazyText.toStrict . Builder.toLazyText . F.foldMap build . fromRawIni where build (_, ini) =- F.foldMap buildComment (isComments ini) <>- Builder.singleton '[' <>- Builder.fromText (isName ini) <>- Builder.fromString "]\n" <>- F.foldMap buildKV (isVals ini)+ F.foldMap buildComment (isComments ini)+ <> Builder.singleton '['+ <> Builder.fromText (isName ini)+ <> Builder.fromString "]\n"+ <> F.foldMap buildKV (isVals ini) buildComment BlankLine = Builder.singleton '\n' buildComment (CommentLine c txt) = Builder.singleton c <> Builder.fromText txt <> Builder.singleton '\n' buildKV (_, val) =- F.foldMap buildComment (vComments val) <>- (if vCommentedOut val then Builder.fromString "# " else mempty) <>- Builder.fromText (vName val) <>- Builder.singleton (vDelimiter val) <>- Builder.fromText (vValue val) <>- Builder.singleton '\n'+ F.foldMap buildComment (vComments val)+ <> (if vCommentedOut val then Builder.fromString "# " else mempty)+ <> Builder.fromText (vName val)+ <> Builder.singleton (vDelimiter val)+ <> Builder.fromText (vValue val)+ <> Builder.singleton '\n' -- | Look up an Ini value by section name and key. Returns the sequence -- of matches.-lookupInSection :: Text- -- ^ The section name. Will be normalized prior to- -- comparison.- -> Text- -- ^ The key. Will be normalized prior to comparison.- -> RawIni- -- ^ The Ini to search.- -> Seq.Seq Text+lookupInSection ::+ -- | The section name. Will be normalized prior to+ -- comparison.+ Text ->+ -- | The key. Will be normalized prior to comparison.+ Text ->+ -- | The Ini to search.+ RawIni ->+ Seq.Seq Text lookupInSection sec opt ini =- vValue <$> (F.asum (lookupValue opt <$> lookupSection sec ini))+ vValue <$> F.asum (lookupValue opt <$> lookupSection sec ini) -- | Look up an Ini section by name. Returns a sequence of all matching -- section records.-lookupSection :: Text- -- ^ The section name. Will be normalized prior to- -- comparison.- -> RawIni- -- ^ The Ini to search.- -> Seq.Seq IniSection+lookupSection ::+ -- | The section name. Will be normalized prior to+ -- comparison.+ Text ->+ -- | The Ini to search.+ RawIni ->+ Seq.Seq IniSection lookupSection name ini =- snd <$> (Seq.filter ((== normalize name) . fst) $ fromRawIni ini)+ snd <$> Seq.filter ((== normalize name) . fst) (fromRawIni ini) -- | Look up an Ini key's value in a given section by the key. Returns -- the sequence of matches.-lookupValue :: Text- -- ^ The key. Will be normalized prior to comparison.- -> IniSection- -- ^ The section to search.- -> Seq.Seq IniValue+lookupValue ::+ -- | The key. Will be normalized prior to comparison.+ Text ->+ -- | The section to search.+ IniSection ->+ Seq.Seq IniValue lookupValue name section =- snd <$> Seq.filter ((== normalize name) . fst) (isVals section)+ snd <$> Seq.filter ((== normalize name) . fst) (isVals section)
test/doctest/Main.hs view
@@ -4,4 +4,4 @@ main :: IO () main = do- doctest [ "src/Data/Ini/Config.hs", "-XOverloadedStrings", "-isrc" ]+ doctest ["src/Data/Ini/Config.hs", "-XOverloadedStrings", "-isrc"]
test/ini-compat/Main.hs view
@@ -1,22 +1,20 @@-{-# LANGUAGE TypeSynonymInstances #-}-{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeSynonymInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Main where import qualified Data.Foldable as Fold-import Data.Function (on)-import Data.HashMap.Strict (HashMap)+import Data.Function (on)+import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HM import qualified Data.Ini as I1 import qualified Data.Ini.Config.Raw as I2-import Data.List (nubBy)+import Data.List (nubBy) import qualified Data.Sequence as Seq-import Data.Text (Text)+import Data.Text (Text) import qualified Data.Text as T--import Hedgehog+import Hedgehog import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Range as Range @@ -27,11 +25,11 @@ i1 = I1.parseIni printed i2 = I2.parseRawIni printed case (i1, i2) of- (Right i1', Right i2') ->- let i1'' = lower i1'- i2'' = toMaps i2'- in i1'' === i2''- _ -> failure+ (Right i1', Right i2') ->+ let i1'' = lower i1'+ i2'' = toMaps i2'+ in i1'' === i2''+ _ -> failure propRevIniEquiv :: Property propRevIniEquiv = property $ do@@ -40,9 +38,9 @@ i1 = I1.parseIni printed i2 = I2.parseRawIni printed case (i1, i2) of- (Right i1', Right i2') ->- lower i1' === toMaps i2'- _ -> failure+ (Right i1', Right i2') ->+ lower i1' === toMaps i2'+ _ -> failure propIniSelfEquiv :: Property propIniSelfEquiv = property $ do@@ -50,35 +48,42 @@ Right (toMaps raw) === fmap toMaps (I2.parseRawIni (I2.printRawIni raw)) lower :: I1.Ini -> HashMap Text (HashMap Text Text)-lower (I1.Ini ini) = go (fmap go ini)- where go hm = HM.fromList [ (T.toLower k, v) | (k, v) <- HM.toList hm ]+lower (I1.Ini sections _) =+ HM.fromList+ [ (T.toLower sectionName, HM.fromList [(T.toLower k, v) | (k, v) <- section])+ | (sectionName, section) <- HM.toList sections+ ] toMaps :: I2.RawIni -> HashMap Text (HashMap Text Text) toMaps (I2.RawIni m) = conv (fmap sectionToPair m)- where sectionToPair (name, section) =- (I2.normalizedText name, conv (fmap valueToPair (I2.isVals section)))- valueToPair (name, value) =- (I2.normalizedText name, T.strip (I2.vValue value))- conv = HM.fromList . Fold.toList+ where+ sectionToPair (name, section) =+ (I2.normalizedText name, conv (fmap valueToPair (I2.isVals section)))+ valueToPair (name, value) =+ (I2.normalizedText name, T.strip (I2.vValue value))+ conv = HM.fromList . Fold.toList textChunk :: Gen Text-textChunk = fmap T.pack $ Gen.list (Range.linear 1 20) $ Gen.alphaNum+textChunk = Gen.text (Range.linear 1 20) Gen.alphaNum mkIni :: Gen I1.Ini mkIni = do ss <- Gen.list (Range.linear 0 10) $ do name <- textChunk- section <- Gen.list (Range.linear 0 10) $- (,) <$> textChunk <*> textChunk- return (name, HM.fromList section)- return (I1.Ini (HM.fromList ss))+ section <-+ Gen.list (Range.linear 0 10) $+ (,) <$> textChunk <*> textChunk+ return (name, section)+ return (I1.Ini (HM.fromList ss) []) mkComments :: Gen (Seq.Seq I2.BlankLine)-mkComments = fmap Seq.fromList $ Gen.list (Range.linear 0 5) $- Gen.choice- [ return I2.BlankLine- , I2.CommentLine <$> Gen.element ";#" <*> textChunk- ]+mkComments =+ fmap Seq.fromList $+ Gen.list (Range.linear 0 5) $+ Gen.choice+ [ return I2.BlankLine,+ I2.CommentLine <$> Gen.element ";#" <*> textChunk+ ] mkRichIni :: Gen I2.RawIni mkRichIni = do@@ -88,20 +93,25 @@ k <- textChunk v <- textChunk cs <- mkComments- return ( I2.normalize k- , I2.IniValue 0 k v cs False '='- )+ return+ ( I2.normalize k,+ I2.IniValue 0 k v cs False '='+ ) cs <- mkComments- return ( I2.normalize name- , I2.IniSection name (Seq.fromList (nubBy ((==) `on` fst) section)) 0 0 cs- )+ return+ ( I2.normalize name,+ I2.IniSection name (Seq.fromList (nubBy ((==) `on` fst) section)) 0 0 cs+ ) return (I2.RawIni (Seq.fromList (nubBy ((==) `on` fst) ss))) main :: IO () main = do- _ <- checkParallel $ Group "Test.Example"- [ ("propIniEquiv", propIniEquiv)- , ("propRevIniEquiv", propRevIniEquiv)- , ("propIniSelfEquiv", propIniSelfEquiv)- ]+ _ <-+ checkParallel $+ Group+ "Test.Example"+ [ ("propIniEquiv", propIniEquiv),+ ("propRevIniEquiv", propRevIniEquiv),+ ("propIniSelfEquiv", propIniSelfEquiv)+ ] return ()
test/prewritten/Main.hs view
@@ -1,13 +1,13 @@ module Main where -import Data.List-import Data.Ini.Config.Raw-import Data.Sequence (Seq)-import Data.Text (Text)+import Data.Ini.Config.Raw+import Data.List+import Data.Sequence (Seq)+import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.IO as T-import System.Directory-import System.Exit+import System.Directory+import System.Exit dir :: FilePath dir = "test/prewritten/cases"@@ -15,25 +15,26 @@ main :: IO () main = do files <- getDirectoryContents dir- let inis = [ f | f <- files- , ".ini" `isSuffixOf` f- ]+ let inis =+ [ f | f <- files, ".ini" `isSuffixOf` f+ ] mapM_ runTest inis type IniSeq = Seq (Text, Seq (Text, Text)) toMaps :: RawIni -> IniSeq toMaps (RawIni m) = fmap sectionToPair m- where sectionToPair (name, section) =- (normalizedText name, fmap valueToPair (isVals section))- valueToPair (name, value) =- (normalizedText name, T.strip (vValue value))+ where+ sectionToPair (name, section) =+ (normalizedText name, fmap valueToPair (isVals section))+ valueToPair (name, value) =+ (normalizedText name, T.strip (vValue value)) runTest :: FilePath -> IO () runTest iniF = do let hsF = take (length iniF - 4) iniF ++ ".hs" ini <- T.readFile (dir ++ "/" ++ iniF)- hs <- readFile (dir ++ "/" ++ hsF)+ hs <- readFile (dir ++ "/" ++ hsF) case parseRawIni ini of Left err -> do putStrLn ("Error parsing " ++ iniF)@@ -41,9 +42,9 @@ exitFailure Right x | toMaps x == read hs -> do- putStrLn ("Passed: " ++ iniF)+ putStrLn ("Passed: " ++ iniF) | otherwise -> do- putStrLn ("Parses do not match for " ++ iniF)- putStrLn ("Expected: " ++ hs)- putStrLn ("Actual: " ++ show (toMaps x))- exitFailure+ putStrLn ("Parses do not match for " ++ iniF)+ putStrLn ("Expected: " ++ hs)+ putStrLn ("Actual: " ++ show (toMaps x))+ exitFailure
test/prewritten/cases/basic.hs view
@@ -1,11 +1,11 @@ fromList- [ ( "s1"- , fromList- [ ( "foo", "bar" )- , ( "baz", "quux" )+ [ ( "s1",+ fromList+ [ ("foo", "bar"),+ ("baz", "quux") ]- )- , ( "s2"- , fromList [ ( "argl", "bargl" ) ]+ ),+ ( "s2",+ fromList [("argl", "bargl")] ) ]