{-# 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 f :: a -> b
f (I x :: 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 lns :: Lens s t a b
lns x :: b
x a :: 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 _ (C x :: 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 lns :: Lens s t a b
lns a :: 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 t :: 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 (\ (t' :: NormalizedText
t', _) -> 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 n :: NormalizedText
n = (Field s -> Bool) -> Seq (Field s) -> Seq (Field s)
forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter (\ f :: 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 def :: s
def (IniSpec spec :: 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 get' :: a -> b
get' set' :: b -> a -> a
set' f :: b -> f b
f a :: 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 (\ i :: s
i v :: 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 raw :: 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 t :: 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 raw :: 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 new :: s
new i :: 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 err :: String
err -> String -> Ini s
forall a. HasCallStack => String -> a
error String
err
Right i' :: Ini s
i' -> Ini s
i'
setIniUpdatePolicy :: UpdatePolicy -> Ini s -> Ini s
setIniUpdatePolicy :: UpdatePolicy -> Ini s -> Ini s
setIniUpdatePolicy pol :: UpdatePolicy
pol i :: 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 name :: Text
name (SectionSpec mote :: 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 _ fd :: FieldDescription a
fd) = FieldDescription a -> Bool
forall t. FieldDescription t -> Bool
fdSkipIfMissing FieldDescription a
fd
isOptional (FieldMb _ _) = Bool
True
allOptional
:: (SectionSpec s () -> IniSpec s ())
-> (SectionSpec s () -> IniSpec s ())
allOptional :: (SectionSpec s () -> IniSpec s ())
-> SectionSpec s () -> IniSpec s ()
allOptional k :: SectionSpec s () -> IniSpec s ()
k spec :: 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 comp :: 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 (\ s :: Seq (Section s)
s -> case Seq (Section s) -> ViewR (Section s)
forall a. Seq a -> ViewR a
Seq.viewr Seq (Section s)
s of
EmptyR -> Seq (Section s)
s
rs :: Seq (Section s)
rs :> Section name :: NormalizedText
name fields :: Seq (Field s)
fields _ ->
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 l :: Lens s s a a
l d :: 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 l :: Lens s s (Maybe a) (Maybe a)
l d :: 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 _ FieldDescription { fdName :: forall t. FieldDescription t -> NormalizedText
fdName = NormalizedText
n }) = NormalizedText
n
fieldName (FieldMb _ FieldDescription { fdName :: forall t. FieldDescription t -> NormalizedText
fdName = NormalizedText
n }) = NormalizedText
n
fieldComment :: Field s -> Seq Text
(Field _ FieldDescription { fdComment :: forall t. FieldDescription t -> Seq Text
fdComment = Seq Text
n }) = Seq Text
n
fieldComment (FieldMb _ 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 ()
l :: Lens s s t t
l .= :: Lens s s t t -> FieldDescription t -> SectionSpec s ()
.= f :: 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 ()
l :: Lens s s (Maybe t) (Maybe t)
l .=? :: Lens s s (Maybe t) (Maybe t)
-> FieldDescription t -> SectionSpec s ()
.=? f :: 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
cmt :: [Text]
cmt fd :: 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 t :: Text
t fd :: 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 fd :: 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 name :: Text
name value :: 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
<> " ")
, 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 name :: 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 t :: Text
t = case String -> Maybe b
forall a. Read a => String -> Maybe a
readMaybe (Text -> String
T.unpack Text
t) of
Just v :: b
v -> b -> Either String b
forall a b. b -> Either a b
Right b
v
Nothing -> String -> Either String b
forall a b. a -> Either a b
Left ("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]
++
" 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 s :: Text
s = case Text -> Text
T.toLower Text
s of
"true" -> Bool -> Either String Bool
forall a b. b -> Either a b
Right Bool
True
"yes" -> Bool -> Either String Bool
forall a b. b -> Either a b
Right Bool
True
"t" -> Bool -> Either String Bool
forall a b. b -> Either a b
Right Bool
True
"y" -> Bool -> Either String Bool
forall a b. b -> Either a b
Right Bool
True
"false" -> Bool -> Either String Bool
forall a b. b -> Either a b
Right Bool
False
"no" -> Bool -> Either String Bool
forall a b. b -> Either a b
Right Bool
False
"f" -> Bool -> Either String Bool
forall a b. b -> Either a b
Right Bool
False
"n" -> Bool -> Either String Bool
forall a b. b -> Either a b
Right Bool
False
_ -> String -> Either String Bool
forall a b. a -> Either a b
Left ("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]
++ " as a boolean")
emit :: Bool -> p
emit True = "true"
emit False = "false"
listWithSeparator :: IsList l => Text -> FieldValue (Item l) -> FieldValue l
listWithSeparator :: Text -> FieldValue (Item l) -> FieldValue l
listWithSeparator sep :: Text
sep fv :: 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 left :: FieldValue l
left sep :: Text
sep right :: FieldValue r
right = FieldValue :: forall a. (Text -> Either String a) -> (a -> Text) -> FieldValue a
FieldValue
{ fvParse :: Text -> Either String (l, r)
fvParse = \ t :: Text
t ->
let (leftChunk :: Text
leftChunk, rightChunk :: 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 = \ (x :: l
x, y :: 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
s Seq.EmptyL _ = s -> Either String s
forall a b. b -> Either a b
Right s
s
parseSections s :: s
s (Section name :: NormalizedText
name fs :: Seq (Field s)
fs opt :: Bool
opt Seq.:< rest :: Seq (Section s)
rest) i :: Seq (NormalizedText, IniSection)
i
| Just v :: 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 ("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
s Seq.EmptyL _ = s -> Either String s
forall a b. b -> Either a b
Right s
s
parseFields s :: s
s (Field l :: Lens s s a a
l descr :: FieldDescription a
descr Seq.:< fs :: Seq (Field s)
fs) sect :: IniSection
sect
| Just v :: 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 ("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
s (FieldMb l :: Lens s s (Maybe a) (Maybe a)
l descr :: FieldDescription a
descr Seq.:< fs :: Seq (Field s)
fs) sect :: IniSection
sect
| Just v :: 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
s spec :: 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 name :: NormalizedText
name fs :: Seq (Field s)
fs _) ->
(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
comments :: Seq Text
comments =
(Text -> BlankLine) -> Seq Text -> Seq BlankLine
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ ln :: Text
ln -> Char -> Text -> BlankLine
CommentLine '#' (" " 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
s name :: Text
name fs :: 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 = 0
, isEndLine :: Int
isEndLine = 0
, isComments :: Seq BlankLine
isComments = Seq BlankLine
forall a. Seq a
Seq.empty
} where mkIniValue :: Text -> FieldDescription t -> Bool -> (NormalizedText, IniValue)
mkIniValue val :: Text
val descr :: FieldDescription t
descr opt :: 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 = 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
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 = '='
}
)
toVal :: Field s -> (NormalizedText, IniValue)
toVal (Field l :: Lens s s a a
l descr :: FieldDescription a
descr)
| Just dummy :: 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 l :: Lens s s (Maybe a) (Maybe a)
l descr :: FieldDescription a
descr)
| Just dummy :: 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 v :: 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 "" 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)
_ CommentPolicyNone = Seq BlankLine
forall a. Seq a
Seq.empty
getComments f :: FieldDescription s
f CommentPolicyAddFieldComment =
Seq Text -> Seq BlankLine
mkComments (FieldDescription s -> Seq Text
forall t. FieldDescription t -> Seq Text
fdComment FieldDescription s
f)
getComments _ (CommentPolicyAddDefaultComment cs :: 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
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 ini' :: 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 :: s
def sections :: Seq (NormalizedText, IniSection)
sections fields :: Seq (Section s)
fields pol :: 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
$ \ (name :: NormalizedText
name, sec :: IniSection
sec) -> do
let err :: Either String b
err = String -> Either String b
forall a b. a -> Either a b
Left ("Unexpected top-level section: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ NormalizedText -> String
forall a. Show a => a -> String
show NormalizedText
name)
Section _ spec :: Seq (Field s)
spec _ <- 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 n :: NormalizedText
n _ _) -> 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 nm :: NormalizedText
nm spec :: Seq (Field s)
spec _) ->
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 0 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 :: s
def fields :: Seq (Field s)
fields pol :: 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 EmptyL = Seq (NormalizedText, IniValue)
forall a. Seq a
Seq.empty
go (Field l :: Lens s s a a
l d :: FieldDescription a
d :< fs :: 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 = 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
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 = '='
}
)
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 l :: Lens s s (Maybe a) (Maybe a)
l d :: FieldDescription a
d :< fs :: 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
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 v :: 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 = 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 = '='
}
)
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
s values :: Seq (NormalizedText, IniValue)
values fields :: Seq (Field s)
fields pol :: 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 ((t :: NormalizedText
t, val :: IniValue
val) :< vs :: Seq (NormalizedText, IniValue)
vs) fs :: 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 (\ f :: 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 l :: Lens s s a a
l descr :: 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 nv :: 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 l :: Lens s s (Maybe a) (Maybe a)
l descr :: 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 nv :: 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)
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)
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 ("Unexpected field: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ NormalizedText -> String
forall a. Show a => a -> String
show NormalizedText
t)
go EmptyL fs :: 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 {}) :< fs :: Seq (Field s)
fs)
| UpdatePolicy -> Bool
updateAddOptionalFields UpdatePolicy
pol
, Just val :: IniValue
val <- NormalizedText -> Field s -> Char -> Maybe IniValue
mkValue (Field s -> NormalizedText
forall s. Field s -> NormalizedText
fieldName Field s
f) Field s
f '=' =
(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 _ descr :: FieldDescription a
descr) :< fs :: Seq (Field s)
fs)
| Bool -> Bool
not (FieldDescription a -> Bool
forall t. FieldDescription t -> Bool
fdSkipIfMissing FieldDescription a
descr)
, Just val :: IniValue
val <- NormalizedText -> Field s -> Char -> Maybe IniValue
mkValue (Field s -> NormalizedText
forall s. Field s -> NormalizedText
fieldName Field s
f) Field s
f '=' =
(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 val :: IniValue
val <- NormalizedText -> Field s -> Char -> Maybe IniValue
mkValue (Field s -> NormalizedText
forall s. Field s -> NormalizedText
fieldName Field s
f) Field s
f '=' =
(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 EmptyL = Seq (NormalizedText, IniValue)
forall a. Seq a
Seq.empty
mkValue :: NormalizedText -> Field s -> Char -> Maybe IniValue
mkValue t :: NormalizedText
t fld :: Field s
fld delim :: Char
delim =
let comments :: Seq BlankLine
comments = case UpdatePolicy -> UpdateCommentPolicy
updateGeneratedCommentPolicy UpdatePolicy
pol of
CommentPolicyNone -> Seq BlankLine
forall a. Seq a
Seq.empty
CommentPolicyAddFieldComment ->
Seq Text -> Seq BlankLine
mkComments (Field s -> Seq Text
forall s. Field s -> Seq Text
fieldComment Field s
fld)
CommentPolicyAddDefaultComment cs :: 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 = 0
, vName :: Text
vName = NormalizedText -> Text
actualText NormalizedText
t
, vValue :: Text
vValue = ""
, vComments :: Seq BlankLine
vComments = Seq BlankLine
comments
, vCommentedOut :: Bool
vCommentedOut = Bool
False
, vDelimiter :: Char
vDelimiter = Char
delim
}
in case Field s
fld of
Field l :: Lens s s a a
l descr :: FieldDescription a
descr ->
IniValue -> Maybe IniValue
forall a. a -> Maybe a
Just (IniValue
val { vValue :: Text
vValue = " " 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 l :: Lens s s (Maybe a) (Maybe a)
l descr :: 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 v :: a
v -> IniValue -> Maybe IniValue
forall a. a -> Maybe a
Just (IniValue
val { vValue :: Text
vValue = " " 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 })
Nothing -> Maybe IniValue
forall a. Maybe a
Nothing