packages feed

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 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")]     )   ]