{-|
Module     : Data.Ini.Config.Bidir
Copyright  : (c) Getty Ritter, 2017
License    : BSD
Maintainer : Getty Ritter <config-ini@infinitenegativeutility.com>
Stability  : experimental

This module presents an alternate API for parsing INI files.  Unlike
the standard API, it is bidirectional: the same declarative structure
can be used to parse an INI file to a value, serialize an INI file
from a value, or even /update/ an INI file by comparing it against a
value and serializing in a way that minimizes the differences between
revisions of the file.

This API does make some extra assumptions about your configuration
type and the way you interact with it: in particular, it assumes that
you have lenses for all the fields you're parsing and that you have
some kind of sensible default value of that configuration
type. Instead of providing combinators which can extract and parse a
field of an INI file into a value, the bidirectional API allows you to
declaratively associate a lens into your structure with a field of the
INI file.

Consider the following example INI file:

> [NETWORK]
> host = example.com
> port = 7878
>
> [LOCAL]
> user = terry

We'd like to parse this INI file into a @Config@ type which we've
defined like this, using
<https://hackage.haskell.org/package/lens lens> or a similar library
to provide lenses:

> data Config = Config
>   { _cfHost :: String
>   , _cfPort :: Int
>   , _cfUser :: Maybe Text
>   } deriving (Eq, Show)
>
> ''makeLenses Config

We can now define a basic specification of the type @'IniSpec' Config
()@ by using the provided operations to declare our top-level
sections, and then within those sections we can associate fields with
@Config@ lenses.

@
'configSpec' :: 'IniSpec' Config ()
'configSpec' = do
  'section' \"NETWORK\" $ do
    cfHost '.=' 'field' \"host\" 'string'
    cfPost '.=' 'field' \"port\" 'number'
  'sectionOpt' \"LOCAL\" $ do
    cfUser '.=?' 'field' \"user\" 'text'
@

There are two operators used to associate lenses with fields:

['.='] Associates a lens of type @Lens' s a@ with a field description
       of type @FieldDescription a@. By default, this will raise an
       error when parsing if the field described is missing, but we
       can mark it as optional, as we'll see.

['.=?'] Associates a lens of type @Lens' s (Maybe a)@ with a field
        description of type @FieldDescription a@. During parsing, if
        the value does not appear in an INI file, then the lens will
        be set to 'Nothing'; similarly, during serializing, if the
        value is 'Nothing', then the field will not be serialized in
        the file.

Each field must include the field's name as well as a 'FieldValue',
which describes how to both parse and serialize a value of a given
type. Several built-in 'FieldValue' descriptions are provided, but you
can always build your own by providing parsing and serialization
functions for individual fields.

We can also provide extra metadata about a field, allowing it to be
skipped durin parsing, or to provide an explicit default value, or to
include an explanatory comment for that value to be used when we
serialize an INI file. These are conventionally applied to the field
using the '&' operator:

@
configSpec :: 'IniSpec' Config ()
configSpec = do
  'section' \"NETWORK\" $ do
    cfHost '.=' 'field' \"host\" 'string'
                & 'comment' [\"The desired hostname (optional)\"]
                & 'optional'
    cfPost '.=' 'field' \"port\" 'number'
                & 'comment' [\"The port number\"]
  'sectionOpt' \"LOCAL\" $ do
    cfUser '.=?' 'field' \"user\" 'text'
@

When we want to use this specification, we need to create a value of
type 'Ini', which is an abstract representation of an INI
specification. To create an 'Ini' value, we need to use the 'ini'
function, which combines the spec with the default version of our
configuration value.

Once we have a value of type 'Ini', we can use it for three basic
operations:

* We can parse a textual INI file with 'parseIni', which will
  systematically walk the spec and use the provided lens/field
  associations to create a parsed configuration file. This will give
  us a new value of type 'Ini' that represents the parsed
  configuration, and we can extract the actual configuration value
  with 'getIniValue'.

* We can update the value contained in an 'Ini' value. If the 'Ini'
  value is the result of a previous call to 'parseIni', then this
  update will attempt to retain as much of the incidental structure of
  the parsed file as it can: for example, it will attempt to retain
  comments, whitespace, and ordering. The general strategy is to make
  the resulting INI file "diff-minimal": the diff between the older
  INI file and the updated INI file should contain as little noise as
  possible. Small cosmetic choices such as how to treat generated
  comments are controlled by a configurable 'UpdatePolicy' value.

* We can serialize an 'Ini' value to a textual INI file. This will
  produce the specified INI file (either a default fresh INI, or a
  modified existing INI) as a textual value.

-}

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

module Data.Ini.Config.Bidir
(
-- * Parsing, Serializing, and Updating Files
-- $using
  Ini
, ini
, getIniValue
, iniValueL
, getRawIni
-- ** Parsing INI files
, parseIni
-- ** Serializing INI files
, serializeIni
-- ** Updating INI Files
, updateIni
, setIniUpdatePolicy
, UpdatePolicy(..)
, UpdateCommentPolicy(..)
, defaultUpdatePolicy
-- * Bidirectional Parser Types
-- $types
, IniSpec
, SectionSpec

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

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

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

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

) where

import           Control.Monad.Trans.State.Strict (State, runState, modify)
import qualified Control.Monad.Trans.State.Strict as State
import qualified Data.Foldable as F
#if __GLASGOW_HASKELL__ >= 710
import           Data.Function ((&))
#endif
import           Data.Monoid ((<>))
import           Data.Sequence ((<|), Seq, ViewL(..), ViewR(..))
import qualified Data.Sequence as Seq
import           Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Traversable as F
import           Data.Typeable (Typeable, Proxy(..), typeRep)
import           GHC.Exts (IsList(..))
import           Text.Read (readMaybe)

import           Data.Ini.Config.Raw

-- * Utility functions + lens stuffs

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

-- These are some inline reimplementations of "lens" operators. We
-- need the identity functor to implement 'set':
newtype I a = I { I a -> a
fromI :: a }
instance Functor I where fmap :: (a -> b) -> I a -> I b
fmap a -> b
f (I a
x) = b -> I b
forall a. a -> I a
I (a -> b
f a
x)

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

-- ... and we need the const functor to implement 'get':
newtype C a b = C { C a b -> a
fromC :: a }
instance Functor (C a) where fmap :: (a -> b) -> C a a -> C a b
fmap a -> b
_ (C a
x) = a -> C a b
forall a b. a -> C a b
C a
x

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

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

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

-- | Create a basic 'Ini' value from a default value and a spec.
ini :: s -> IniSpec s () -> Ini s
ini :: s -> IniSpec s () -> Ini s
ini s
def (IniSpec BidirM (Section s) ()
spec) = Ini :: forall s. Spec s -> s -> s -> Maybe RawIni -> UpdatePolicy -> Ini s
Ini
  { iniSpec :: Spec s
iniSpec = BidirM (Section s) () -> Spec s
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 = Maybe RawIni
forall a. Maybe a
Nothing
  , iniPol :: UpdatePolicy
iniPol  = UpdatePolicy
defaultUpdatePolicy
  }

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

mkLens :: (a -> b) -> (b -> a -> a) -> Lens a a b b
mkLens :: (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) (b -> a) -> f b -> f 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 :: (s -> f s) -> Ini s -> f (Ini s)
iniValueL = (Ini s -> s) -> (s -> Ini s -> Ini s) -> Lens (Ini s) (Ini s) s s
forall a b. (a -> b) -> (b -> a -> a) -> Lens a a b b
mkLens Ini s -> s
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 :: Ini s -> Text
serializeIni = RawIni -> Text
printRawIni (RawIni -> Text) -> (Ini s -> RawIni) -> Ini s -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ini s -> RawIni
forall s. Ini s -> RawIni
getRawIni

-- | Get the underlying 'RawIni' value for the file.
getRawIni :: Ini s -> RawIni
getRawIni :: 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
               }) = s -> Spec s -> RawIni
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 :: 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 <- s
-> ViewL (Section s)
-> Seq (NormalizedText, IniSection)
-> Either String s
forall s.
s
-> ViewL (Section s)
-> Seq (NormalizedText, IniSection)
-> Either String s
parseSections s
def (Spec s -> ViewL (Section s)
forall a. Seq a -> ViewL a
Seq.viewl Spec s
spec) Seq (NormalizedText, IniSection)
raw
  Ini s -> Either String (Ini s)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ini s -> Either String (Ini s)) -> Ini s -> Either String (Ini s)
