{-# LANGUAGE CPP #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- |
-- Module     : Data.Ini.Config.Bidir
-- Copyright  : (c) Getty Ritter, 2017
-- License    : BSD
-- Maintainer : Getty Ritter <config-ini@infinitenegativeutility.com>
-- Stability  : experimental
--
-- This module presents an alternate API for parsing INI files.  Unlike
-- the standard API, it is bidirectional: the same declarative structure
-- can be used to parse an INI file to a value, serialize an INI file
-- from a value, or even /update/ an INI file by comparing it against a
-- value and serializing in a way that minimizes the differences between
-- revisions of the file.
--
-- This API does make some extra assumptions about your configuration
-- type and the way you interact with it: in particular, it assumes that
-- you have lenses for all the fields you're parsing and that you have
-- some kind of sensible default value of that configuration
-- type. Instead of providing combinators which can extract and parse a
-- field of an INI file into a value, the bidirectional API allows you to
-- declaratively associate a lens into your structure with a field of the
-- INI file.
--
-- Consider the following example INI file:
--
-- > [NETWORK]
-- > host = example.com
-- > port = 7878
-- >
-- > [LOCAL]
-- > user = terry
--
-- We'd like to parse this INI file into a @Config@ type which we've
-- defined like this, using
-- <https://hackage.haskell.org/package/lens lens> or a similar library
-- to provide lenses:
--
-- > data Config = Config
-- >   { _cfHost :: String
-- >   , _cfPort :: Int
-- >   , _cfUser :: Maybe Text
-- >   } deriving (Eq, Show)
-- >
-- > ''makeLenses Config
--
-- We can now define a basic specification of the type @'IniSpec' Config
-- ()@ by using the provided operations to declare our top-level
-- sections, and then within those sections we can associate fields with
-- @Config@ lenses.
--
-- @
-- 'configSpec' :: 'IniSpec' Config ()
-- 'configSpec' = do
--   'section' \"NETWORK\" $ do
--     cfHost '.=' 'field' \"host\" 'string'
--     cfPost '.=' 'field' \"port\" 'number'
--   'sectionOpt' \"LOCAL\" $ do
--     cfUser '.=?' 'field' \"user\" 'text'
-- @
--
-- There are two operators used to associate lenses with fields:
--
-- ['.='] Associates a lens of type @Lens' s a@ with a field description
--        of type @FieldDescription a@. By default, this will raise an
--        error when parsing if the field described is missing, but we
--        can mark it as optional, as we'll see.
--
-- ['.=?'] Associates a lens of type @Lens' s (Maybe a)@ with a field
--         description of type @FieldDescription a@. During parsing, if
--         the value does not appear in an INI file, then the lens will
--         be set to 'Nothing'; similarly, during serializing, if the
--         value is 'Nothing', then the field will not be serialized in
--         the file.
--
-- Each field must include the field's name as well as a 'FieldValue',
-- which describes how to both parse and serialize a value of a given
-- type. Several built-in 'FieldValue' descriptions are provided, but you
-- can always build your own by providing parsing and serialization
-- functions for individual fields.
--
-- We can also provide extra metadata about a field, allowing it to be
-- skipped durin parsing, or to provide an explicit default value, or to
-- include an explanatory comment for that value to be used when we
-- serialize an INI file. These are conventionally applied to the field
-- using the '&' operator:
--
-- @
-- configSpec :: 'IniSpec' Config ()
-- configSpec = do
--   'section' \"NETWORK\" $ do
--     cfHost '.=' 'field' \"host\" 'string'
--                 & 'comment' [\"The desired hostname (optional)\"]
--                 & 'optional'
--     cfPost '.=' 'field' \"port\" 'number'
--                 & 'comment' [\"The port number\"]
--   'sectionOpt' \"LOCAL\" $ do
--     cfUser '.=?' 'field' \"user\" 'text'
-- @
--
-- When we want to use this specification, we need to create a value of
-- type 'Ini', which is an abstract representation of an INI
-- specification. To create an 'Ini' value, we need to use the 'ini'
-- function, which combines the spec with the default version of our
-- configuration value.
--
-- Once we have a value of type 'Ini', we can use it for three basic
-- operations:
--
-- * We can parse a textual INI file with 'parseIni', which will
--   systematically walk the spec and use the provided lens/field
--   associations to create a parsed configuration file. This will give
--   us a new value of type 'Ini' that represents the parsed
--   configuration, and we can extract the actual configuration value
--   with 'getIniValue'.
--
-- * We can update the value contained in an 'Ini' value. If the 'Ini'
--   value is the result of a previous call to 'parseIni', then this
--   update will attempt to retain as much of the incidental structure of
--   the parsed file as it can: for example, it will attempt to retain
--   comments, whitespace, and ordering. The general strategy is to make
--   the resulting INI file "diff-minimal": the diff between the older
--   INI file and the updated INI file should contain as little noise as
--   possible. Small cosmetic choices such as how to treat generated
--   comments are controlled by a configurable 'UpdatePolicy' value.
--
-- * We can serialize an 'Ini' value to a textual INI file. This will
--   produce the specified INI file (either a default fresh INI, or a
--   modified existing INI) as a textual value.
module Data.Ini.Config.Bidir
  ( -- * Parsing, Serializing, and Updating Files
    -- $using
    Ini,
    ini,
    getIniValue,
    iniValueL,
    getRawIni,

    -- ** Parsing INI files
    parseIni,

    -- ** Serializing INI files
    serializeIni,

    -- ** Updating INI Files
    updateIni,
    setIniUpdatePolicy,
    UpdatePolicy (..),
    UpdateCommentPolicy (..),
    defaultUpdatePolicy,

    -- * Bidirectional Parser Types
    -- $types
    IniSpec,
    SectionSpec,

    -- * Section-Level Parsing
    -- $sections
    section,
    allOptional,

    -- * Field-Level Parsing
    -- $fields
    FieldDescription,
    (.=),
    (.=?),
    field,
    flag,
    comment,
    placeholderValue,
    optional,

    -- * FieldValues
    -- $fieldvalues
    FieldValue (..),
    text,
    string,
    number,
    bool,
    readable,
    listWithSeparator,
    pairWithSeparator,

    -- * Miscellaneous Helpers
    -- $misc
    (&),
    Lens,
  )
where

import Control.Monad.Trans.State.Strict (State, modify, runState)
import qualified Control.Monad.Trans.State.Strict as State
import qualified Data.Foldable as F
#if __GLASGOW_HASKELL__ >= 710
import           Data.Function ((&))
#endif

import Data.Ini.Config.Raw
import Data.Monoid ((<>))
import Data.Sequence (Seq, ViewL (..), ViewR (..), (<|))
import qualified Data.Sequence as Seq
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Traversable as F
import Data.Typeable (Proxy (..), Typeable, typeRep)
import GHC.Exts (IsList (..))
import Text.Read (readMaybe)

-- * Utility functions + lens stuffs

-- | This is a
--   <https://hackage.haskell.org/package/lens lens>-compatible
--   type alias
type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t

-- These are some inline reimplementations of "lens" operators. We
-- need the identity functor to implement 'set':
newtype I a = I {forall a. I a -> a
fromI :: a}

instance Functor I where fmap :: forall a b. (a -> b) -> I a -> I b
fmap a -> b
f (I a
x) = forall a. a -> I a
I (a -> b
f a
x)

set :: Lens s t a b -> b -> s -> t
set :: forall s t a b. Lens s t a b -> b -> s -> t
set Lens s t a b
lns b
x s
a = forall a. I a -> a
fromI (Lens s t a b
lns (forall a b. a -> b -> a
const (forall a. a -> I a
I b
x)) s
a)

-- ... and we need the const functor to implement 'get':
newtype C a b = C {forall a b. C a b -> a
fromC :: a}

instance Functor (C a) where fmap :: forall a b. (a -> b) -> C a a -> C a b
fmap a -> b
_ (C a
x) = forall a b. a -> C a b
C a
x

get :: Lens s t a b -> s -> a
get :: forall s t a b. Lens s t a b -> s -> a
get Lens s t a b
lns s
a = forall a b. C a b -> a
fromC (Lens s t a b
lns forall a b. a -> C a b
C s
a)

lkp :: NormalizedText -> Seq (NormalizedText, a) -> Maybe a
lkp :: forall a. NormalizedText -> Seq (NormalizedText, a) -> Maybe a
lkp NormalizedText
t = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
F.find (\(NormalizedText
t', a
_) -> NormalizedText
t' forall a. Eq a => a -> a -> Bool
== NormalizedText
t)

rmv :: NormalizedText -> Seq (Field s) -> Seq (Field s)
rmv :: forall s. NormalizedText -> Seq (Field s) -> Seq (Field s)
rmv NormalizedText
n = forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter (\Field s
f -> forall s. Field s -> NormalizedText
fieldName Field s
f forall a. Eq a => a -> a -> Bool
/= NormalizedText
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
  { forall s. Ini s -> Spec s
iniSpec :: Spec s,
    forall s. Ini s -> s
iniCurr :: s,
    forall s. Ini s -> s
iniDef :: s,
    forall s. Ini s -> Maybe RawIni
iniLast :: Maybe RawIni,
    forall s. Ini s -> UpdatePolicy
iniPol :: UpdatePolicy
  }

-- | Create a basic 'Ini' value from a default value and a spec.
ini :: s -> IniSpec s () -> Ini s
ini :: forall s. s -> IniSpec s () -> Ini s
ini s
def (IniSpec BidirM (Section s) ()
spec) =
  Ini
    { iniSpec :: Spec s
iniSpec = forall s a. BidirM s a -> Seq s
runBidirM BidirM (Section s) ()
spec,
      iniCurr :: s
iniCurr = s
def,
      iniDef :: s
iniDef = s
def,
      iniLast :: Maybe RawIni
iniLast = forall a. Maybe a
Nothing,
      iniPol :: UpdatePolicy
iniPol = UpdatePolicy
defaultUpdatePolicy
    }

-- | Get the underlying Haskell value associated with the 'Ini'.
getIniValue :: Ini s -> s
getIniValue :: forall s. Ini s -> s
getIniValue = forall s. Ini s -> s
iniCurr

mkLens :: (a -> b) -> (b -> a -> a) -> Lens a a b b
mkLens :: forall a b. (a -> b) -> (b -> a -> a) -> Lens a a b b
mkLens a -> b
get' b -> a -> a
set' b -> f b
f a
a = (b -> a -> a
`set'` a
a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` b -> f b
f (a -> b
get' a
a)

-- | The lens equivalent of 'getIniValue'
iniValueL :: Lens (Ini s) (Ini s) s s
iniValueL :: forall s. Lens (Ini s) (Ini s) s s
iniValueL = forall a b. (a -> b) -> (b -> a -> a) -> Lens a a b b
mkLens forall s. Ini s -> s
iniCurr (\s
i Ini s
v -> Ini s
v {iniCurr :: s
iniCurr = s
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 :: forall s. Ini s -> Text
serializeIni = RawIni -> Text
printRawIni forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. Ini s -> RawIni
getRawIni

-- | Get the underlying 'RawIni' value for the file.
getRawIni :: Ini s -> RawIni
getRawIni :: forall s. Ini s -> RawIni
getRawIni Ini {iniLast :: forall s. Ini s -> Maybe RawIni
iniLast = Just RawIni
raw} = RawIni
raw
getRawIni
  Ini
    { iniCurr :: forall s. Ini s -> s
iniCurr = s
s,
      iniSpec :: forall s. Ini s -> Spec s
iniSpec = Spec s
spec
    } =
    forall s. s -> Spec s -> RawIni
emitIniFile s
s Spec 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 :: forall s. Text -> Ini s -> Either String (Ini s)
parseIni
  Text
t
  i :: Ini s
i@Ini
    { iniSpec :: forall s. Ini s -> Spec s
iniSpec = Spec s
spec,
      iniCurr :: forall s. Ini s -> s
iniCurr = s
def
    } = do
    RawIni Seq (NormalizedText, IniSection)
raw <- Text -> Either String RawIni
parseRawIni Text
t
    s
s <- forall s.
s
-> ViewL (Section s)
-> Seq (NormalizedText, IniSection)
-> Either String s
parseSections s
def (forall a. Seq a -> ViewL a
Seq.viewl Spec s
spec) Seq (NormalizedText, IniSection)
raw
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
      Ini s
i
        { iniCurr :: s
iniCurr = s
s,
          iniLast :: Maybe RawIni
iniLast = forall a. a -> Maybe a
Just (Seq (NormalizedText, IniSection) -> RawIni
RawIni Seq (NormalizedText, IniSection)
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 :: forall s. s -> Ini s -> Ini s
updateIni s
new Ini s
i =
  case forall s. s -> Ini s -> Either String (Ini s)
doUpdateIni s
new Ini s
i of
    Left String
err -> forall a. HasCallStack => String -> a
error String
err
    Right Ini s
i' -> Ini s
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 :: forall s. UpdatePolicy -> Ini s -> Ini s
setIniUpdatePolicy UpdatePolicy
pol Ini s
i = Ini s
i {iniPol :: UpdatePolicy
iniPol = UpdatePolicy
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.
    forall a. FieldValue a -> Text -> Either String a
fvParse :: Text -> Either String a,
    -- | The function to use when serializing a value into an INI
    -- file.
    forall a. FieldValue a -> a -> Text
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 :: forall s a. BidirM s a -> Seq s
runBidirM = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s a. State s a -> s -> (a, s)
runState forall a. Seq a
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 (forall a b. a -> IniSpec s b -> IniSpec s a
forall a b. (a -> b) -> IniSpec s a -> IniSpec s b
forall s a b. a -> IniSpec s b -> IniSpec s a
forall s a b. (a -> b) -> IniSpec s a -> IniSpec s b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> IniSpec s b -> IniSpec s a
$c<$ :: forall s a b. a -> IniSpec s b -> IniSpec s a
fmap :: forall a b. (a -> b) -> IniSpec s a -> IniSpec s b
$cfmap :: forall s a b. (a -> b) -> IniSpec s a -> IniSpec s b
Functor, forall s. Functor (IniSpec s)
forall a. a -> IniSpec s a
forall s a. a -> IniSpec s a
forall a b. IniSpec s a -> IniSpec s b -> IniSpec s a
forall a b. IniSpec s a -> IniSpec s b -> IniSpec s b
forall a b. IniSpec s (a -> b) -> IniSpec s a -> IniSpec s b
forall s a b. IniSpec s a -> IniSpec s b -> IniSpec s a
forall s a b. IniSpec s a -> IniSpec s b -> IniSpec s b
forall s a b. IniSpec s (a -> b) -> IniSpec s a -> IniSpec s b
forall a b c.
(a -> b -> c) -> IniSpec s a -> IniSpec s b -> IniSpec s c
forall s a b c.
(a -> b -> c) -> IniSpec s a -> IniSpec s b -> IniSpec s c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. IniSpec s a -> IniSpec s b -> IniSpec s a
$c<* :: forall s a b. IniSpec s a -> IniSpec s b -> IniSpec s a
*> :: forall a b. IniSpec s a -> IniSpec s b -> IniSpec s b
$c*> :: forall s a b. IniSpec s a -> IniSpec s b -> IniSpec s b
liftA2 :: forall a b c.
(a -> b -> c) -> IniSpec s a -> IniSpec s b -> IniSpec s c
$cliftA2 :: forall s a b c.
(a -> b -> c) -> IniSpec s a -> IniSpec s b -> IniSpec s c
<*> :: forall a b. IniSpec s (a -> b) -> IniSpec s a -> IniSpec s b
$c<*> :: forall s a b. IniSpec s (a -> b) -> IniSpec s a -> IniSpec s b
pure :: forall a. a -> IniSpec s a
$cpure :: forall s a. a -> IniSpec s a
Applicative, forall s. Applicative (IniSpec s)
forall a. a -> IniSpec s a
forall s a. a -> IniSpec s a
forall a b. IniSpec s a -> IniSpec s b -> IniSpec s b
forall a b. IniSpec s a -> (a -> IniSpec s b) -> IniSpec s b
forall s a b. IniSpec s a -> IniSpec s b -> IniSpec s b
forall s a b. IniSpec s a -> (a -> IniSpec s b) -> IniSpec s b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> IniSpec s a
$creturn :: forall s a. a -> IniSpec s a
>> :: forall a b. IniSpec s a -> IniSpec s b -> IniSpec s b
$c>> :: forall s a b. IniSpec s a -> IniSpec s b -> IniSpec s b
>>= :: forall a b. IniSpec s a -> (a -> IniSpec s b) -> IniSpec s b
$c>>= :: forall s a b. IniSpec s a -> (a -> IniSpec s b) -> IniSpec s b
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 (forall a b. a -> SectionSpec s b -> SectionSpec s a
forall a b. (a -> b) -> SectionSpec s a -> SectionSpec s b
forall s a b. a -> SectionSpec s b -> SectionSpec s a
forall s a b. (a -> b) -> SectionSpec s a -> SectionSpec s b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> SectionSpec s b -> SectionSpec s a
$c<$ :: forall s a b. a -> SectionSpec s b -> SectionSpec s a
fmap :: forall a b. (a -> b) -> SectionSpec s a -> SectionSpec s b
$cfmap :: forall s a b. (a -> b) -> SectionSpec s a -> SectionSpec s b
Functor, forall s. Functor (SectionSpec s)
forall a. a -> SectionSpec s a
forall s a. a -> SectionSpec s a
forall a b. SectionSpec s a -> SectionSpec s b -> SectionSpec s a
forall a b. SectionSpec s a -> SectionSpec s b -> SectionSpec s b
forall a b.
SectionSpec s (a -> b) -> SectionSpec s a -> SectionSpec s b
forall s a b. SectionSpec s a -> SectionSpec s b -> SectionSpec s a
forall s a b. SectionSpec s a -> SectionSpec s b -> SectionSpec s b
forall s a b.
SectionSpec s (a -> b) -> SectionSpec s a -> SectionSpec s b
forall a b c.
(a -> b -> c)
-> SectionSpec s a -> SectionSpec s b -> SectionSpec s c
forall s a b c.
(a -> b -> c)
-> SectionSpec s a -> SectionSpec s b -> SectionSpec s c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. SectionSpec s a -> SectionSpec s b -> SectionSpec s a
$c<* :: forall s a b. SectionSpec s a -> SectionSpec s b -> SectionSpec s a
*> :: forall a b. SectionSpec s a -> SectionSpec s b -> SectionSpec s b
$c*> :: forall s a b. SectionSpec s a -> SectionSpec s b -> SectionSpec s b
liftA2 :: forall a b c.
(a -> b -> c)
-> SectionSpec s a -> SectionSpec s b -> SectionSpec s c
$cliftA2 :: forall s a b c.
(a -> b -> c)
-> SectionSpec s a -> SectionSpec s b -> SectionSpec s c
<*> :: forall a b.
SectionSpec s (a -> b) -> SectionSpec s a -> SectionSpec s b
$c<*> :: forall s a b.
SectionSpec s (a -> b) -> SectionSpec s a -> SectionSpec s b
pure :: forall a. a -> SectionSpec s a
$cpure :: forall s a. a -> SectionSpec s a
Applicative, forall s. Applicative (SectionSpec s)
forall a. a -> SectionSpec s a
forall s a. a -> SectionSpec s a
forall a b. SectionSpec s a -> SectionSpec s b -> SectionSpec s b
forall a b.
SectionSpec s a -> (a -> SectionSpec s b) -> SectionSpec s b
forall s a b. SectionSpec s a -> SectionSpec s b -> SectionSpec s b
forall s a b.
SectionSpec s a -> (a -> SectionSpec s b) -> SectionSpec s b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> SectionSpec s a
$creturn :: forall s a. a -> SectionSpec s a
>> :: forall a b. SectionSpec s a -> SectionSpec s b -> SectionSpec s b
$c>> :: forall s a b. SectionSpec s a -> SectionSpec s b -> SectionSpec s b
>>= :: forall a b.
SectionSpec s a -> (a -> SectionSpec s b) -> SectionSpec s b
$c>>= :: forall s a b.
SectionSpec s a -> (a -> SectionSpec s b) -> SectionSpec s b
Monad)

-- * Sections

-- | Define the specification of a top-level INI section.
section :: Text -> SectionSpec s () -> IniSpec s ()
section :: forall s. Text -> SectionSpec s () -> IniSpec s ()
section Text
name (SectionSpec BidirM (Field s) ()
mote) = forall s a. BidirM (Section s) a -> IniSpec s a
IniSpec forall a b. (a -> b) -> a -> b
$ do
  let fields :: Seq (Field s)
fields = forall s a. BidirM s a -> Seq s
runBidirM BidirM (Field s) ()
mote
  forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify (forall a. Seq a -> a -> Seq a
Seq.|> forall s. NormalizedText -> Seq (Field s) -> Bool -> Section s
Section (Text -> NormalizedText
normalize Text
name) Seq (Field s)
fields (forall s. Seq (Field s) -> Bool
allFieldsOptional Seq (Field s)
fields))

allFieldsOptional :: Seq (Field s) -> Bool
allFieldsOptional :: forall s. Seq (Field s) -> Bool
allFieldsOptional = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all forall {s}. Field s -> Bool
isOptional
  where
    isOptional :: Field s -> Bool
isOptional (Field Lens s s a a
_ FieldDescription a
fd) = forall t. FieldDescription t -> Bool
fdSkipIfMissing FieldDescription a
fd
    isOptional (FieldMb Lens s s (Maybe a) (Maybe a)
_ FieldDescription a
_) = Bool
True

-- | Treat an entire section as containing entirely optional fields.
allOptional ::
  (SectionSpec s () -> IniSpec s ()) ->
  (SectionSpec s () -> IniSpec s ())
allOptional :: forall s.
(SectionSpec s () -> IniSpec s ())
-> SectionSpec s () -> IniSpec s ()
allOptional SectionSpec s () -> IniSpec s ()
k SectionSpec s ()
spec = forall s a. BidirM (Section s) a -> IniSpec s a
IniSpec forall a b. (a -> b) -> a -> b
$ do
  let IniSpec BidirM (Section s) ()
comp = SectionSpec s () -> IniSpec s ()
k SectionSpec s ()
spec
  BidirM (Section s) ()
comp
  forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify
    ( \Seq (Section s)
s -> case forall a. Seq a -> ViewR a
Seq.viewr Seq (Section s)
s of
        ViewR (Section s)
EmptyR -> Seq (Section s)
s
        Seq (Section s)
rs :> Section NormalizedText
name Seq (Field s)
fields Bool
_ ->
          Seq (Section s)
rs forall a. Seq a -> a -> Seq a
Seq.|> forall s. NormalizedText -> Seq (Field s) -> Bool -> Section s
Section NormalizedText
name (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall s. Field s -> Field s
makeOptional Seq (Field s)
fields) Bool
True
    )

makeOptional :: Field s -> Field s
makeOptional :: forall s. Field s -> Field s
makeOptional (Field Lens s s a a
l FieldDescription a
d) = forall s a. Eq a => Lens s s a a -> FieldDescription a -> Field s
Field Lens s s a a
l FieldDescription a
d {fdSkipIfMissing :: Bool
fdSkipIfMissing = Bool
True}
makeOptional (FieldMb Lens s s (Maybe a) (Maybe a)
l FieldDescription a
d) = forall s a.
Eq a =>
Lens s s (Maybe a) (Maybe a) -> FieldDescription a -> Field s
FieldMb Lens s s (Maybe a) (Maybe a)
l FieldDescription a
d {fdSkipIfMissing :: Bool
fdSkipIfMissing = Bool
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 :: forall s. Field s -> NormalizedText
fieldName (Field Lens s s a a
_ FieldDescription {fdName :: forall t. FieldDescription t -> NormalizedText
fdName = NormalizedText
n}) = NormalizedText
n
fieldName (FieldMb Lens s s (Maybe a) (Maybe a)
_ FieldDescription {fdName :: forall t. FieldDescription t -> NormalizedText
fdName = NormalizedText
n}) = NormalizedText
n

fieldComment :: Field s -> Seq Text
fieldComment :: forall s. Field s -> Seq Text
fieldComment (Field Lens s s a a
_ FieldDescription {fdComment :: forall t. FieldDescription t -> Seq Text
fdComment = Seq Text
n}) = Seq Text
n
fieldComment (FieldMb Lens s s (Maybe a) (Maybe a)
_ FieldDescription {fdComment :: forall t. FieldDescription t -> Seq Text
fdComment = Seq Text
n}) = Seq Text
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
  { forall t. FieldDescription t -> NormalizedText
fdName :: NormalizedText,
    forall t. FieldDescription t -> FieldValue t
fdValue :: FieldValue t,
    forall t. FieldDescription t -> Seq Text
fdComment :: Seq Text,
    forall t. FieldDescription t -> Maybe Text
fdDummy :: Maybe Text,
    forall t. FieldDescription t -> Bool
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 ()
Lens s s t t
l .= :: forall t s.
Eq t =>
Lens s s t t -> FieldDescription t -> SectionSpec s ()
.= FieldDescription t
f = forall s a. BidirM (Field s) a -> SectionSpec s a
SectionSpec forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify (forall a. Seq a -> a -> Seq a
Seq.|> Field s
fd)
  where
    fd :: Field s
fd = forall s a. Eq a => Lens s s a a -> FieldDescription a -> Field s
Field Lens s s t t
l FieldDescription t
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 ()
Lens s s (Maybe t) (Maybe t)
l .=? :: forall t s.
Eq t =>
Lens s s (Maybe t) (Maybe t)
-> FieldDescription t -> SectionSpec s ()
.=? FieldDescription t
f = forall s a. BidirM (Field s) a -> SectionSpec s a
SectionSpec forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify (forall a. Seq a -> a -> Seq a
Seq.|> Field s
fd)
  where
    fd :: Field s
fd = forall s a.
Eq a =>
Lens s s (Maybe a) (Maybe a) -> FieldDescription a -> Field s
FieldMb Lens s s (Maybe t) (Maybe t)
l FieldDescription t
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 :: forall t. [Text] -> FieldDescription t -> FieldDescription t
comment [Text]
cmt FieldDescription t
fd = FieldDescription t
fd {fdComment :: Seq Text
fdComment = forall a. [a] -> Seq a
Seq.fromList [Text]
cmt}

-- | Choose a placeholder value to be displayed for optional fields.
--   This is used when serializing an optional Ini field: the
--   field will appear commented out in the output using the
--   placeholder text as a value, so a spec that includes
--
--   @
--   myLens .=? field "x" & placeholderValue "\<val\>"
--   @
--
--   will serialize into an INI file that contains the line
--
--   @
--   # x = \<val\>
--   @
--
--   A placeholder value will only appear in the serialized output if
--   the field is optional, but will be preferred over serializing the
--   default value for an optional field. This will not affect INI
--   file updates.
placeholderValue :: Text -> FieldDescription t -> FieldDescription t
placeholderValue :: forall t. Text -> FieldDescription t -> FieldDescription t
placeholderValue Text
t FieldDescription t
fd = FieldDescription t
fd {fdDummy :: Maybe Text
fdDummy = forall a. a -> Maybe a
Just Text
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 :: forall t. FieldDescription t -> FieldDescription t
optional FieldDescription t
fd = FieldDescription t
fd {fdSkipIfMissing :: Bool
fdSkipIfMissing = Bool
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 :: forall a. Text -> FieldValue a -> FieldDescription a
field Text
name FieldValue a
value =
  FieldDescription
    { fdName :: NormalizedText
fdName = Text -> NormalizedText
normalize (Text
name forall a. Semigroup a => a -> a -> a
<> Text
" "),
      fdValue :: FieldValue a
fdValue = FieldValue a
value,
      fdComment :: Seq Text
fdComment = forall a. Seq a
Seq.empty,
      fdDummy :: Maybe Text
fdDummy = forall a. Maybe a
Nothing,
      fdSkipIfMissing :: Bool
fdSkipIfMissing = Bool
False
    }

-- | Create a description of a 'Bool'-valued field.
flag :: Text -> FieldDescription Bool
flag :: Text -> FieldDescription Bool
flag Text
name = forall a. Text -> FieldValue a -> FieldDescription a
field Text
name FieldValue Bool
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 :: forall a. (Show a, Read a, Typeable a) => FieldValue a
readable = FieldValue {fvParse :: Text -> Either String a
fvParse = forall {b}. Read b => Text -> Either String b
parse, fvEmit :: a -> Text
fvEmit = a -> Text
emit}
  where
    emit :: a -> Text
emit = String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
    parse :: Text -> Either String b
parse Text
t = case forall a. Read a => String -> Maybe a
readMaybe (Text -> String
T.unpack Text
t) of
      Just b
v -> forall a b. b -> Either a b
Right b
v
      Maybe b
Nothing ->
        forall a b. a -> Either a b
Left
          ( String
"Unable to parse " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Text
t
              forall a. [a] -> [a] -> [a]
++ String
" as a value of type "
              forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show TypeRep
typ
          )
    typ :: TypeRep
typ = forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy a
prx
    prx :: Proxy a
    prx :: Proxy a
prx = forall {k} (t :: k). Proxy t
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 :: forall a. (Show a, Read a, Num a, Typeable a) => FieldValue a
number = forall a. (Show a, Read a, Typeable a) => FieldValue a
readable

-- | Represents a field whose value is a 'Text' value
text :: FieldValue Text
text :: FieldValue Text
text = FieldValue {fvParse :: Text -> Either String Text
fvParse = forall a b. b -> Either a b
Right, fvEmit :: Text -> Text
fvEmit = forall a. a -> a
id}

-- | Represents a field whose value is a 'String' value
string :: FieldValue String
string :: FieldValue String
string = FieldValue {fvParse :: Text -> Either String String
fvParse = forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack, fvEmit :: String -> Text
fvEmit = String -> Text
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 Bool
bool = FieldValue {fvParse :: Text -> Either String Bool
fvParse = Text -> Either String Bool
parse, fvEmit :: Bool -> Text
fvEmit = forall {a}. IsString a => Bool -> a
emit}
  where
    parse :: Text -> Either String Bool
parse Text
s = case Text -> Text
T.toLower Text
s of
      Text
"true" -> forall a b. b -> Either a b
Right Bool
True
      Text
"yes" -> forall a b. b -> Either a b
Right Bool
True
      Text
"t" -> forall a b. b -> Either a b
Right Bool
True
      Text
"y" -> forall a b. b -> Either a b
Right Bool
True
      Text
"false" -> forall a b. b -> Either a b
Right Bool
False
      Text
"no" -> forall a b. b -> Either a b
Right Bool
False
      Text
"f" -> forall a b. b -> Either a b
Right Bool
False
      Text
"n" -> forall a b. b -> Either a b
Right Bool
False
      Text
_ -> forall a b. a -> Either a b
Left (String
"Unable to parse " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Text
s forall a. [a] -> [a] -> [a]
++ String
" as a boolean")
    emit :: Bool -> a
emit Bool
True = a
"true"
    emit Bool
False = a
"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 :: forall l. IsList l => Text -> FieldValue (Item l) -> FieldValue l
listWithSeparator Text
sep FieldValue (Item l)
fv =
  FieldValue
    { fvParse :: Text -> Either String l
fvParse = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall l. IsList l => [Item l] -> l
fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a. FieldValue a -> Text -> Either String a
fvParse FieldValue (Item l)
fv forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Text]
T.splitOn Text
sep,
      fvEmit :: l -> Text
fvEmit = Text -> [Text] -> Text
T.intercalate Text
sep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. FieldValue a -> a -> Text
fvEmit FieldValue (Item l)
fv) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l. IsList l => l -> [Item l]
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 :: forall l r.
FieldValue l -> Text -> FieldValue r -> FieldValue (l, r)
pairWithSeparator FieldValue l
left Text
sep FieldValue r
right =
  FieldValue
    { fvParse :: Text -> Either String (l, r)
fvParse = \Text
t ->
        let (Text
leftChunk, Text
rightChunk) = Text -> Text -> (Text, Text)
T.breakOn Text
sep Text
t
         in do
              l
x <- forall a. FieldValue a -> Text -> Either String a
fvParse FieldValue l
left Text
leftChunk
              r
y <- forall a. FieldValue a -> Text -> Either String a
fvParse FieldValue r
right Text
rightChunk
              forall (m :: * -> *) a. Monad m => a -> m a
return (l
x, r
y),
      fvEmit :: (l, r) -> Text
fvEmit = \(l
x, r
y) -> forall a. FieldValue a -> a -> Text
fvEmit FieldValue l
left l
x forall a. Semigroup a => a -> a -> a
<> Text
sep forall a. Semigroup a => a -> a -> a
<> forall a. FieldValue a -> a -> Text
fvEmit FieldValue r
right r
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 :: forall s.
s
-> ViewL (Section s)
-> Seq (NormalizedText, IniSection)
-> Either String s
parseSections s
s ViewL (Section s)
Seq.EmptyL Seq (NormalizedText, IniSection)
_ = forall a b. b -> Either a b
Right s
s
parseSections s
s (Section NormalizedText
name Seq (Field s)
fs Bool
opt Seq.:< Seq (Section s)
rest) Seq (NormalizedText, IniSection)
i
  | Just IniSection
v <- forall a. NormalizedText -> Seq (NormalizedText, a) -> Maybe a
lkp NormalizedText
name Seq (NormalizedText, IniSection)
i = do
    s
s' <- forall s. s -> ViewL (Field s) -> IniSection -> Either String s
parseFields s
s (forall a. Seq a -> ViewL a
Seq.viewl Seq (Field s)
fs) IniSection
v
    forall s.
s
-> ViewL (Section s)
-> Seq (NormalizedText, IniSection)
-> Either String s
parseSections s
s' (forall a. Seq a -> ViewL a
Seq.viewl Seq (Section s)
rest) Seq (NormalizedText, IniSection)
i
  | Bool
opt = forall s.
s
-> ViewL (Section s)
-> Seq (NormalizedText, IniSection)
-> Either String s
parseSections s
s (forall a. Seq a -> ViewL a
Seq.viewl Seq (Section s)
rest) Seq (NormalizedText, IniSection)
i
  | Bool
otherwise =
    forall a b. a -> Either a b
Left
      ( String
"Unable to find section "
          forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (NormalizedText -> Text
normalizedText 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 :: forall s. s -> ViewL (Field s) -> IniSection -> Either String s
parseFields s
s ViewL (Field s)
Seq.EmptyL IniSection
_ = forall a b. b -> Either a b
Right s
s
parseFields s
s (Field Lens s s a a
l FieldDescription a
descr Seq.:< Seq (Field s)
fs) IniSection
sect
  | Just IniValue
v <- forall a. NormalizedText -> Seq (NormalizedText, a) -> Maybe a
lkp (forall t. FieldDescription t -> NormalizedText
fdName FieldDescription a
descr) (IniSection -> Seq (NormalizedText, IniValue)
isVals IniSection
sect) = do
    a
value <- forall a. FieldValue a -> Text -> Either String a
fvParse (forall t. FieldDescription t -> FieldValue t
fdValue FieldDescription a
descr) (Text -> Text
T.strip (IniValue -> Text
vValue IniValue
v))
    forall s. s -> ViewL (Field s) -> IniSection -> Either String s
parseFields (forall s t a b. Lens s t a b -> b -> s -> t
set Lens s s a a
l a
value s
s) (forall a. Seq a -> ViewL a
Seq.viewl Seq (Field s)
fs) IniSection
sect
  | forall t. FieldDescription t -> Bool
fdSkipIfMissing FieldDescription a
descr =
    forall s. s -> ViewL (Field s) -> IniSection -> Either String s
parseFields s
s (forall a. Seq a -> ViewL a
Seq.viewl Seq (Field s)
fs) IniSection
sect
  | Bool
otherwise =
    forall a b. a -> Either a b
Left
      ( String
"Unable to find field "
          forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (NormalizedText -> Text
normalizedText (forall t. FieldDescription t -> NormalizedText
fdName FieldDescription a
descr))
      )
parseFields s
s (FieldMb Lens s s (Maybe a) (Maybe a)
l FieldDescription a
descr Seq.:< Seq (Field s)
fs) IniSection
sect
  | Just IniValue
v <- forall a. NormalizedText -> Seq (NormalizedText, a) -> Maybe a
lkp (forall t. FieldDescription t -> NormalizedText
fdName FieldDescription a
descr) (IniSection -> Seq (NormalizedText, IniValue)
isVals IniSection
sect) = do
    a
value <- forall a. FieldValue a -> Text -> Either String a
fvParse (forall t. FieldDescription t -> FieldValue t
fdValue FieldDescription a
descr) (Text -> Text
T.strip (IniValue -> Text
vValue IniValue
v))
    forall s. s -> ViewL (Field s) -> IniSection -> Either String s
parseFields (forall s t a b. Lens s t a b -> b -> s -> t
set Lens s s (Maybe a) (Maybe a)
l (forall a. a -> Maybe a
Just a
value) s
s) (forall a. Seq a -> ViewL a
Seq.viewl Seq (Field s)
fs) IniSection
sect
  | Bool
otherwise =
    forall s. s -> ViewL (Field s) -> IniSection -> Either String s
parseFields (forall s t a b. Lens s t a b -> b -> s -> t
set Lens s s (Maybe a) (Maybe a)
l forall a. Maybe a
Nothing s
s) (forall a. Seq a -> ViewL a
Seq.viewl Seq (Field s)
fs) IniSection
sect

-- | Serialize a value as an INI file according to a provided
-- 'IniSpec'.
emitIniFile :: s -> Spec s -> RawIni
emitIniFile :: forall s. s -> Spec s -> RawIni
emitIniFile s
s Spec s
spec =
  Seq (NormalizedText, IniSection) -> RawIni
RawIni forall a b. (a -> b) -> a -> b
$
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
      ( \(Section NormalizedText
name Seq (Field s)
fs Bool
_) ->
          (NormalizedText
name, forall s. s -> Text -> Seq (Field s) -> IniSection
toSection s
s (NormalizedText -> Text
actualText NormalizedText
name) Seq (Field s)
fs)
      )
      Spec s
spec

mkComments :: Seq Text -> Seq BlankLine
mkComments :: Seq Text -> Seq BlankLine
mkComments = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Text
ln -> Char -> Text -> BlankLine
CommentLine Char
'#' (Text
" " forall a. Semigroup a => a -> a -> a
<> Text
ln))

toSection :: s -> Text -> Seq (Field s) -> IniSection
toSection :: forall s. s -> Text -> Seq (Field s) -> IniSection
toSection s
s Text
name Seq (Field s)
fs =
  IniSection
    { isName :: Text
isName = Text
name,
      isVals :: Seq (NormalizedText, IniValue)
isVals = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Field s -> (NormalizedText, IniValue)
toVal Seq (Field s)
fs,
      isStartLine :: Int
isStartLine = Int
0,
      isEndLine :: Int
isEndLine = Int
0,
      isComments :: Seq BlankLine
isComments = forall a. Seq a
Seq.empty
    }
  where
    mkIniValue :: Text -> FieldDescription t -> Bool -> (NormalizedText, IniValue)
mkIniValue Text
val FieldDescription t
descr Bool
opt =
      ( forall t. FieldDescription t -> NormalizedText
fdName FieldDescription t
descr,
        IniValue
          { vLineNo :: Int
vLineNo = Int
0,
            vName :: Text
vName = NormalizedText -> Text
actualText (forall t. FieldDescription t -> NormalizedText
fdName FieldDescription t
descr),
            vValue :: Text
vValue = Text
" " forall a. Semigroup a => a -> a -> a
<> Text
val,
            vComments :: Seq BlankLine
vComments = Seq Text -> Seq BlankLine
mkComments (forall t. FieldDescription t -> Seq Text
fdComment FieldDescription t
descr),
            vCommentedOut :: Bool
vCommentedOut = Bool
opt,
            vDelimiter :: Char
vDelimiter = Char
'='
          }
      )
    toVal :: Field s -> (NormalizedText, IniValue)
toVal (Field Lens s s a a
l FieldDescription a
descr)
      | Just Text
dummy <- forall t. FieldDescription t -> Maybe Text
fdDummy FieldDescription a
descr =
        forall {t}.
Text -> FieldDescription t -> Bool -> (NormalizedText, IniValue)
mkIniValue Text
dummy FieldDescription a
descr Bool
False
      | Bool
otherwise =
        forall {t}.
Text -> FieldDescription t -> Bool -> (NormalizedText, IniValue)
mkIniValue (forall a. FieldValue a -> a -> Text
fvEmit (forall t. FieldDescription t -> FieldValue t
fdValue FieldDescription a
descr) (forall s t a b. Lens s t a b -> s -> a
get Lens s s a a
l s
s)) FieldDescription a
descr Bool
False
    toVal (FieldMb Lens s s (Maybe a) (Maybe a)
l FieldDescription a
descr)
      | Just Text
dummy <- forall t. FieldDescription t -> Maybe Text
fdDummy FieldDescription a
descr =
        forall {t}.
Text -> FieldDescription t -> Bool -> (NormalizedText, IniValue)
mkIniValue Text
dummy FieldDescription a
descr Bool
True
      | Just a
v <- forall s t a b. Lens s t a b -> s -> a
get Lens s s (Maybe a) (Maybe a)
l s
s =
        forall {t}.
Text -> FieldDescription t -> Bool -> (NormalizedText, IniValue)
mkIniValue (forall a. FieldValue a -> a -> Text
fvEmit (forall t. FieldDescription t -> FieldValue t
fdValue FieldDescription a
descr) a
v) FieldDescription a
descr Bool
True
      | Bool
otherwise =
        forall {t}.
Text -> FieldDescription t -> Bool -> (NormalizedText, IniValue)
mkIniValue Text
"" FieldDescription a
descr Bool
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'.
    UpdatePolicy -> Bool
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'.
    UpdatePolicy -> Bool
updateIgnoreExtraneousFields :: Bool,
    -- | The policy for what to do to comments associated with
    -- modified fields during an update. Defaults to
    -- 'CommentPolicyNone'.
    UpdatePolicy -> UpdateCommentPolicy
updateGeneratedCommentPolicy :: UpdateCommentPolicy
  }
  deriving (UpdatePolicy -> UpdatePolicy -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdatePolicy -> UpdatePolicy -> Bool
$c/= :: UpdatePolicy -> UpdatePolicy -> Bool
== :: UpdatePolicy -> UpdatePolicy -> Bool
$c== :: UpdatePolicy -> UpdatePolicy -> Bool
Eq, Int -> UpdatePolicy -> ShowS
[UpdatePolicy] -> ShowS
UpdatePolicy -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdatePolicy] -> ShowS
$cshowList :: [UpdatePolicy] -> ShowS
show :: UpdatePolicy -> String
$cshow :: UpdatePolicy -> String
showsPrec :: Int -> UpdatePolicy -> ShowS
$cshowsPrec :: Int -> UpdatePolicy -> ShowS
Show)

-- | A set of sensible 'UpdatePolicy' defaults which keep the diffs
-- between file versions minimal.
defaultUpdatePolicy :: UpdatePolicy
defaultUpdatePolicy :: UpdatePolicy
defaultUpdatePolicy =
  UpdatePolicy
    { updateAddOptionalFields :: Bool
updateAddOptionalFields = Bool
False,
      updateIgnoreExtraneousFields :: Bool
updateIgnoreExtraneousFields = Bool
True,
      updateGeneratedCommentPolicy :: UpdateCommentPolicy
updateGeneratedCommentPolicy = UpdateCommentPolicy
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 (UpdateCommentPolicy -> UpdateCommentPolicy -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateCommentPolicy -> UpdateCommentPolicy -> Bool
$c/= :: UpdateCommentPolicy -> UpdateCommentPolicy -> Bool
== :: UpdateCommentPolicy -> UpdateCommentPolicy -> Bool
$c== :: UpdateCommentPolicy -> UpdateCommentPolicy -> Bool
Eq, Int -> UpdateCommentPolicy -> ShowS
[UpdateCommentPolicy] -> ShowS
UpdateCommentPolicy -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateCommentPolicy] -> ShowS
$cshowList :: [UpdateCommentPolicy] -> ShowS
show :: UpdateCommentPolicy -> String
$cshow :: UpdateCommentPolicy -> String
showsPrec :: Int -> UpdateCommentPolicy -> ShowS
$cshowsPrec :: Int -> UpdateCommentPolicy -> ShowS
Show)

getComments :: FieldDescription s -> UpdateCommentPolicy -> Seq BlankLine
getComments :: forall s.
FieldDescription s -> UpdateCommentPolicy -> Seq BlankLine
getComments FieldDescription s
_ UpdateCommentPolicy
CommentPolicyNone = forall a. Seq a
Seq.empty
getComments FieldDescription s
f UpdateCommentPolicy
CommentPolicyAddFieldComment =
  Seq Text -> Seq BlankLine
mkComments (forall t. FieldDescription t -> Seq Text
fdComment FieldDescription s
f)
getComments FieldDescription s
_ (CommentPolicyAddDefaultComment Seq Text
cs) =
  Seq Text -> Seq BlankLine
mkComments Seq Text
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 :: forall s. s -> Ini s -> Either String (Ini s)
doUpdateIni
  s
s
  i :: Ini s
i@Ini
    { iniSpec :: forall s. Ini s -> Spec s
iniSpec = Spec s
spec,
      iniDef :: forall s. Ini s -> s
iniDef = s
def,
      iniPol :: forall s. Ini s -> UpdatePolicy
iniPol = UpdatePolicy
pol
    } = do
    -- spec (RawIni ini) pol = do
    let RawIni Seq (NormalizedText, IniSection)
ini' = forall s. Ini s -> RawIni
getRawIni Ini s
i
    Seq (NormalizedText, IniSection)
res <- forall s.
s
-> s
-> Seq (NormalizedText, IniSection)
-> Seq (Section s)
-> UpdatePolicy
-> Either String (Seq (NormalizedText, IniSection))
updateSections s
s s
def Seq (NormalizedText, IniSection)
ini' Spec s
spec UpdatePolicy
pol
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
      Ini s
i
        { iniCurr :: s
iniCurr = s
s,
          iniLast :: Maybe RawIni
iniLast = forall a. a -> Maybe a
Just (Seq (NormalizedText, IniSection) -> RawIni
RawIni Seq (NormalizedText, IniSection)
res)
        }

updateSections ::
  s ->
  s ->
  Seq (NormalizedText, IniSection) ->
  Seq (Section s) ->
  UpdatePolicy ->
  Either String (Seq (NormalizedText, IniSection))
updateSections :: forall s.
s
-> s
-> Seq (NormalizedText, IniSection)
-> Seq (Section s)
-> UpdatePolicy
-> Either String (Seq (NormalizedText, IniSection))
updateSections s
s s
def Seq (NormalizedText, IniSection)
sections Seq (Section s)
fields UpdatePolicy
pol = do
  -- First, we process all the sections that actually appear in the
  -- INI file in order
  Seq (NormalizedText, IniSection)
existingSections <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
F.for Seq (NormalizedText, IniSection)
sections forall a b. (a -> b) -> a -> b
$ \(NormalizedText
name, IniSection
sec) -> do
    let err :: Either String b
err = forall a b. a -> Either a b
Left (String
"Unexpected top-level section: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show NormalizedText
name)
    Section NormalizedText
_ Seq (Field s)
spec Bool
_ <-
      forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        forall {b}. Either String b
err
        forall a b. b -> Either a b
Right
        (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
F.find (\(Section NormalizedText
n Seq (Field s)
_ Bool
_) -> NormalizedText
n forall a. Eq a => a -> a -> Bool
== NormalizedText
name) Seq (Section s)
fields)
    Seq (NormalizedText, IniValue)
newVals <- forall s.
s
-> Seq (NormalizedText, IniValue)
-> Seq (Field s)
-> UpdatePolicy
-> Either String (Seq (NormalizedText, IniValue))
updateFields s
s (IniSection -> Seq (NormalizedText, IniValue)
isVals IniSection
sec) Seq (Field s)
spec UpdatePolicy
pol
    forall (m :: * -> *) a. Monad m => a -> m a
return (NormalizedText
name, IniSection
sec {isVals :: Seq (NormalizedText, IniValue)
isVals = Seq (NormalizedText, IniValue)
newVals})
  -- And then
  let existingSectionNames :: Seq NormalizedText
existingSectionNames = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst Seq (NormalizedText, IniSection)
existingSections
  Seq (Seq (NormalizedText, IniSection))
newSections <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
F.for Seq (Section s)
fields forall a b. (a -> b) -> a -> b
$
    \(Section NormalizedText
nm Seq (Field s)
spec Bool
_) ->
      if NormalizedText
nm forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Seq NormalizedText
existingSectionNames
        then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
        else
          let rs :: Seq (NormalizedText, IniValue)
rs = forall s.
s
-> s
-> Seq (Field s)
-> UpdatePolicy
-> Seq (NormalizedText, IniValue)
emitNewFields s
s s
def Seq (Field s)
spec UpdatePolicy
pol
           in if forall a. Seq a -> Bool
Seq.null Seq (NormalizedText, IniValue)
rs
                then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
                else
                  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
                    forall a. a -> Seq a
Seq.singleton
                      ( NormalizedText
nm,
                        Text
-> Seq (NormalizedText, IniValue)
-> Int
-> Int
-> Seq BlankLine
-> IniSection
IniSection (NormalizedText -> Text
actualText NormalizedText
nm) Seq (NormalizedText, IniValue)
rs Int
0 Int
0 forall a. Monoid a => a
mempty
                      )
  forall (m :: * -> *) a. Monad m => a -> m a
return (Seq (NormalizedText, IniSection)
existingSections forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
F.asum Seq (Seq (NormalizedText, IniSection))
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 :: forall s.
s
-> s
-> Seq (Field s)
-> UpdatePolicy
-> Seq (NormalizedText, IniValue)
emitNewFields s
s s
def Seq (Field s)
fields UpdatePolicy
pol = ViewL (Field s) -> Seq (NormalizedText, IniValue)
go (forall a. Seq a -> ViewL a
Seq.viewl Seq (Field s)
fields)
  where
    go :: ViewL (Field s) -> Seq (NormalizedText, IniValue)
go ViewL (Field s)
EmptyL = forall a. Seq a
Seq.empty
    go (Field Lens s s a a
l FieldDescription a
d :< Seq (Field s)
fs)
      -- If a field is not present but is also the same as the default,
      -- then we can safely omit it
      | forall s t a b. Lens s t a b -> s -> a
get Lens s s a a
l s
s forall a. Eq a => a -> a -> Bool
== forall s t a b. Lens s t a b -> s -> a
get Lens s s a a
l s
def Bool -> Bool -> Bool
&& Bool -> Bool
not (UpdatePolicy -> Bool
updateAddOptionalFields UpdatePolicy
pol) =
        ViewL (Field s) -> Seq (NormalizedText, IniValue)
go (forall a. Seq a -> ViewL a
Seq.viewl Seq (Field s)
fs)
      -- otherwise, we should add it to the result
      | Bool
otherwise =
        let cs :: Seq BlankLine
cs = forall s.
FieldDescription s -> UpdateCommentPolicy -> Seq BlankLine
getComments FieldDescription a
d (UpdatePolicy -> UpdateCommentPolicy
updateGeneratedCommentPolicy UpdatePolicy
pol)
            new :: (NormalizedText, IniValue)
new =
              ( forall t. FieldDescription t -> NormalizedText
fdName FieldDescription a
d,
                IniValue
                  { vLineNo :: Int
vLineNo = Int
0,
                    vName :: Text
vName = NormalizedText -> Text
actualText (forall t. FieldDescription t -> NormalizedText
fdName FieldDescription a
d),
                    vValue :: Text
vValue = Text
" " forall a. Semigroup a => a -> a -> a
<> forall a. FieldValue a -> a -> Text
fvEmit (forall t. FieldDescription t -> FieldValue t
fdValue FieldDescription a
d) (forall s t a b. Lens s t a b -> s -> a
get Lens s s a a
l s
s),
                    vComments :: Seq BlankLine
vComments = Seq BlankLine
cs,
                    vCommentedOut :: Bool
vCommentedOut = Bool
False,
                    vDelimiter :: Char
vDelimiter = Char
'='
                  }
              )
         in (NormalizedText, IniValue)
new forall a. a -> Seq a -> Seq a
<| ViewL (Field s) -> Seq (NormalizedText, IniValue)
go (forall a. Seq a -> ViewL a
Seq.viewl Seq (Field s)
fs)
    go (FieldMb Lens s s (Maybe a) (Maybe a)
l FieldDescription a
d :< Seq (Field s)
fs) =
      case forall s t a b. Lens s t a b -> s -> a
get Lens s s (Maybe a) (Maybe a)
l s
s of
        Maybe a
Nothing -> ViewL (Field s) -> Seq (NormalizedText, IniValue)
go (forall a. Seq a -> ViewL a
Seq.viewl Seq (Field s)
fs)
        Just a
v ->
          let cs :: Seq BlankLine
cs = forall s.
FieldDescription s -> UpdateCommentPolicy -> Seq BlankLine
getComments FieldDescription a
d (UpdatePolicy -> UpdateCommentPolicy
updateGeneratedCommentPolicy UpdatePolicy
pol)
              new :: (NormalizedText, IniValue)
new =
                ( forall t. FieldDescription t -> NormalizedText
fdName FieldDescription a
d,
                  IniValue
                    { vLineNo :: Int
vLineNo = Int
0,
                      vName :: Text
vName = NormalizedText -> Text
actualText (forall t. FieldDescription t -> NormalizedText
fdName FieldDescription a
d),
                      vValue :: Text
vValue = forall a. FieldValue a -> a -> Text
fvEmit (forall t. FieldDescription t -> FieldValue t
fdValue FieldDescription a
d) a
v,
                      vComments :: Seq BlankLine
vComments = Seq BlankLine
cs,
                      vCommentedOut :: Bool
vCommentedOut = Bool
False,
                      vDelimiter :: Char
vDelimiter = Char
'='
                    }
                )
           in (NormalizedText, IniValue)
new forall a. a -> Seq a -> Seq a
<| ViewL (Field s) -> Seq (NormalizedText, IniValue)
go (forall a. Seq a -> ViewL a
Seq.viewl Seq (Field s)
fs)

updateFields ::
  s ->
  Seq (NormalizedText, IniValue) ->
  Seq (Field s) ->
  UpdatePolicy ->
  Either String (Seq (NormalizedText, IniValue))
updateFields :: forall s.
s
-> Seq (NormalizedText, IniValue)
-> Seq (Field s)
-> UpdatePolicy
-> Either String (Seq (NormalizedText, IniValue))
updateFields s
s Seq (NormalizedText, IniValue)
values Seq (Field s)
fields UpdatePolicy
pol = ViewL (NormalizedText, IniValue)
-> Seq (Field s) -> Either String (Seq (NormalizedText, IniValue))
go (forall a. Seq a -> ViewL a
Seq.viewl Seq (NormalizedText, IniValue)
values) Seq (Field s)
fields
  where
    go :: ViewL (NormalizedText, IniValue)
-> Seq (Field s) -> Either String (Seq (NormalizedText, IniValue))
go ((NormalizedText
t, IniValue
val) :< Seq (NormalizedText, IniValue)
vs) Seq (Field s)
fs =
      -- For each field, we need to fetch the description of the
      -- field in the spec
      case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
F.find (\Field s
f -> forall s. Field s -> NormalizedText
fieldName Field s
f forall a. Eq a => a -> a -> Bool
== NormalizedText
t) Seq (Field s)
fs of
        Just f :: Field s
f@(Field Lens s s a a
l FieldDescription a
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 forall a b. b -> Either a b
Right (forall s t a b. Lens s t a b -> s -> a
get Lens s s a a
l s
s) forall a. Eq a => a -> a -> Bool
== forall a. FieldValue a -> Text -> Either String a
fvParse (forall t. FieldDescription t -> FieldValue t
fdValue FieldDescription a
descr) (Text -> Text
T.strip (IniValue -> Text
vValue IniValue
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
              ((NormalizedText
t, IniValue
val) forall a. a -> Seq a -> Seq a
<|) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ViewL (NormalizedText, IniValue)
-> Seq (Field s) -> Either String (Seq (NormalizedText, IniValue))
go (forall a. Seq a -> ViewL a
Seq.viewl Seq (NormalizedText, IniValue)
vs) (forall s. NormalizedText -> Seq (Field s) -> Seq (Field s)
rmv NormalizedText
t Seq (Field s)
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 IniValue
nv = NormalizedText -> Field s -> Char -> Maybe IniValue
mkValue NormalizedText
t Field s
f (IniValue -> Char
vDelimiter IniValue
val)
               in ((NormalizedText
t, IniValue
nv) forall a. a -> Seq a -> Seq a
<|) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ViewL (NormalizedText, IniValue)
-> Seq (Field s) -> Either String (Seq (NormalizedText, IniValue))
go (forall a. Seq a -> ViewL a
Seq.viewl Seq (NormalizedText, IniValue)
vs) (forall s. NormalizedText -> Seq (Field s) -> Seq (Field s)
rmv NormalizedText
t Seq (Field s)
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 :: Field s
f@(FieldMb Lens s s (Maybe a) (Maybe a)
l FieldDescription a
descr) ->
          let parsed :: Either String a
parsed = forall a. FieldValue a -> Text -> Either String a
fvParse (forall t. FieldDescription t -> FieldValue t
fdValue FieldDescription a
descr) (Text -> Text
T.strip (IniValue -> Text
vValue IniValue
val))
           in if forall a b. b -> Either a b
Right (forall s t a b. Lens s t a b -> s -> a
get Lens s s (Maybe a) (Maybe a)
l s
s) forall a. Eq a => a -> a -> Bool
== forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just Either String a
parsed
                then ((NormalizedText
t, IniValue
val) forall a. a -> Seq a -> Seq a
<|) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ViewL (NormalizedText, IniValue)
-> Seq (Field s) -> Either String (Seq (NormalizedText, IniValue))
go (forall a. Seq a -> ViewL a
Seq.viewl Seq (NormalizedText, IniValue)
vs) (forall s. NormalizedText -> Seq (Field s) -> Seq (Field s)
rmv NormalizedText
t Seq (Field s)
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 NormalizedText -> Field s -> Char -> Maybe IniValue
mkValue NormalizedText
t Field s
f (IniValue -> Char
vDelimiter IniValue
val) of
                  Just IniValue
nv -> ((NormalizedText
t, IniValue
nv) forall a. a -> Seq a -> Seq a
<|) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ViewL (NormalizedText, IniValue)
-> Seq (Field s) -> Either String (Seq (NormalizedText, IniValue))
go (forall a. Seq a -> ViewL a
Seq.viewl Seq (NormalizedText, IniValue)
vs) (forall s. NormalizedText -> Seq (Field s) -> Seq (Field s)
rmv NormalizedText
t Seq (Field s)
fs)
                  Maybe IniValue
Nothing -> ViewL (NormalizedText, IniValue)
-> Seq (Field s) -> Either String (Seq (NormalizedText, IniValue))
go (forall a. Seq a -> ViewL a
Seq.viewl Seq (NormalizedText, IniValue)
vs) (forall s. NormalizedText -> Seq (Field s) -> Seq (Field s)
rmv NormalizedText
t Seq (Field s)
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.
        Maybe (Field s)
Nothing
          | UpdatePolicy -> Bool
updateIgnoreExtraneousFields UpdatePolicy
pol ->
            ((NormalizedText
t, IniValue
val) forall a. a -> Seq a -> Seq a
<|) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ViewL (NormalizedText, IniValue)
-> Seq (Field s) -> Either String (Seq (NormalizedText, IniValue))
go (forall a. Seq a -> ViewL a
Seq.viewl Seq (NormalizedText, IniValue)
vs) Seq (Field s)
fs
          | Bool
otherwise -> forall a b. a -> Either a b
Left (String
"Unexpected field: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show NormalizedText
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 ViewL (NormalizedText, IniValue)
EmptyL Seq (Field s)
fs = forall (m :: * -> *) a. Monad m => a -> m a
return (ViewL (Field s) -> Seq (NormalizedText, IniValue)
finish (forall a. Seq a -> ViewL a
Seq.viewl Seq (Field s)
fs))
    finish :: ViewL (Field s) -> Seq (NormalizedText, IniValue)
finish (f :: Field s
f@Field {} :< Seq (Field s)
fs)
      | UpdatePolicy -> Bool
updateAddOptionalFields UpdatePolicy
pol,
        Just IniValue
val <- NormalizedText -> Field s -> Char -> Maybe IniValue
mkValue (forall s. Field s -> NormalizedText
fieldName Field s
f) Field s
f Char
'=' =
        (forall s. Field s -> NormalizedText
fieldName Field s
f, IniValue
val) forall a. a -> Seq a -> Seq a
<| ViewL (Field s) -> Seq (NormalizedText, IniValue)
finish (forall a. Seq a -> ViewL a
Seq.viewl Seq (Field s)
fs)
      | Bool
otherwise = ViewL (Field s) -> Seq (NormalizedText, IniValue)
finish (forall a. Seq a -> ViewL a
Seq.viewl Seq (Field s)
fs)
    finish (f :: Field s
f@(FieldMb Lens s s (Maybe a) (Maybe a)
_ FieldDescription a
descr) :< Seq (Field s)
fs)
      | Bool -> Bool
not (forall t. FieldDescription t -> Bool
fdSkipIfMissing FieldDescription a
descr),
        Just IniValue
val <- NormalizedText -> Field s -> Char -> Maybe IniValue
mkValue (forall s. Field s -> NormalizedText
fieldName Field s
f) Field s
f Char
'=' =
        (forall s. Field s -> NormalizedText
fieldName Field s
f, IniValue
val) forall a. a -> Seq a -> Seq a
<| ViewL (Field s) -> Seq (NormalizedText, IniValue)
finish (forall a. Seq a -> ViewL a
Seq.viewl Seq (Field s)
fs)
      | UpdatePolicy -> Bool
updateAddOptionalFields UpdatePolicy
pol,
        Just IniValue
val <- NormalizedText -> Field s -> Char -> Maybe IniValue
mkValue (forall s. Field s -> NormalizedText
fieldName Field s
f) Field s
f Char
'=' =
        (forall s. Field s -> NormalizedText
fieldName Field s
f, IniValue
val) forall a. a -> Seq a -> Seq a
<| ViewL (Field s) -> Seq (NormalizedText, IniValue)
finish (forall a. Seq a -> ViewL a
Seq.viewl Seq (Field s)
fs)
      | Bool
otherwise = ViewL (Field s) -> Seq (NormalizedText, IniValue)
finish (forall a. Seq a -> ViewL a
Seq.viewl Seq (Field s)
fs)
    -- If there's nothing left, then we can return a final value!
    finish ViewL (Field s)
EmptyL = forall a. Seq a
Seq.empty
    mkValue :: NormalizedText -> Field s -> Char -> Maybe IniValue
mkValue NormalizedText
t Field s
fld Char
delim =
      let comments :: Seq BlankLine
comments = case UpdatePolicy -> UpdateCommentPolicy
updateGeneratedCommentPolicy UpdatePolicy
pol of
            UpdateCommentPolicy
CommentPolicyNone -> forall a. Seq a
Seq.empty
            UpdateCommentPolicy
CommentPolicyAddFieldComment ->
              Seq Text -> Seq BlankLine
mkComments (forall s. Field s -> Seq Text
fieldComment Field s
fld)
            CommentPolicyAddDefaultComment Seq Text
cs ->
              Seq Text -> Seq BlankLine
mkComments Seq Text
cs
          val :: IniValue
val =
            IniValue
              { vLineNo :: Int
vLineNo = Int
0,
                vName :: Text
vName = NormalizedText -> Text
actualText NormalizedText
t,
                vValue :: Text
vValue = Text
"",
                vComments :: Seq BlankLine
vComments = Seq BlankLine
comments,
                vCommentedOut :: Bool
vCommentedOut = Bool
False,
                vDelimiter :: Char
vDelimiter = Char
delim
              }
       in case Field s
fld of
            Field Lens s s a a
l FieldDescription a
descr ->
              forall a. a -> Maybe a
Just (IniValue
val {vValue :: Text
vValue = Text
" " forall a. Semigroup a => a -> a -> a
<> forall a. FieldValue a -> a -> Text
fvEmit (forall t. FieldDescription t -> FieldValue t
fdValue FieldDescription a
descr) (forall s t a b. Lens s t a b -> s -> a
get Lens s s a a
l s
s)})
            FieldMb Lens s s (Maybe a) (Maybe a)
l FieldDescription a
descr ->
              case forall s t a b. Lens s t a b -> s -> a
get Lens s s (Maybe a) (Maybe a)
l s
s of
                Just a
v -> forall a. a -> Maybe a
Just (IniValue
val {vValue :: Text
vValue = Text
" " forall a. Semigroup a => a -> a -> a
<> forall a. FieldValue a -> a -> Text
fvEmit (forall t. FieldDescription t -> FieldValue t
fdValue FieldDescription a
descr) a
v})
                Maybe a
Nothing -> forall a. Maybe a
Nothing

-- $using
-- Functions for parsing, serializing, and updating INI files.

-- $types
-- Types which represent declarative specifications for INI
-- file structure.

-- $sections
-- Declaring sections of an INI file specification

-- $fields
-- Declaring individual fields of an INI file specification.

-- $fieldvalues
-- Values of type 'FieldValue' represent both a parser and a
-- serializer for a value of a given type. It's possible to manually
-- create 'FieldValue' descriptions, but for simple configurations,
-- but for the sake of convenience, several commonly-needed
-- varieties of 'FieldValue' are defined here.

-- $misc
-- These values and types are exported for compatibility.