{-# LANGUAGE CPP #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiWayIf #-}
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, 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
type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t
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)
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)
#if __GLASGOW_HASKELL__ < 710
(&) :: a -> (a -> b) -> b
a & f = f a
infixl 1 &
#endif
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
}
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
}
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)
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 })
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
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
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)
}
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'
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 }
data FieldValue a = FieldValue
{ FieldValue a -> Text -> Either String a
fvParse :: Text -> Either String a
, FieldValue a -> a -> Text
fvEmit :: a -> Text
}
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)
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)
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)
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
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
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 :: 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
{ FieldDescription t -> NormalizedText
fdName :: NormalizedText
, FieldDescription t -> FieldValue t
fdValue :: FieldValue t
, :: Seq Text
, FieldDescription t -> Maybe Text
fdDummy :: Maybe Text
, FieldDescription t -> Bool
fdSkipIfMissing :: Bool
}
(.=) :: 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
(.=?) :: 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
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 :: 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 :: 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 :: 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
}
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 :: 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
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
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 }
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 }
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"
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
}
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
}
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))
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
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
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
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
/= :: 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)
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
}
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
/= :: 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)
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 :: 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 (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
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 })
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)
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)
| 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)
| 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 =
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 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 (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 (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 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)
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)
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)
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)
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