forall a b. (a -> b) -> a -> b
$ Ini s
i
    { iniCurr :: s
iniCurr = s
s
    , iniLast :: Maybe RawIni
iniLast = RawIni -> Maybe RawIni
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 :: s -> Ini s -> Ini s
updateIni s
new Ini s
i =
  case s -> Ini s -> Either String (Ini s)
forall s. s -> Ini s -> Either String (Ini s)
doUpdateIni s
new Ini s
i of
    Left String
err -> String -> Ini s
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 :: 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
  { FieldValue a -> Text -> Either String a
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.
  , FieldValue a -> a -> Text
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 :: BidirM s a -> Seq s
runBidirM = (a, Seq s) -> Seq s
forall a b. (a, b) -> b
snd ((a, Seq s) -> Seq s)
-> (BidirM s a -> (a, Seq s)) -> BidirM s a -> Seq s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BidirM s a -> Seq s -> (a, Seq s))
-> Seq s -> BidirM s a -> (a, Seq s)
forall a b c. (a -> b -> c) -> b -> a -> c
flip BidirM s a -> Seq s -> (a, Seq s)
forall s a. State s a -> s -> (a, s)
runState Seq s
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 (a -> IniSpec s b -> IniSpec s a
(a -> b) -> IniSpec s a -> IniSpec s b
(forall a b. (a -> b) -> IniSpec s a -> IniSpec s b)
-> (forall a b. a -> IniSpec s b -> IniSpec s a)
-> Functor (IniSpec s)
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
<$ :: a -> IniSpec s b -> IniSpec s a
$c<$ :: forall s a b. a -> IniSpec s b -> IniSpec s a
fmap :: (a -> b) -> IniSpec s a -> IniSpec s b
$cfmap :: forall s a b. (a -> b) -> IniSpec s a -> IniSpec s b
Functor, Functor (IniSpec s)
a -> IniSpec s a
Functor (IniSpec s)
-> (forall a. a -> IniSpec s a)
-> (forall 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 a b. IniSpec s a -> IniSpec s b -> IniSpec s b)
-> (forall a b. IniSpec s a -> IniSpec s b -> IniSpec s a)
-> Applicative (IniSpec s)
IniSpec s a -> IniSpec s b -> IniSpec s b
IniSpec s a -> IniSpec s b -> IniSpec s a
IniSpec s (a -> b) -> IniSpec s a -> IniSpec s b
(a -> b -> c) -> IniSpec s a -> IniSpec s b -> IniSpec s c
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
<* :: IniSpec s a -> IniSpec s b -> IniSpec s a
$c<* :: forall s a b. IniSpec s a -> IniSpec s b -> IniSpec s a
*> :: IniSpec s a -> IniSpec s b -> IniSpec s b
$c*> :: forall s a b. IniSpec s a -> IniSpec s b -> IniSpec s b
liftA2 :: (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
<*> :: 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 :: a -> IniSpec s a
$cpure :: forall s a. a -> IniSpec s a
$cp1Applicative :: forall s. Functor (IniSpec s)
Applicative, Applicative (IniSpec s)
a -> IniSpec s a
Applicative (IniSpec s)
-> (forall a b. IniSpec s a -> (a -> IniSpec s b) -> IniSpec s b)
-> (forall a b. IniSpec s a -> IniSpec s b -> IniSpec s b)
-> (forall a. a -> IniSpec s a)
-> Monad (IniSpec s)
IniSpec s a -> (a -> IniSpec s b) -> IniSpec s b
IniSpec s a -> IniSpec s b -> IniSpec s b
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 :: a -> IniSpec s a
$creturn :: forall s a. a -> IniSpec s a
>> :: IniSpec s a -> IniSpec s b -> IniSpec s b
$c>> :: forall s a b. IniSpec s a -> IniSpec s b -> IniSpec s 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
$cp1Monad :: forall s. Applicative (IniSpec s)
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 (a -> SectionSpec s b -> SectionSpec s a
(a -> b) -> SectionSpec s a -> SectionSpec s b
(forall a b. (a -> b) -> SectionSpec s a -> SectionSpec s b)
-> (forall a b. a -> SectionSpec s b -> SectionSpec s a)
-> Functor (SectionSpec s)
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
<$ :: a -> SectionSpec s b -> SectionSpec s a
$c<$ :: forall s a b. a -> SectionSpec s b -> SectionSpec s a
fmap :: (a -> b) -> SectionSpec s a -> SectionSpec s b
$cfmap :: forall s a b. (a -> b) -> SectionSpec s a -> SectionSpec s b
Functor, Functor (SectionSpec s)
a -> SectionSpec s a
Functor (SectionSpec s)
-> (forall a. a -> SectionSpec s a)
-> (forall 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 a b.
    SectionSpec s a -> SectionSpec s b -> SectionSpec s b)
-> (forall a b.
    SectionSpec s a -> SectionSpec s b -> SectionSpec s a)
-> Applicative (SectionSpec s)
SectionSpec s a -> SectionSpec s b -> SectionSpec s b
SectionSpec s a -> SectionSpec s b -> SectionSpec s a
SectionSpec s (a -> b) -> SectionSpec s a -> SectionSpec s b
(a -> b -> c)
-> SectionSpec s a -> SectionSpec s b -> SectionSpec s c
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
<* :: SectionSpec s a -> SectionSpec s b -> SectionSpec s a
$c<* :: forall s a b. SectionSpec s a -> SectionSpec s b -> SectionSpec s a
*> :: SectionSpec s a -> SectionSpec s b -> SectionSpec s b
$c*> :: forall s a b. SectionSpec s a -> SectionSpec s b -> SectionSpec s b
liftA2 :: (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
<*> :: 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 :: a -> SectionSpec s a
$cpure :: forall s a. a -> SectionSpec s a
$cp1Applicative :: forall s. Functor (SectionSpec s)
Applicative, Applicative (SectionSpec s)
a -> SectionSpec s a
Applicative (SectionSpec s)
-> (forall a b.
    SectionSpec s a -> (a -> SectionSpec s b) -> SectionSpec s b)
-> (forall a b.
    SectionSpec s a -> SectionSpec s b -> SectionSpec s b)
-> (forall a. a -> SectionSpec s a)
-> Monad (SectionSpec s)
SectionSpec s a -> (a -> SectionSpec s b) -> SectionSpec s b
SectionSpec s a -> SectionSpec s b -> SectionSpec s b
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 :: a -> SectionSpec s a
$creturn :: forall s a. a -> SectionSpec s a
>> :: SectionSpec s a -> SectionSpec s b -> SectionSpec s b
$c>> :: forall s a b. SectionSpec s a -> SectionSpec s b -> SectionSpec s 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
$cp1Monad :: forall s. Applicative (SectionSpec s)
Monad)

-- * Sections

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

allFieldsOptional :: (Seq (Field s)) -> Bool
allFieldsOptional :: Seq (Field s) -> Bool
allFieldsOptional = (Field s -> Bool) -> Seq (Field s) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Field s -> Bool
forall s. Field s -> Bool
isOptional
  where isOptional :: Field s -> Bool
isOptional (Field   Lens s s a a
_ FieldDescription a
fd) = FieldDescription a -> Bool
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 :: (SectionSpec s () -> IniSpec s ())
-> SectionSpec s () -> IniSpec s ()
allOptional SectionSpec s () -> IniSpec s ()
k SectionSpec s ()
spec = BidirM (Section s) () -> IniSpec s ()
forall s a. BidirM (Section s) a -> IniSpec s a
IniSpec (BidirM (Section s) () -> IniSpec s ())
-> BidirM (Section s) () -> IniSpec s ()
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
  (Seq (Section s) -> Seq (Section s)) -> BidirM (Section s) ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify (\ Seq (Section s)
s -> case Seq (Section s) -> ViewR (Section s)
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 Seq (Section s) -> Section s -> Seq (Section s)
forall a. Seq a -> a -> Seq a
Seq.|> NormalizedText -> Seq (Field s) -> Bool -> Section s
forall s. NormalizedText -> Seq (Field s) -> Bool -> Section s
Section NormalizedText
name ((Field s -> Field s) -> Seq (Field s) -> Seq (Field s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Field s -> Field s
forall s. Field s -> Field s
makeOptional Seq (Field s)
fields) Bool
True)

makeOptional :: Field s -> Field s
makeOptional :: Field s -> Field s
makeOptional (Field Lens s s a a
l FieldDescription a
d) = Lens s s a a -> FieldDescription a -> Field s
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) = Lens s s (Maybe a) (Maybe a) -> FieldDescription a -> Field s
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 :: 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 :: 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
  { FieldDescription t -> NormalizedText
fdName          :: NormalizedText
  , FieldDescription t -> FieldValue t
fdValue         :: FieldValue t
  , FieldDescription t -> Seq Text
fdComment       :: Seq Text
  , FieldDescription t -> Maybe Text
fdDummy         :: Maybe Text
  , 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 .= :: Lens s s t t -> FieldDescription t -> SectionSpec s ()
.= FieldDescription t
f = BidirM (Field s) () -> SectionSpec s ()
forall s a. BidirM (Field s) a -> SectionSpec s a
SectionSpec (BidirM (Field s) () -> SectionSpec s ())
-> BidirM (Field s) () -> SectionSpec s ()
forall a b. (a -> b) -> a -> b
$ (Seq (Field s) -> Seq (Field s)) -> BidirM (Field s) ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify (Seq (Field s) -> Field s -> Seq (Field s)
forall a. Seq a -> a -> Seq a
Seq.|> Field s
fd)
  where fd :: Field s
fd = Lens s s t t -> FieldDescription t -> Field s
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 .=? :: Lens s s (Maybe t) (Maybe t)
-> FieldDescription t -> SectionSpec s ()
.=? FieldDescription t
f = BidirM (Field s) () -> SectionSpec s ()
forall s a. BidirM (Field s) a -> SectionSpec s a
SectionSpec (BidirM (Field s) () -> SectionSpec s ())
-> BidirM (Field s) () -> SectionSpec s ()
forall a b. (a -> b) -> a -> b
$ (Seq (Field s) -> Seq (Field s)) -> BidirM (Field s) ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify (Seq (Field s) -> Field s -> Seq (Field s)
forall a. Seq a -> a -> Seq a
Seq.|> Field s
fd)
  where fd :: Field s
fd = Lens s s (Maybe t) (Maybe t) -> FieldDescription t -> Field s
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 :: [Text] -> FieldDescription t -> FieldDescription t
comment [Text]
cmt FieldDescription t
fd = FieldDescription t
fd { fdComment :: Seq Text
fdComment = [Text] -> Seq Text
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 :: Text -> FieldDescription t -> FieldDescription t
placeholderValue Text
t FieldDescription t
fd = FieldDescription t
fd { fdDummy :: Maybe Text
fdDummy = Text -> Maybe Text
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 :: 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 :: Text -> FieldValue a -> FieldDescription a
field Text
name FieldValue a
value = FieldDescription :: forall t.
NormalizedText
-> FieldValue t
-> Seq Text
-> Maybe Text
-> Bool
-> FieldDescription t
FieldDescription
  { fdName :: NormalizedText
fdName          = Text -> NormalizedText
normalize (Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ")
  , fdValue :: FieldValue a
fdValue         = FieldValue a
value
  , fdComment :: Seq Text
fdComment       = Seq Text
forall a. Seq a
Seq.empty
  , fdDummy :: Maybe Text
fdDummy         = Maybe Text
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 = Text -> FieldValue Bool -> FieldDescription Bool
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 :: FieldValue a
readable = FieldValue :: forall a. (Text -> Either String a) -> (a -> Text) -> FieldValue a
FieldValue { fvParse :: Text -> Either String a
fvParse = Text -> Either String a
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 (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show
        parse :: Text -> Either String b
parse Text
t = case String -> Maybe b
forall a. Read a => String -> Maybe a
readMaybe (Text -> String
T.unpack Text
t) of
          Just b
v -> b -> Either String b
forall a b. b -> Either a b
Right b
v
          Maybe b
Nothing -> String -> Either String b
forall a b. a -> Either a b
Left (String
"Unable to parse " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
t String -> String -> String
forall a. [a] -> [a] -> [a]
++
                           String
" as a value of type " String -> String -> String
forall a. [a] -> [a] -> [a]
++ TypeRep -> String
forall a. Show a => a -> String
show TypeRep
typ)
        typ :: TypeRep
typ = Proxy a -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy a
prx)
        prx :: Proxy a
        prx :: Proxy a
prx = Proxy a
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 :: FieldValue a
number = FieldValue a
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 :: forall a. (Text -> Either String a) -> (a -> Text) -> FieldValue a
FieldValue { fvParse :: Text -> Either String Text
fvParse = Text -> Either String Text
forall a b. b -> Either a b
Right, fvEmit :: Text -> Text
fvEmit = Text -> Text
forall a. a -> a
id }

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

toSection :: s -> Text -> Seq (Field s) -> IniSection
toSection :: s -> Text -> Seq (Field s) -> IniSection
toSection s
s Text
name Seq (Field s)
fs = IniSection :: Text
-> Seq (NormalizedText, IniValue)
-> Int
-> Int
-> Seq BlankLine
-> IniSection
IniSection
  { isName :: Text
isName = Text
name
  , isVals :: Seq (NormalizedText, IniValue)
isVals = (Field s -> (NormalizedText, IniValue))
-> Seq (Field s) -> Seq (NormalizedText, IniValue)
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  = Seq BlankLine
forall a. Seq a
Seq.empty
  } where mkIniValue :: Text -> FieldDescription t -> Bool -> (NormalizedText, IniValue)
mkIniValue Text
val FieldDescription t
descr Bool
opt =
            ( FieldDescription t -> NormalizedText
forall t. FieldDescription t -> NormalizedText
fdName FieldDescription t
descr
            , IniValue :: Int -> Text -> Text -> Seq BlankLine -> Bool -> Char -> IniValue
IniValue
                { vLineNo :: Int
vLineNo = Int
0
                , vName :: Text
vName   = NormalizedText -> Text
actualText (FieldDescription t -> NormalizedText
forall t. FieldDescription t -> NormalizedText
fdName FieldDescription t
descr)
                , vValue :: Text
vValue  = Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
val
                , vComments :: Seq BlankLine
vComments = Seq Text -> Seq BlankLine
mkComments (FieldDescription t -> Seq Text
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 <- FieldDescription a -> Maybe Text
forall t. FieldDescription t -> Maybe Text
fdDummy FieldDescription a
descr =
                Text -> FieldDescription a -> Bool -> (NormalizedText, IniValue)
forall t.
Text -> FieldDescription t -> Bool -> (NormalizedText, IniValue)
mkIniValue Text
dummy FieldDescription a
descr Bool
False
            | Bool
otherwise =
                Text -> FieldDescription a -> Bool -> (NormalizedText, IniValue)
forall t.
Text -> FieldDescription t -> Bool -> (NormalizedText, IniValue)
mkIniValue (FieldValue a -> a -> Text
forall a. FieldValue a -> a -> Text
fvEmit (FieldDescription a -> FieldValue a
forall t. FieldDescription t -> FieldValue t
fdValue FieldDescription a
descr) (Lens s s a a -> s -> a
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 <- FieldDescription a -> Maybe Text
forall t. FieldDescription t -> Maybe Text
fdDummy FieldDescription a
descr =
                Text -> FieldDescription a -> Bool -> (NormalizedText, IniValue)
forall t.
Text -> FieldDescription t -> Bool -> (NormalizedText, IniValue)
mkIniValue Text
dummy FieldDescription a
descr Bool
True
            | Just a
v <- Lens s s (Maybe a) (Maybe a) -> s -> Maybe a
forall s t a b. Lens s t a b -> s -> a
get Lens s s (Maybe a) (Maybe a)
l s
s =
                Text -> FieldDescription a -> Bool -> (NormalizedText, IniValue)
forall t.
Text -> FieldDescription t -> Bool -> (NormalizedText, IniValue)
mkIniValue (FieldValue a -> a -> Text
forall a. FieldValue a -> a -> Text
fvEmit (FieldDescription a -> FieldValue a
forall t. FieldDescription t -> FieldValue t
fdValue FieldDescription a
descr) a
v) FieldDescription a
descr Bool
True
            | Bool
otherwise =
                Text -> FieldDescription a -> Bool -> (NormalizedText, IniValue)
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
  { UpdatePolicy -> Bool
updateAddOptionalFields      :: Bool
    -- ^ If 'True', then optional fields not included in the INI file
    -- will be included in the updated INI file. Defaults to 'False'.
  , UpdatePolicy -> Bool
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'.
  , UpdatePolicy -> UpdateCommentPolicy
updateGeneratedCommentPolicy :: UpdateCommentPolicy
    -- ^ The policy for what to do to comments associated with
    -- modified fields during an update. Defaults to
    -- 'CommentPolicyNone'.
  } deriving (UpdatePolicy -> UpdatePolicy -> Bool
(UpdatePolicy -> UpdatePolicy -> Bool)
-> (UpdatePolicy -> UpdatePolicy -> Bool) -> Eq UpdatePolicy
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 -> String -> String
[UpdatePolicy] -> String -> String
UpdatePolicy -> String
(Int -> UpdatePolicy -> String -> String)
-> (UpdatePolicy -> String)
-> ([UpdatePolicy] -> String -> String)
-> Show UpdatePolicy
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [UpdatePolicy] -> String -> String
$cshowList :: [UpdatePolicy] -> String -> String
show :: UpdatePolicy -> String
$cshow :: UpdatePolicy -> String
showsPrec :: Int -> UpdatePolicy -> String -> String
$cshowsPrec :: Int -> UpdatePolicy -> String -> String
Show)

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

getComments :: FieldDescription s -> UpdateCommentPolicy -> (Seq BlankLine)
getComments :: FieldDescription s -> UpdateCommentPolicy -> Seq BlankLine
getComments FieldDescription s
_ UpdateCommentPolicy
CommentPolicyNone = Seq BlankLine
forall a. Seq a
Seq.empty
getComments FieldDescription s
f UpdateCommentPolicy
CommentPolicyAddFieldComment =
  Seq Text -> Seq BlankLine
mkComments (FieldDescription s -> Seq Text
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 :: 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' = Ini s -> RawIni
forall s. Ini s -> RawIni
getRawIni Ini s
i
  Seq (NormalizedText, IniSection)
res <- s
-> s
-> Seq (NormalizedText, IniSection)
-> Spec s
-> UpdatePolicy
-> Either String (Seq (NormalizedText, IniSection))
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
  Ini s -> Either String (Ini s)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ini s -> Either String (Ini s)) -> Ini s -> Either String (Ini s)
forall a b. (a -> b) -> a -> b
$ Ini s
i
    { iniCurr :: s
iniCurr = s
s
    , iniLast :: Maybe RawIni
iniLast = RawIni -> Maybe RawIni
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 :: 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 <- Seq (NormalizedText, IniSection)
-> ((NormalizedText, IniSection)
    -> Either String (NormalizedText, IniSection))
-> Either String (Seq (NormalizedText, IniSection))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
F.for Seq (NormalizedText, IniSection)
sections (((NormalizedText, IniSection)
  -> Either String (NormalizedText, IniSection))
 -> Either String (Seq (NormalizedText, IniSection)))
-> ((NormalizedText, IniSection)
    -> Either String (NormalizedText, IniSection))
-> Either String (Seq (NormalizedText, IniSection))
forall a b. (a -> b) -> a -> b
$ \ (NormalizedText
name, IniSection
sec) -> do
    let err :: Either String b
err  = String -> Either String b
forall a b. a -> Either a b
Left (String
"Unexpected top-level section: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ NormalizedText -> String
forall a. Show a => a -> String
show NormalizedText
name)
    Section NormalizedText
_ Seq (Field s)
spec Bool
_ <- Either String (Section s)
-> (Section s -> Either String (Section s))
-> Maybe (Section s)
-> Either String (Section s)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Either String (Section s)
forall b. Either String b
err Section s -> Either String (Section s)
forall a b. b -> Either a b
Right
      ((Section s -> Bool) -> Seq (Section s) -> Maybe (Section s)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
F.find (\ (Section NormalizedText
n Seq (Field s)
_ Bool
_) -> NormalizedText
n NormalizedText -> NormalizedText -> Bool
forall a. Eq a => a -> a -> Bool
== NormalizedText
name) Seq (Section s)
fields)
    Seq (NormalizedText, IniValue)
newVals <- s
-> Seq (NormalizedText, IniValue)
-> Seq (Field s)
-> UpdatePolicy
-> Either String (Seq (NormalizedText, IniValue))
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
    (NormalizedText, IniSection)
-> Either String (NormalizedText, IniSection)
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 = ((NormalizedText, IniSection) -> NormalizedText)
-> Seq (NormalizedText, IniSection) -> Seq NormalizedText
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NormalizedText, IniSection) -> NormalizedText
forall a b. (a, b) -> a
fst Seq (NormalizedText, IniSection)
existingSections
  Seq (Seq (NormalizedText, IniSection))
newSections <- Seq (Section s)
-> (Section s -> Either String (Seq (NormalizedText, IniSection)))
-> Either String (Seq (Seq (NormalizedText, IniSection)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
F.for Seq (Section s)
fields ((Section s -> Either String (Seq (NormalizedText, IniSection)))
 -> Either String (Seq (Seq (NormalizedText, IniSection))))
-> (Section s -> Either String (Seq (NormalizedText, IniSection)))
-> Either String (Seq (Seq (NormalizedText, IniSection)))
forall a b. (a -> b) -> a -> b
$
    \ (Section NormalizedText
nm Seq (Field s)
spec Bool
_) ->
      if | NormalizedText
nm NormalizedText -> Seq NormalizedText -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Seq NormalizedText
existingSectionNames -> Seq (NormalizedText, IniSection)
-> Either String (Seq (NormalizedText, IniSection))
forall (m :: * -> *) a. Monad m => a -> m a
return Seq (NormalizedText, IniSection)
forall a. Monoid a => a
mempty
         | Bool
otherwise ->
           let rs :: Seq (NormalizedText, IniValue)
rs = s
-> s
-> Seq (Field s)
-> UpdatePolicy
-> Seq (NormalizedText, IniValue)
forall s.
s
-> s
-> Seq (Field s)
-> UpdatePolicy
-> Seq (NormalizedText, IniValue)
emitNewFields s
s s
def Seq (Field s)
spec UpdatePolicy
pol
           in if Seq (NormalizedText, IniValue) -> Bool
forall a. Seq a -> Bool
Seq.null Seq (NormalizedText, IniValue)
rs
                then Seq (NormalizedText, IniSection)
-> Either String (Seq (NormalizedText, IniSection))
forall (m :: * -> *) a. Monad m => a -> m a
return Seq (NormalizedText, IniSection)
forall a. Monoid a => a
mempty
                else Seq (NormalizedText, IniSection)
-> Either String (Seq (NormalizedText, IniSection))
forall (m :: * -> *) a. Monad m => a -> m a
return (Seq (NormalizedText, IniSection)
 -> Either String (Seq (NormalizedText, IniSection)))
-> Seq (NormalizedText, IniSection)
-> Either String (Seq (NormalizedText, IniSection))
forall a b. (a -> b) -> a -> b
$ (NormalizedText, IniSection) -> Seq (NormalizedText, IniSection)
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 Seq BlankLine
forall a. Monoid a => a
mempty
                       )
  Seq (NormalizedText, IniSection)
-> Either String (Seq (NormalizedText, IniSection))
forall (m :: * -> *) a. Monad m => a -> m a
return (Seq (NormalizedText, IniSection)
existingSections Seq (NormalizedText, IniSection)
-> Seq (NormalizedText, IniSection)
-> Seq (NormalizedText, IniSection)
forall a. Semigroup a => a -> a -> a
<> Seq (Seq (NormalizedText, IniSection))
-> Seq (NormalizedText, IniSection)
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 :: 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 (Seq (Field s) -> ViewL (Field s)
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 = Seq (NormalizedText, IniValue)
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
    | Lens s s a a -> s -> a
forall s t a b. Lens s t a b -> s -> a
get Lens s s a a
l s
s a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== Lens s s a a -> s -> a
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 (Seq (Field s) -> ViewL (Field s)
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 = FieldDescription a -> UpdateCommentPolicy -> Seq BlankLine
forall s.
FieldDescription s -> UpdateCommentPolicy -> Seq BlankLine
getComments FieldDescription a
d (UpdatePolicy -> UpdateCommentPolicy
updateGeneratedCommentPolicy UpdatePolicy
pol)
          new :: (NormalizedText, IniValue)
new = ( FieldDescription a -> NormalizedText
forall t. FieldDescription t -> NormalizedText
fdName FieldDescription a
d
                , IniValue :: Int -> Text -> Text -> Seq BlankLine -> Bool -> Char -> IniValue
IniValue
                  { vLineNo :: Int
vLineNo       = Int
0
                  , vName :: Text
vName         = NormalizedText -> Text
actualText (FieldDescription a -> NormalizedText
forall t. FieldDescription t -> NormalizedText
fdName FieldDescription a
d)
                  , vValue :: Text
vValue        = Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FieldValue a -> a -> Text
forall a. FieldValue a -> a -> Text
fvEmit (FieldDescription a -> FieldValue a
forall t. FieldDescription t -> FieldValue t
fdValue FieldDescription a
d) (Lens s s a a -> s -> a
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 (NormalizedText, IniValue)
-> Seq (NormalizedText, IniValue) -> Seq (NormalizedText, IniValue)
forall a. a -> Seq a -> Seq a
<| ViewL (Field s) -> Seq (NormalizedText, IniValue)
go (Seq (Field s) -> ViewL (Field s)
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 Lens s s (Maybe a) (Maybe a) -> s -> Maybe a
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 (Seq (Field s) -> ViewL (Field s)
forall a. Seq a -> ViewL a
Seq.viewl Seq (Field s)
fs)
      Just a
v ->
        let cs :: Seq BlankLine
cs = FieldDescription a -> UpdateCommentPolicy -> Seq BlankLine
forall s.
FieldDescription s -> UpdateCommentPolicy -> Seq BlankLine
getComments FieldDescription a
d (UpdatePolicy -> UpdateCommentPolicy
updateGeneratedCommentPolicy UpdatePolicy
pol)
            new :: (NormalizedText, IniValue)
new = ( FieldDescription a -> NormalizedText
forall t. FieldDescription t -> NormalizedText
fdName FieldDescription a
d
                  , IniValue :: Int -> Text -> Text -> Seq BlankLine -> Bool -> Char -> IniValue
IniValue
                    { vLineNo :: Int
vLineNo       = Int
0
                    , vName :: Text
vName         = NormalizedText -> Text
actualText (FieldDescription a -> NormalizedText
forall t. FieldDescription t -> NormalizedText
fdName FieldDescription a
d)
                    , vValue :: Text
vValue        = FieldValue a -> a -> Text
forall a. FieldValue a -> a -> Text
fvEmit (FieldDescription a -> FieldValue a
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 (NormalizedText, IniValue)
-> Seq (NormalizedText, IniValue) -> Seq (NormalizedText, IniValue)
forall a. a -> Seq a -> Seq a
<| ViewL (Field s) -> Seq (NormalizedText, IniValue)
go (Seq (Field s) -> ViewL (Field s)
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 :: 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 (Seq (NormalizedText, IniValue) -> ViewL (NormalizedText, IniValue)
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 (Field s -> Bool) -> Seq (Field s) -> Maybe (Field s)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
F.find (\ Field s
f -> Field s -> NormalizedText
forall s. Field s -> NormalizedText
fieldName Field s
f NormalizedText -> NormalizedText -> Bool
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 a -> Either String a
forall a b. b -> Either a b
Right (Lens s s a a -> s -> a
forall s t a b. Lens s t a b -> s -> a
get Lens s s a a
l s
s) Either String a -> Either String a -> Bool
forall a. Eq a => a -> a -> Bool
== FieldValue a -> Text -> Either String a
forall a. FieldValue a -> Text -> Either String a
fvParse (FieldDescription a -> FieldValue a
forall t. FieldDescription t -> FieldValue t
fdValue FieldDescription a
descr) (Text -> Text
T.strip (IniValue -> Text
vValue IniValue
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 ((NormalizedText
t, IniValue
val) (NormalizedText, IniValue)
-> Seq (NormalizedText, IniValue) -> Seq (NormalizedText, IniValue)
forall a. a -> Seq a -> Seq a
<|) (Seq (NormalizedText, IniValue) -> Seq (NormalizedText, IniValue))
-> Either String (Seq (NormalizedText, IniValue))
-> Either String (Seq (NormalizedText, IniValue))
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 (Seq (NormalizedText, IniValue) -> ViewL (NormalizedText, IniValue)
forall a. Seq a -> ViewL a
Seq.viewl Seq (NormalizedText, IniValue)
vs) (NormalizedText -> Seq (Field s) -> Seq (Field s)
forall s. NormalizedText -> Seq (Field s) -> Seq (Field s)
rmv NormalizedText
t Seq (Field s)
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 IniValue
nv = NormalizedText -> Field s -> Char -> Maybe IniValue
mkValue NormalizedText
t Field s
f (IniValue -> Char
vDelimiter IniValue
val)
                     in ((NormalizedText
t, IniValue
nv) (NormalizedText, IniValue)
-> Seq (NormalizedText, IniValue) -> Seq (NormalizedText, IniValue)
forall a. a -> Seq a -> Seq a
<|) (Seq (NormalizedText, IniValue) -> Seq (NormalizedText, IniValue))
-> Either String (Seq (NormalizedText, IniValue))
-> Either String (Seq (NormalizedText, IniValue))
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 (Seq (NormalizedText, IniValue) -> ViewL (NormalizedText, IniValue)
forall a. Seq a -> ViewL a
Seq.viewl Seq (NormalizedText, IniValue)
vs) (NormalizedText -> Seq (Field s) -> Seq (Field s)
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 = FieldValue a -> Text -> Either String a
forall a. FieldValue a -> Text -> Either String a
fvParse (FieldDescription a -> FieldValue a
forall t. FieldDescription t -> FieldValue t
fdValue FieldDescription a
descr) (Text -> Text
T.strip (IniValue -> Text
vValue IniValue
val))
              in if Maybe a -> Either String (Maybe a)
forall a b. b -> Either a b
Right (Lens s s (Maybe a) (Maybe a) -> s -> Maybe a
forall s t a b. Lens s t a b -> s -> a
get Lens s s (Maybe a) (Maybe a)
l s
s) Either String (Maybe a) -> Either String (Maybe a) -> Bool
forall a. Eq a => a -> a -> Bool
== (a -> Maybe a) -> Either String a -> Either String (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just Either String a
parsed
                  then ((NormalizedText
t, IniValue
val) (NormalizedText, IniValue)
-> Seq (NormalizedText, IniValue) -> Seq (NormalizedText, IniValue)
forall a. a -> Seq a -> Seq a
<|) (Seq (NormalizedText, IniValue) -> Seq (NormalizedText, IniValue))
-> Either String (Seq (NormalizedText, IniValue))
-> Either String (Seq (NormalizedText, IniValue))
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 (Seq (NormalizedText, IniValue) -> ViewL (NormalizedText, IniValue)
forall a. Seq a -> ViewL a
Seq.viewl Seq (NormalizedText, IniValue)
vs) (NormalizedText -> Seq (Field s) -> Seq (Field s)
forall s. NormalizedText -> Seq (Field s) -> Seq (Field s)
rmv NormalizedText
t Seq (Field s)
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 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) (NormalizedText, IniValue)
-> Seq (NormalizedText, IniValue) -> Seq (NormalizedText, IniValue)
forall a. a -> Seq a -> Seq a
<|) (Seq (NormalizedText, IniValue) -> Seq (NormalizedText, IniValue))
-> Either String (Seq (NormalizedText, IniValue))
-> Either String (Seq (NormalizedText, IniValue))
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 (Seq (NormalizedText, IniValue) -> ViewL (NormalizedText, IniValue)
forall a. Seq a -> ViewL a
Seq.viewl Seq (NormalizedText, IniValue)
vs) (NormalizedText -> Seq (Field s) -> Seq (Field s)
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 (Seq (NormalizedText, IniValue) -> ViewL (NormalizedText, IniValue)
forall a. Seq a -> ViewL a
Seq.viewl Seq (NormalizedText, IniValue)
vs) (NormalizedText -> Seq (Field s) -> Seq (Field s)
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) (NormalizedText, IniValue)
-> Seq (NormalizedText, IniValue) -> Seq (NormalizedText, IniValue)
forall a. a -> Seq a -> Seq a
<|) (Seq (NormalizedText, IniValue) -> Seq (NormalizedText, IniValue))
-> Either String (Seq (NormalizedText, IniValue))
-> Either String (Seq (NormalizedText, IniValue))
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 (Seq (NormalizedText, IniValue) -> ViewL (NormalizedText, IniValue)
forall a. Seq a -> ViewL a
Seq.viewl Seq (NormalizedText, IniValue)
vs) Seq (Field s)
fs
              | Bool
otherwise -> String -> Either String (Seq (NormalizedText, IniValue))
forall a b. a -> Either a b
Left (String
"Unexpected field: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ NormalizedText -> String
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 = Seq (NormalizedText, IniValue)
-> Either String (Seq (NormalizedText, IniValue))
forall (m :: * -> *) a. Monad m => a -> m a
return (ViewL (Field s) -> Seq (NormalizedText, IniValue)
finish (Seq (Field s) -> ViewL (Field s)
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 (Field s -> NormalizedText
forall s. Field s -> NormalizedText
fieldName Field s
f) Field s
f Char
'=' =
            (Field s -> NormalizedText
forall s. Field s -> NormalizedText
fieldName Field s
f, IniValue
val) (NormalizedText, IniValue)
-> Seq (NormalizedText, IniValue) -> Seq (NormalizedText, IniValue)
forall a. a -> Seq a -> Seq a
<| ViewL (Field s) -> Seq (NormalizedText, IniValue)
finish (Seq (Field s) -> ViewL (Field s)
forall a. Seq a -> ViewL a
Seq.viewl Seq (Field s)
fs)
          | Bool
otherwise = ViewL (Field s) -> Seq (NormalizedText, IniValue)
finish (Seq (Field s) -> ViewL (Field s)
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 (FieldDescription a -> Bool
forall t. FieldDescription t -> Bool
fdSkipIfMissing FieldDescription a
descr)
          , Just IniValue
val <- NormalizedText -> Field s -> Char -> Maybe IniValue
mkValue (Field s -> NormalizedText
forall s. Field s -> NormalizedText
fieldName Field s
f) Field s
f Char
'=' =
            (Field s -> NormalizedText
forall s. Field s -> NormalizedText
fieldName Field s
f, IniValue
val) (NormalizedText, IniValue)
-> Seq (NormalizedText, IniValue) -> Seq (NormalizedText, IniValue)
forall a. a -> Seq a -> Seq a
<| ViewL (Field s) -> Seq (NormalizedText, IniValue)
finish (Seq (Field s) -> ViewL (Field s)
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 (Field s -> NormalizedText
forall s. Field s -> NormalizedText
fieldName Field s
f) Field s
f Char
'=' =
            (Field s -> NormalizedText
forall s. Field s -> NormalizedText
fieldName Field s
f, IniValue
val) (NormalizedText, IniValue)
-> Seq (NormalizedText, IniValue) -> Seq (NormalizedText, IniValue)
forall a. a -> Seq a -> Seq a
<| ViewL (Field s) -> Seq (NormalizedText, IniValue)
finish (Seq (Field s) -> ViewL (Field s)
forall a. Seq a -> ViewL a
Seq.viewl Seq (Field s)
fs)
          | Bool
otherwise = ViewL (Field s) -> Seq (NormalizedText, IniValue)
finish (Seq (Field s) -> ViewL (Field s)
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 = Seq (NormalizedText, IniValue)
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 -> Seq BlankLine
forall a. Seq a
Seq.empty
                UpdateCommentPolicy
CommentPolicyAddFieldComment ->
                  Seq Text -> Seq BlankLine
mkComments (Field s -> Seq Text
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 :: Int -> Text -> Text -> Seq BlankLine -> Bool -> Char -> IniValue
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 ->
                 IniValue -> Maybe IniValue
forall a. a -> Maybe a
Just (IniValue
val { vValue :: Text
vValue = Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FieldValue a -> a -> Text
forall a. FieldValue a -> a -> Text
fvEmit (FieldDescription a -> FieldValue a
forall t. FieldDescription t -> FieldValue t
fdValue FieldDescription a
descr) (Lens s s a a -> s -> a
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 Lens s s (Maybe a) (Maybe a) -> s -> Maybe a
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  -> IniValue -> Maybe IniValue
forall a. a -> Maybe a
Just (IniValue
val { vValue :: Text
vValue = Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FieldValue a -> a -> Text
forall a. FieldValue a -> a -> Text
fvEmit (FieldDescription a -> FieldValue a
forall t. FieldDescription t -> FieldValue t
fdValue FieldDescription a
descr) a
v })
                   Maybe a
Nothing -> Maybe IniValue
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.