{-# LANGUAGE CPP #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Data.Ini.Config.Bidir
(
Ini,
ini,
getIniValue,
iniValueL,
getRawIni,
parseIni,
serializeIni,
updateIni,
setIniUpdatePolicy,
UpdatePolicy (..),
UpdateCommentPolicy (..),
defaultUpdatePolicy,
IniSpec,
SectionSpec,
section,
allOptional,
FieldDescription,
(.=),
(.=?),
field,
flag,
comment,
placeholderValue,
optional,
FieldValue (..),
text,
string,
number,
bool,
readable,
listWithSeparator,
pairWithSeparator,
(&),
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)
type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t
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) = b -> I b
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 = 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)
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) = a -> C a b
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 = 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 :: forall a. NormalizedText -> Seq (NormalizedText, a) -> Maybe a
lkp NormalizedText
t = ((NormalizedText, a) -> a) -> Maybe (NormalizedText, a) -> Maybe a
forall a b. (a -> b) -> Maybe a -> Maybe b
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 :: forall s. 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)
#if __GLASGOW_HASKELL__ < 710
(&) :: a -> (a -> b) -> b
a & f = f a
infixl 1 &
#endif
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
}
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 = 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
}
getIniValue :: Ini s -> s
getIniValue :: forall s. 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 :: 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) (b -> a) -> f b -> f a
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` b -> f b
f (a -> b
get' a
a)
iniValueL :: Lens (Ini s) (Ini s) s s
iniValueL :: forall s (f :: * -> *).
Functor f =>
(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})
serializeIni :: Ini s -> Text
serializeIni :: forall s. 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
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
} =
s -> Spec s -> RawIni
forall s. s -> Spec s -> RawIni
emitIniFile s
s Spec s
spec
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 <- 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 a. a -> Either String a
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)
}
updateIni :: s -> Ini s -> Ini s
updateIni :: forall s. 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'
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}
data FieldValue a = FieldValue
{
forall a. FieldValue a -> Text -> Either String a
fvParse :: Text -> Either String a,
forall a. FieldValue a -> a -> Text
fvEmit :: a -> Text
}
type BidirM s a = State (Seq s) a
runBidirM :: BidirM s a -> Seq s
runBidirM :: forall s a. 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)
newtype IniSpec s a = IniSpec (BidirM (Section s) a)
deriving ((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
$cfmap :: forall s a b. (a -> b) -> IniSpec s a -> IniSpec s b
fmap :: forall a b. (a -> b) -> IniSpec s a -> IniSpec s b
$c<$ :: forall s a b. a -> IniSpec s b -> IniSpec s a
<$ :: forall a b. a -> IniSpec s b -> IniSpec s a
Functor, Functor (IniSpec s)
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)
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
$cpure :: forall s a. a -> IniSpec s a
pure :: forall a. a -> IniSpec s a
$c<*> :: forall s a b. IniSpec s (a -> b) -> IniSpec s a -> IniSpec s b
<*> :: forall a b. IniSpec s (a -> b) -> IniSpec s a -> IniSpec s b
$cliftA2 :: forall s a b c.
(a -> b -> c) -> IniSpec s a -> IniSpec s b -> IniSpec s c
liftA2 :: forall a b c.
(a -> b -> c) -> IniSpec s a -> IniSpec s b -> IniSpec s c
$c*> :: forall s a b. IniSpec s a -> IniSpec s b -> IniSpec s b
*> :: 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 a
<* :: forall a b. IniSpec s a -> IniSpec s b -> IniSpec s a
Applicative, Applicative (IniSpec s)
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)
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
$c>>= :: forall s a b. IniSpec s a -> (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 -> IniSpec s b -> IniSpec s b
>> :: forall a b. IniSpec s a -> IniSpec s b -> IniSpec s b
$creturn :: forall s a. a -> IniSpec s a
return :: forall a. a -> IniSpec s a
Monad)
newtype SectionSpec s a = SectionSpec (BidirM (Field s) a)
deriving ((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
$cfmap :: forall s a b. (a -> b) -> SectionSpec s a -> SectionSpec s b
fmap :: forall a b. (a -> b) -> SectionSpec s a -> SectionSpec s b
$c<$ :: forall s a b. a -> SectionSpec s b -> SectionSpec s a
<$ :: forall a b. a -> SectionSpec s b -> SectionSpec s a
Functor, Functor (SectionSpec s)
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)
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
$cpure :: forall s a. a -> SectionSpec s a
pure :: forall a. a -> SectionSpec s a
$c<*> :: forall s a b.
SectionSpec s (a -> b) -> SectionSpec s a -> SectionSpec s b
<*> :: forall a b.
SectionSpec s (a -> b) -> SectionSpec s a -> SectionSpec s b
$cliftA2 :: forall s a b c.
(a -> b -> c)
-> SectionSpec s a -> SectionSpec s b -> SectionSpec s c
liftA2 :: forall a b c.
(a -> b -> c)
-> SectionSpec s a -> SectionSpec s b -> SectionSpec s c
$c*> :: forall s a b. SectionSpec s a -> SectionSpec s b -> SectionSpec s b
*> :: 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 a
<* :: forall a b. SectionSpec s a -> SectionSpec s b -> SectionSpec s a
Applicative, Applicative (SectionSpec s)
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)
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
$c>>= :: forall s a b.
SectionSpec s a -> (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 -> SectionSpec s b -> SectionSpec s b
>> :: forall a b. SectionSpec s a -> SectionSpec s b -> SectionSpec s b
$creturn :: forall s a. a -> SectionSpec s a
return :: forall a. a -> SectionSpec s a
Monad)
section :: Text -> SectionSpec s () -> IniSpec s ()
section :: forall s. 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 :: forall s. 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
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 = 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 a b. (a -> b) -> Seq a -> Seq b
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 :: forall s. 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 (a -> f a) -> s -> f s
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 (Maybe a -> f (Maybe a)) -> s -> f s
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
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)
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
(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
data FieldDescription t = FieldDescription
{ forall t. FieldDescription t -> NormalizedText
fdName :: NormalizedText,
forall t. FieldDescription t -> FieldValue t
fdValue :: FieldValue t,
:: Seq Text,
forall t. FieldDescription t -> Maybe Text
fdDummy :: Maybe Text,
forall t. FieldDescription t -> Bool
fdSkipIfMissing :: Bool
}
(.=) :: 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 = 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 (t -> f t) -> s -> f s
Lens s s t t
l FieldDescription t
f
(.=?) :: 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 = 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 (Maybe t -> f (Maybe t)) -> s -> f s
Lens s s (Maybe t) (Maybe t)
l FieldDescription t
f
comment :: [Text] -> FieldDescription t -> FieldDescription t
[Text]
cmt FieldDescription t
fd = FieldDescription t
fd {fdComment :: Seq Text
fdComment = [Text] -> Seq Text
forall a. [a] -> Seq a
Seq.fromList [Text]
cmt}
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 = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t}
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 .=?
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 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
}
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
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 = 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
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 = FieldValue a
forall a. (Show a, Read a, Typeable a) => FieldValue a
readable
text :: FieldValue Text
text :: FieldValue Text
text = 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}
string :: FieldValue String
string :: FieldValue String
string = 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}
bool :: FieldValue Bool
bool :: FieldValue Bool
bool = FieldValue {fvParse :: Text -> Either String Bool
fvParse = Text -> Either String Bool
parse, fvEmit :: Bool -> Text
fvEmit = Bool -> Text
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" -> 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 -> a
emit Bool
True = a
"true"
emit Bool
False = a
"false"
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 = ([Item l] -> l) -> Either String [Item l] -> Either String l
forall a b. (a -> b) -> Either String a -> Either String b
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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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
. HasCallStack => Text -> Text -> [Text]
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
}
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) = HasCallStack => Text -> Text -> (Text, Text)
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 a. a -> Either String a
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
}
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)
_ = 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)
)
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
_ = 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 (a -> f a) -> s -> f s
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 (Maybe a -> f (Maybe a)) -> s -> f s
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 (Maybe a -> f (Maybe a)) -> s -> f s
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
emitIniFile :: s -> Spec s -> RawIni
emitIniFile :: forall s. 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 a b. (a -> b) -> Seq a -> Seq b
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
= (Text -> BlankLine) -> Seq Text -> Seq BlankLine
forall a b. (a -> b) -> Seq a -> Seq b
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))
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 = (Field s -> (NormalizedText, IniValue))
-> Seq (Field s) -> Seq (NormalizedText, IniValue)
forall a b. (a -> b) -> Seq a -> Seq b
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
{ 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 (a -> f a) -> s -> f s
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 (Maybe a -> f (Maybe a)) -> s -> f s
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
data UpdatePolicy = UpdatePolicy
{
UpdatePolicy -> Bool
updateAddOptionalFields :: Bool,
:: Bool,
:: UpdateCommentPolicy
}
deriving (UpdatePolicy -> UpdatePolicy -> Bool
(UpdatePolicy -> UpdatePolicy -> Bool)
-> (UpdatePolicy -> UpdatePolicy -> Bool) -> Eq UpdatePolicy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UpdatePolicy -> UpdatePolicy -> Bool
== :: UpdatePolicy -> UpdatePolicy -> Bool
$c/= :: UpdatePolicy -> UpdatePolicy -> Bool
/= :: 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
$cshowsPrec :: Int -> UpdatePolicy -> String -> String
showsPrec :: Int -> UpdatePolicy -> String -> String
$cshow :: UpdatePolicy -> String
show :: UpdatePolicy -> String
$cshowList :: [UpdatePolicy] -> String -> String
showList :: [UpdatePolicy] -> String -> String
Show)
defaultUpdatePolicy :: UpdatePolicy
defaultUpdatePolicy :: UpdatePolicy
defaultUpdatePolicy =
UpdatePolicy
{ updateAddOptionalFields :: Bool
updateAddOptionalFields = Bool
False,
updateIgnoreExtraneousFields :: Bool
updateIgnoreExtraneousFields = Bool
True,
updateGeneratedCommentPolicy :: UpdateCommentPolicy
updateGeneratedCommentPolicy = UpdateCommentPolicy
CommentPolicyNone
}
data
=
|
|
(Seq Text)
deriving (UpdateCommentPolicy -> UpdateCommentPolicy -> Bool
(UpdateCommentPolicy -> UpdateCommentPolicy -> Bool)
-> (UpdateCommentPolicy -> UpdateCommentPolicy -> Bool)
-> Eq UpdateCommentPolicy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UpdateCommentPolicy -> UpdateCommentPolicy -> Bool
== :: UpdateCommentPolicy -> UpdateCommentPolicy -> Bool
$c/= :: UpdateCommentPolicy -> UpdateCommentPolicy -> Bool
/= :: 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
$cshowsPrec :: Int -> UpdateCommentPolicy -> String -> String
showsPrec :: Int -> UpdateCommentPolicy -> String -> String
$cshow :: UpdateCommentPolicy -> String
show :: UpdateCommentPolicy -> String
$cshowList :: [UpdateCommentPolicy] -> String -> String
showList :: [UpdateCommentPolicy] -> String -> String
Show)
getComments :: FieldDescription s -> UpdateCommentPolicy -> Seq BlankLine
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
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
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 a. a -> Either String a
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 :: 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
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 a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (NormalizedText
name, IniSection
sec {isVals :: Seq (NormalizedText, IniValue)
isVals = Seq (NormalizedText, IniValue)
newVals})
let existingSectionNames :: Seq NormalizedText
existingSectionNames = ((NormalizedText, IniSection) -> NormalizedText)
-> Seq (NormalizedText, IniSection) -> Seq NormalizedText
forall a b. (a -> b) -> Seq a -> Seq b
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 a. Eq a => a -> Seq a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Seq NormalizedText
existingSectionNames
then Seq (NormalizedText, IniSection)
-> Either String (Seq (NormalizedText, IniSection))
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return Seq (NormalizedText, IniSection)
forall a. Monoid a => a
mempty
else
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 a. a -> Either String a
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 a. a -> Either String a
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 a. a -> Either String a
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)
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 (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)
| Lens s s a a -> s -> a
forall s t a b. Lens s t a b -> s -> a
get (a -> f a) -> s -> f s
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 (a -> f a) -> s -> f s
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)
| 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
{ 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 (a -> f a) -> s -> f s
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 (Maybe a -> f (Maybe a)) -> s -> f s
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
{ 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 :: 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 (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 =
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 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 (a -> f a) -> s -> f s
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))
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 a b. (a -> b) -> Either String a -> Either String b
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)
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 a b. (a -> b) -> Either String a -> Either String b
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)
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 (Maybe a -> f (Maybe a)) -> s -> f s
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 a b. (a -> b) -> Either String a -> Either String b
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 a b. (a -> b) -> Either String a -> Either String b
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)
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 a b. (a -> b) -> Either String a -> Either String b
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)
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 a b. (a -> b) -> Either String a -> Either String b
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)
go ViewL (NormalizedText, IniValue)
EmptyL Seq (Field s)
fs = Seq (NormalizedText, IniValue)
-> Either String (Seq (NormalizedText, IniValue))
forall a. a -> Either String a
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)
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
{ 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 (a -> f a) -> s -> f s
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 (Maybe a -> f (Maybe a)) -> s -> f s
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