module Data.Ini.Config.Raw
(
RawIni (..),
IniSection (..),
IniValue (..),
BlankLine (..),
NormalizedText (..),
normalize,
parseRawIni,
printRawIni,
lookupInSection,
lookupSection,
lookupValue,
)
where
import Control.Monad (void)
import qualified Data.Foldable as F
import Data.Monoid ((<>))
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Lazy as LazyText
import qualified Data.Text.Lazy.Builder as Builder
import Data.Void (Void)
import Text.Megaparsec
import Text.Megaparsec.Char
type Parser = Parsec Void Text
data NormalizedText = NormalizedText
{ NormalizedText -> Text
actualText :: Text,
NormalizedText -> Text
normalizedText :: Text
}
deriving (Int -> NormalizedText -> ShowS
[NormalizedText] -> ShowS
NormalizedText -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NormalizedText] -> ShowS
$cshowList :: [NormalizedText] -> ShowS
show :: NormalizedText -> String
$cshow :: NormalizedText -> String
showsPrec :: Int -> NormalizedText -> ShowS
$cshowsPrec :: Int -> NormalizedText -> ShowS
Show)
normalize :: Text -> NormalizedText
normalize :: Text -> NormalizedText
normalize Text
t = Text -> Text -> NormalizedText
NormalizedText Text
t (Text -> Text
T.toLower (Text -> Text
T.strip Text
t))
instance Eq NormalizedText where
NormalizedText Text
_ Text
x == :: NormalizedText -> NormalizedText -> Bool
== NormalizedText Text
_ Text
y =
Text
x forall a. Eq a => a -> a -> Bool
== Text
y
instance Ord NormalizedText where
NormalizedText Text
_ Text
x compare :: NormalizedText -> NormalizedText -> Ordering
`compare` NormalizedText Text
_ Text
y =
Text
x forall a. Ord a => a -> a -> Ordering
`compare` Text
y
newtype RawIni = RawIni
{ RawIni -> Seq (NormalizedText, IniSection)
fromRawIni :: Seq (NormalizedText, IniSection)
}
deriving (RawIni -> RawIni -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RawIni -> RawIni -> Bool
$c/= :: RawIni -> RawIni -> Bool
== :: RawIni -> RawIni -> Bool
$c== :: RawIni -> RawIni -> Bool
Eq, Int -> RawIni -> ShowS
[RawIni] -> ShowS
RawIni -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RawIni] -> ShowS
$cshowList :: [RawIni] -> ShowS
show :: RawIni -> String
$cshow :: RawIni -> String
showsPrec :: Int -> RawIni -> ShowS
$cshowsPrec :: Int -> RawIni -> ShowS
Show)
data IniSection = IniSection
{
IniSection -> Text
isName :: Text,
IniSection -> Seq (NormalizedText, IniValue)
isVals :: Seq (NormalizedText, IniValue),
IniSection -> Int
isStartLine :: Int,
IniSection -> Int
isEndLine :: Int,
:: Seq BlankLine
}
deriving (IniSection -> IniSection -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IniSection -> IniSection -> Bool
$c/= :: IniSection -> IniSection -> Bool
== :: IniSection -> IniSection -> Bool
$c== :: IniSection -> IniSection -> Bool
Eq, Int -> IniSection -> ShowS
[IniSection] -> ShowS
IniSection -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IniSection] -> ShowS
$cshowList :: [IniSection] -> ShowS
show :: IniSection -> String
$cshow :: IniSection -> String
showsPrec :: Int -> IniSection -> ShowS
$cshowsPrec :: Int -> IniSection -> ShowS
Show)
data IniValue = IniValue
{
IniValue -> Int
vLineNo :: Int,
IniValue -> Text
vName :: Text,
IniValue -> Text
vValue :: Text,
:: Seq BlankLine,
:: Bool,
IniValue -> Char
vDelimiter :: Char
}
deriving (IniValue -> IniValue -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IniValue -> IniValue -> Bool
$c/= :: IniValue -> IniValue -> Bool
== :: IniValue -> IniValue -> Bool
$c== :: IniValue -> IniValue -> Bool
Eq, Int -> IniValue -> ShowS
[IniValue] -> ShowS
IniValue -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IniValue] -> ShowS
$cshowList :: [IniValue] -> ShowS
show :: IniValue -> String
$cshow :: IniValue -> String
showsPrec :: Int -> IniValue -> ShowS
$cshowsPrec :: Int -> IniValue -> ShowS
Show)
data BlankLine
= Char Text
| BlankLine
deriving (BlankLine -> BlankLine -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlankLine -> BlankLine -> Bool
$c/= :: BlankLine -> BlankLine -> Bool
== :: BlankLine -> BlankLine -> Bool
$c== :: BlankLine -> BlankLine -> Bool
Eq, Int -> BlankLine -> ShowS
[BlankLine] -> ShowS
BlankLine -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlankLine] -> ShowS
$cshowList :: [BlankLine] -> ShowS
show :: BlankLine -> String
$cshow :: BlankLine -> String
showsPrec :: Int -> BlankLine -> ShowS
$cshowsPrec :: Int -> BlankLine -> ShowS
Show)
parseRawIni :: Text -> Either String RawIni
parseRawIni :: Text -> Either String RawIni
parseRawIni Text
t = case forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
runParser Parser RawIni
pIni String
"ini file" Text
t of
Left ParseErrorBundle Text Void
err -> forall a b. a -> Either a b
Left (forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty ParseErrorBundle Text Void
err)
Right RawIni
v -> forall a b. b -> Either a b
Right RawIni
v
pIni :: Parser RawIni
pIni :: Parser RawIni
pIni = do
Seq BlankLine
leading <- Parser (Seq BlankLine)
sBlanks
Seq BlankLine -> Seq (NormalizedText, IniSection) -> Parser RawIni
pSections Seq BlankLine
leading forall a. Seq a
Seq.empty
sBlanks :: Parser (Seq BlankLine)
sBlanks :: Parser (Seq BlankLine)
sBlanks = forall a. [a] -> Seq a
Seq.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ((BlankLine
BlankLine forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (f :: * -> *) a. Functor f => f a -> f ()
void forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
eol) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity BlankLine
sComment)
sComment :: Parser BlankLine
= do
Char
c <- forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf String
";#"
Text
txt <- String -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
eol
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Text -> BlankLine
CommentLine Char
c Text
txt)
pSections :: Seq BlankLine -> Seq (NormalizedText, IniSection) -> Parser RawIni
pSections :: Seq BlankLine -> Seq (NormalizedText, IniSection) -> Parser RawIni
pSections Seq BlankLine
leading Seq (NormalizedText, IniSection)
prevs =
Seq BlankLine -> Seq (NormalizedText, IniSection) -> Parser RawIni
pSection Seq BlankLine
leading Seq (NormalizedText, IniSection)
prevs forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Seq (NormalizedText, IniSection) -> RawIni
RawIni Seq (NormalizedText, IniSection)
prevs forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (f :: * -> *) a. Functor f => f a -> f ()
void forall e s (m :: * -> *). MonadParsec e s m => m ()
eof)
pSection :: Seq BlankLine -> Seq (NormalizedText, IniSection) -> Parser RawIni
pSection :: Seq BlankLine -> Seq (NormalizedText, IniSection) -> Parser RawIni
pSection Seq BlankLine
leading Seq (NormalizedText, IniSection)
prevs = do
Int
start <- Parser Int
getCurrentLine
forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'[')
Text
name <- String -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf String
"[]")
forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
']')
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
eol
Seq BlankLine
comments <- Parser (Seq BlankLine)
sBlanks
Text
-> Int
-> Seq BlankLine
-> Seq (NormalizedText, IniSection)
-> Seq BlankLine
-> Seq (NormalizedText, IniValue)
-> Parser RawIni
pPairs (Text -> Text
T.strip Text
name) Int
start Seq BlankLine
leading Seq (NormalizedText, IniSection)
prevs Seq BlankLine
comments forall a. Seq a
Seq.empty
pPairs ::
Text ->
Int ->
Seq BlankLine ->
Seq (NormalizedText, IniSection) ->
Seq BlankLine ->
Seq (NormalizedText, IniValue) ->
Parser RawIni
pPairs :: Text
-> Int
-> Seq BlankLine
-> Seq (NormalizedText, IniSection)
-> Seq BlankLine
-> Seq (NormalizedText, IniValue)
-> Parser RawIni
pPairs Text
name Int
start Seq BlankLine
leading Seq (NormalizedText, IniSection)
prevs Seq BlankLine
comments Seq (NormalizedText, IniValue)
pairs = Parser RawIni
newPair forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser RawIni
finishedSection
where
newPair :: Parser RawIni
newPair = do
(NormalizedText
n, IniValue
pair) <- Seq BlankLine -> Parser (NormalizedText, IniValue)
pPair Seq BlankLine
comments
Seq BlankLine
rs <- Parser (Seq BlankLine)
sBlanks
Text
-> Int
-> Seq BlankLine
-> Seq (NormalizedText, IniSection)
-> Seq BlankLine
-> Seq (NormalizedText, IniValue)
-> Parser RawIni
pPairs Text
name Int
start Seq BlankLine
leading Seq (NormalizedText, IniSection)
prevs Seq BlankLine
rs (Seq (NormalizedText, IniValue)
pairs forall a. Seq a -> a -> Seq a
Seq.|> (NormalizedText
n, IniValue
pair))
finishedSection :: Parser RawIni
finishedSection = do
Int
end <- Parser Int
getCurrentLine
let newSection :: IniSection
newSection =
IniSection
{ isName :: Text
isName = Text
name,
isVals :: Seq (NormalizedText, IniValue)
isVals = Seq (NormalizedText, IniValue)
pairs,
isStartLine :: Int
isStartLine = Int
start,
isEndLine :: Int
isEndLine = Int
end,
isComments :: Seq BlankLine
isComments = Seq BlankLine
leading
}
Seq BlankLine -> Seq (NormalizedText, IniSection) -> Parser RawIni
pSections Seq BlankLine
comments (Seq (NormalizedText, IniSection)
prevs forall a. Seq a -> a -> Seq a
Seq.|> (Text -> NormalizedText
normalize Text
name, IniSection
newSection))
pPair :: Seq BlankLine -> Parser (NormalizedText, IniValue)
pPair :: Seq BlankLine -> Parser (NormalizedText, IniValue)
pPair Seq BlankLine
leading = do
Int
pos <- Parser Int
getCurrentLine
Text
key <- String -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf String
"[]=:")
Char
delim <- forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf String
":="
Text
val <- String -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
eol
forall (m :: * -> *) a. Monad m => a -> m a
return
( Text -> NormalizedText
normalize Text
key,
IniValue
{ vLineNo :: Int
vLineNo = Int
pos,
vName :: Text
vName = Text
key,
vValue :: Text
vValue = Text
val,
vComments :: Seq BlankLine
vComments = Seq BlankLine
leading,
vCommentedOut :: Bool
vCommentedOut = Bool
False,
vDelimiter :: Char
vDelimiter = Char
delim
}
)
getCurrentLine :: Parser Int
getCurrentLine :: Parser Int
getCurrentLine = (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pos -> Int
unPos forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourcePos -> Pos
sourceLine) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
printRawIni :: RawIni -> Text
printRawIni :: RawIni -> Text
printRawIni = Text -> Text
LazyText.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
Builder.toLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap forall {a}. (a, IniSection) -> Builder
build forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawIni -> Seq (NormalizedText, IniSection)
fromRawIni
where
build :: (a, IniSection) -> Builder
build (a
_, IniSection
ini) =
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap BlankLine -> Builder
buildComment (IniSection -> Seq BlankLine
isComments IniSection
ini)
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
Builder.singleton Char
'['
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
Builder.fromText (IniSection -> Text
isName IniSection
ini)
forall a. Semigroup a => a -> a -> a
<> String -> Builder
Builder.fromString String
"]\n"
forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap forall {a}. (a, IniValue) -> Builder
buildKV (IniSection -> Seq (NormalizedText, IniValue)
isVals IniSection
ini)
buildComment :: BlankLine -> Builder
buildComment BlankLine
BlankLine = Char -> Builder
Builder.singleton Char
'\n'
buildComment (CommentLine Char
c Text
txt) =
Char -> Builder
Builder.singleton Char
c forall a. Semigroup a => a -> a -> a
<> Text -> Builder
Builder.fromText Text
txt forall a. Semigroup a => a -> a -> a
<> Char -> Builder
Builder.singleton Char
'\n'
buildKV :: (a, IniValue) -> Builder
buildKV (a
_, IniValue
val) =
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap BlankLine -> Builder
buildComment (IniValue -> Seq BlankLine
vComments IniValue
val)
forall a. Semigroup a => a -> a -> a
<> (if IniValue -> Bool
vCommentedOut IniValue
val then String -> Builder
Builder.fromString String
"# " else forall a. Monoid a => a
mempty)
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
Builder.fromText (IniValue -> Text
vName IniValue
val)
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
Builder.singleton (IniValue -> Char
vDelimiter IniValue
val)
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
Builder.fromText (IniValue -> Text
vValue IniValue
val)
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
Builder.singleton Char
'\n'
lookupInSection ::
Text ->
Text ->
RawIni ->
Seq.Seq Text
lookupInSection :: Text -> Text -> RawIni -> Seq Text
lookupInSection Text
sec Text
opt RawIni
ini =
IniValue -> Text
vValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
F.asum (Text -> IniSection -> Seq IniValue
lookupValue Text
opt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> RawIni -> Seq IniSection
lookupSection Text
sec RawIni
ini)
lookupSection ::
Text ->
RawIni ->
Seq.Seq IniSection
lookupSection :: Text -> RawIni -> Seq IniSection
lookupSection Text
name RawIni
ini =
forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter ((forall a. Eq a => a -> a -> Bool
== Text -> NormalizedText
normalize Text
name) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) (RawIni -> Seq (NormalizedText, IniSection)
fromRawIni RawIni
ini)
lookupValue ::
Text ->
IniSection ->
Seq.Seq IniValue
lookupValue :: Text -> IniSection -> Seq IniValue
lookupValue Text
name IniSection
section =
forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter ((forall a. Eq a => a -> a -> Bool
== Text -> NormalizedText
normalize Text
name) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) (IniSection -> Seq (NormalizedText, IniValue)
isVals IniSection
section)