diff --git a/config-ini.cabal b/config-ini.cabal --- a/config-ini.cabal +++ b/config-ini.cabal @@ -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 diff --git a/src/Data/Ini/Config.hs b/src/Data/Ini/Config.hs --- a/src/Data/Ini/Config.hs +++ b/src/Data/Ini/Config.hs @@ -1,125 +1,131 @@ -{-| -Module : Data.Ini.Config -Copyright : (c) Getty Ritter, 2017 -License : BSD -Maintainer : Getty Ritter -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 +-- 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 diff --git a/src/Data/Ini/Config/Bidir.hs b/src/Data/Ini/Config/Bidir.hs --- a/src/Data/Ini/Config/Bidir.hs +++ b/src/Data/Ini/Config/Bidir.hs @@ -1,941 +1,995 @@ -{-| -Module : Data.Ini.Config.Bidir -Copyright : (c) Getty Ritter, 2017 -License : BSD -Maintainer : Getty Ritter -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 - 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 --- -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 "\" --- @ --- --- will serialize into an INI file that contains the line --- --- @ --- # x = \ --- @ --- --- 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 +-- 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 +-- 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 +-- -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 "\" +-- @ +-- +-- will serialize into an INI file that contains the line +-- +-- @ +-- # x = \ +-- @ +-- +-- 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. diff --git a/src/Data/Ini/Config/Raw.hs b/src/Data/Ini/Config/Raw.hs --- a/src/Data/Ini/Config/Raw.hs +++ b/src/Data/Ini/Config/Raw.hs @@ -1,43 +1,44 @@ -{-| -Module : Data.Ini.Config.Raw -Copyright : (c) Getty Ritter, 2017 -License : BSD -Maintainer : Getty Ritter -Stability : experimental +-- | +-- Module : Data.Ini.Config.Raw +-- Copyright : (c) Getty Ritter, 2017 +-- License : BSD +-- Maintainer : Getty Ritter +-- 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) diff --git a/test/doctest/Main.hs b/test/doctest/Main.hs --- a/test/doctest/Main.hs +++ b/test/doctest/Main.hs @@ -4,4 +4,4 @@ main :: IO () main = do - doctest [ "src/Data/Ini/Config.hs", "-XOverloadedStrings", "-isrc" ] + doctest ["src/Data/Ini/Config.hs", "-XOverloadedStrings", "-isrc"] diff --git a/test/ini-compat/Main.hs b/test/ini-compat/Main.hs --- a/test/ini-compat/Main.hs +++ b/test/ini-compat/Main.hs @@ -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 () diff --git a/test/prewritten/Main.hs b/test/prewritten/Main.hs --- a/test/prewritten/Main.hs +++ b/test/prewritten/Main.hs @@ -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 diff --git a/test/prewritten/cases/basic.hs b/test/prewritten/cases/basic.hs --- a/test/prewritten/cases/basic.hs +++ b/test/prewritten/cases/basic.hs @@ -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")] ) ]