module Matterhorn.Config.Schema
( IniParser
, parseIniFile
, (<!>)
, Fatal(..)
, fatalString
, Warning(..)
, warningString
, section
, sectionMb
, fieldMbOf
, fieldMb
, field
, fieldDefOf
, fieldFlagDef
, number
, string
, listWithSeparator
) where
import Prelude ()
import Matterhorn.Prelude
import Data.Map (Map)
import qualified Data.Map as Map
import Data.List.NonEmpty (NonEmpty)
import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Text as T
import Control.Monad
import Data.Ini.Config (flag, number, listWithSeparator, string)
import Data.Ini.Config.Raw
newtype Parser e t a = Parser { forall e t a.
Parser e t a
-> e
-> Map NormalizedText (NonEmpty t)
-> Either Fatal (Map NormalizedText (NonEmpty t), [Warning], a)
unParser :: e -> Map NormalizedText (NonEmpty t) -> Either Fatal (Map NormalizedText (NonEmpty t), [Warning], a) }
instance Functor (Parser e t) where
fmap :: forall a b. (a -> b) -> Parser e t a -> Parser e t b
fmap = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
instance Applicative (Parser e t) where
pure :: forall a. a -> Parser e t a
pure a
x = forall e t a.
(e
-> Map NormalizedText (NonEmpty t)
-> Either Fatal (Map NormalizedText (NonEmpty t), [Warning], a))
-> Parser e t a
Parser forall a b. (a -> b) -> a -> b
$ \e
_ Map NormalizedText (NonEmpty t)
s -> forall a b. b -> Either a b
Right (Map NormalizedText (NonEmpty t)
s, [], a
x)
<*> :: forall a b. Parser e t (a -> b) -> Parser e t a -> Parser e t b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Monad (Parser e t) where
Parser e t a
m >>= :: forall a b. Parser e t a -> (a -> Parser e t b) -> Parser e t b
>>= a -> Parser e t b
f = forall e t a.
(e
-> Map NormalizedText (NonEmpty t)
-> Either Fatal (Map NormalizedText (NonEmpty t), [Warning], a))
-> Parser e t a
Parser forall a b. (a -> b) -> a -> b
$ \e
e Map NormalizedText (NonEmpty t)
s0 ->
do (Map NormalizedText (NonEmpty t)
s1, [Warning]
ws1, a
x1) <- forall e t a.
Parser e t a
-> e
-> Map NormalizedText (NonEmpty t)
-> Either Fatal (Map NormalizedText (NonEmpty t), [Warning], a)
unParser Parser e t a
m e
e Map NormalizedText (NonEmpty t)
s0
(Map NormalizedText (NonEmpty t)
s2, [Warning]
ws2, b
x2) <- forall e t a.
Parser e t a
-> e
-> Map NormalizedText (NonEmpty t)
-> Either Fatal (Map NormalizedText (NonEmpty t), [Warning], a)
unParser (a -> Parser e t b
f a
x1) e
e Map NormalizedText (NonEmpty t)
s1
forall a b. b -> Either a b
Right (Map NormalizedText (NonEmpty t)
s2, [Warning]
ws1forall a. [a] -> [a] -> [a]
++[Warning]
ws2, b
x2)
(<!>) :: Parser e t a -> Parser e t a -> Parser e t a
Parser e t a
p <!> :: forall e t a. Parser e t a -> Parser e t a -> Parser e t a
<!> Parser e t a
q = forall e t a.
(e
-> Map NormalizedText (NonEmpty t)
-> Either Fatal (Map NormalizedText (NonEmpty t), [Warning], a))
-> Parser e t a
Parser forall a b. (a -> b) -> a -> b
$ \e
e Map NormalizedText (NonEmpty t)
s ->
case forall e t a.
Parser e t a
-> e
-> Map NormalizedText (NonEmpty t)
-> Either Fatal (Map NormalizedText (NonEmpty t), [Warning], a)
unParser Parser e t a
p e
e Map NormalizedText (NonEmpty t)
s of
Right (Map NormalizedText (NonEmpty t), [Warning], a)
r -> forall a b. b -> Either a b
Right (Map NormalizedText (NonEmpty t), [Warning], a)
r
Left {} -> forall e t a.
Parser e t a
-> e
-> Map NormalizedText (NonEmpty t)
-> Either Fatal (Map NormalizedText (NonEmpty t), [Warning], a)
unParser Parser e t a
q e
e Map NormalizedText (NonEmpty t)
s
getenv :: Parser e t e
getenv :: forall e t. Parser e t e
getenv = forall e t a.
(e
-> Map NormalizedText (NonEmpty t)
-> Either Fatal (Map NormalizedText (NonEmpty t), [Warning], a))
-> Parser e t a
Parser forall a b. (a -> b) -> a -> b
$ \e
e Map NormalizedText (NonEmpty t)
s -> forall a b. b -> Either a b
Right (Map NormalizedText (NonEmpty t)
s, [], e
e)
request :: Text -> Parser e t (Maybe t)
request :: forall e t. Text -> Parser e t (Maybe t)
request Text
name = forall e t a.
(e
-> Map NormalizedText (NonEmpty t)
-> Either Fatal (Map NormalizedText (NonEmpty t), [Warning], a))
-> Parser e t a
Parser forall a b. (a -> b) -> a -> b
$ \e
_ Map NormalizedText (NonEmpty t)
s ->
let name' :: NormalizedText
name' = Text -> NormalizedText
normalize Text
name in
forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$!
case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup NormalizedText
name' Map NormalizedText (NonEmpty t)
s of
Maybe (NonEmpty t)
Nothing -> (Map NormalizedText (NonEmpty t)
s , [], forall a. Maybe a
Nothing)
Just (t
x NonEmpty.:| [t]
xs) -> (Map NormalizedText (NonEmpty t)
s', [], forall a. a -> Maybe a
Just t
x)
where
s' :: Map NormalizedText (NonEmpty t)
s' = case forall a. [a] -> Maybe (NonEmpty a)
NonEmpty.nonEmpty [t]
xs of
Maybe (NonEmpty t)
Nothing -> forall k a. Ord k => k -> Map k a -> Map k a
Map.delete NormalizedText
name' Map NormalizedText (NonEmpty t)
s
Just NonEmpty t
ne -> forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert NormalizedText
name' NonEmpty t
ne Map NormalizedText (NonEmpty t)
s
fatal :: Fatal -> Parser e t a
fatal :: forall e t a. Fatal -> Parser e t a
fatal Fatal
e = forall e t a.
(e
-> Map NormalizedText (NonEmpty t)
-> Either Fatal (Map NormalizedText (NonEmpty t), [Warning], a))
-> Parser e t a
Parser forall a b. (a -> b) -> a -> b
$ \e
_ Map NormalizedText (NonEmpty t)
_ -> forall a b. a -> Either a b
Left Fatal
e
warnings :: [Warning] -> IniParser ()
warnings :: [Warning] -> IniParser ()
warnings [Warning]
ws = forall e t a.
(e
-> Map NormalizedText (NonEmpty t)
-> Either Fatal (Map NormalizedText (NonEmpty t), [Warning], a))
-> Parser e t a
Parser forall a b. (a -> b) -> a -> b
$ \RawIni
_ Map NormalizedText (NonEmpty IniSection)
s -> forall a b. b -> Either a b
Right (Map NormalizedText (NonEmpty IniSection)
s, [Warning]
ws, ())
type IniParser = Parser RawIni IniSection
type SectionParser = Parser IniSection IniValue
data Fatal
= NoSection Text
| MissingField IniSection Text
| BadField IniSection IniValue String
| ParseError String
deriving Int -> Fatal -> ShowS
[Fatal] -> ShowS
Fatal -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Fatal] -> ShowS
$cshowList :: [Fatal] -> ShowS
show :: Fatal -> [Char]
$cshow :: Fatal -> [Char]
showsPrec :: Int -> Fatal -> ShowS
$cshowsPrec :: Int -> Fatal -> ShowS
Show
data Warning
= UnusedSection IniSection
| UnusedField IniSection IniValue
deriving Int -> Warning -> ShowS
[Warning] -> ShowS
Warning -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Warning] -> ShowS
$cshowList :: [Warning] -> ShowS
show :: Warning -> [Char]
$cshow :: Warning -> [Char]
showsPrec :: Int -> Warning -> ShowS
$cshowsPrec :: Int -> Warning -> ShowS
Show
fatalString :: Fatal -> String
fatalString :: Fatal -> [Char]
fatalString (NoSection Text
name) = [Char]
"No top-level section named " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Text
name
fatalString (MissingField IniSection
sec Text
name) = [Char]
"Missing field " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Text
name forall a. [a] -> [a] -> [a]
++ [Char]
" in section " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (IniSection -> Text
isName IniSection
sec)
fatalString (BadField IniSection
sec IniValue
val [Char]
err) =
[Char]
"Line " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (IniValue -> Int
vLineNo IniValue
val) forall a. [a] -> [a] -> [a]
++
[Char]
" in section " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (IniSection -> Text
isName IniSection
sec) forall a. [a] -> [a] -> [a]
++
[Char]
": " forall a. [a] -> [a] -> [a]
++ [Char]
err
fatalString (ParseError [Char]
err) = [Char]
err
warningString :: Warning -> String
warningString :: Warning -> [Char]
warningString (UnusedSection IniSection
sec) = [Char]
"Unused section " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (IniSection -> Text
isName IniSection
sec)
warningString (UnusedField IniSection
sec IniValue
val) =
[Char]
"Line " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (IniValue -> Int
vLineNo IniValue
val) forall a. [a] -> [a] -> [a]
++
[Char]
" in section " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (IniSection -> Text
isName IniSection
sec) forall a. [a] -> [a] -> [a]
++
[Char]
": unused field"
parseIniFile :: Text -> IniParser a -> Either Fatal ([Warning], a)
parseIniFile :: forall a. Text -> IniParser a -> Either Fatal ([Warning], a)
parseIniFile Text
text IniParser a
parser =
case Text -> Either [Char] RawIni
parseRawIni Text
text of
Left [Char]
e -> forall a b. a -> Either a b
Left ([Char] -> Fatal
ParseError [Char]
e)
Right RawIni
ini ->
let entries :: Map NormalizedText (NonEmpty IniSection)
entries = forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith forall a. Semigroup a => a -> a -> a
(<>)
[ (NormalizedText
k, forall (f :: * -> *) a. Applicative f => a -> f a
pure IniSection
v) | (NormalizedText
k,IniSection
v) <- forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (RawIni -> Seq (NormalizedText, IniSection)
fromRawIni RawIni
ini) ]
in
case forall e t a.
Parser e t a
-> e
-> Map NormalizedText (NonEmpty t)
-> Either Fatal (Map NormalizedText (NonEmpty t), [Warning], a)
unParser IniParser a
parser RawIni
ini Map NormalizedText (NonEmpty IniSection)
entries of
Left Fatal
e -> forall a b. a -> Either a b
Left Fatal
e
Right (Map NormalizedText (NonEmpty IniSection)
entries', [Warning]
ws, a
x) -> forall a b. b -> Either a b
Right ([Warning]
ws forall a. [a] -> [a] -> [a]
++ [Warning]
unused, a
x)
where
unused :: [Warning]
unused = [ IniSection -> Warning
UnusedSection IniSection
e | IniSection
e <- forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Map NormalizedText (NonEmpty IniSection)
entries' ]
section :: Text -> SectionParser a -> IniParser a
section :: forall a. Text -> SectionParser a -> IniParser a
section Text
name SectionParser a
parser =
do Maybe a
mb <- forall a. Text -> SectionParser a -> IniParser (Maybe a)
sectionMb Text
name SectionParser a
parser
case Maybe a
mb of
Maybe a
Nothing -> forall e t a. Fatal -> Parser e t a
fatal (Text -> Fatal
NoSection Text
name)
Just a
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
sectionMb :: Text -> SectionParser a -> IniParser (Maybe a)
sectionMb :: forall a. Text -> SectionParser a -> IniParser (Maybe a)
sectionMb Text
name SectionParser a
parser =
do Maybe IniSection
mb <- forall e t. Text -> Parser e t (Maybe t)
request Text
name
case Maybe IniSection
mb of
Maybe IniSection
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
Just IniSection
sec ->
let entries :: Map NormalizedText (NonEmpty IniValue)
entries = forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith forall a. Semigroup a => a -> a -> a
(<>)
[ (NormalizedText
k, forall (f :: * -> *) a. Applicative f => a -> f a
pure IniValue
v) | (NormalizedText
k,IniValue
v) <- forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (IniSection -> Seq (NormalizedText, IniValue)
isVals IniSection
sec) ]
in
case forall e t a.
Parser e t a
-> e
-> Map NormalizedText (NonEmpty t)
-> Either Fatal (Map NormalizedText (NonEmpty t), [Warning], a)
unParser SectionParser a
parser IniSection
sec Map NormalizedText (NonEmpty IniValue)
entries of
Left Fatal
e -> forall e t a. Fatal -> Parser e t a
fatal Fatal
e
Right (Map NormalizedText (NonEmpty IniValue)
entries', [Warning]
ws, a
result) ->
do [Warning] -> IniParser ()
warnings ([Warning]
ws forall a. [a] -> [a] -> [a]
++ [ IniSection -> IniValue -> Warning
UnusedField IniSection
sec IniValue
v | IniValue
v <- forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Map NormalizedText (NonEmpty IniValue)
entries' ])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just a
result)
field :: Text -> SectionParser Text
field :: Text -> SectionParser Text
field Text
name =
do Maybe Text
mb <- Text -> SectionParser (Maybe Text)
fieldMb Text
name
case Maybe Text
mb of
Just Text
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
x
Maybe Text
Nothing ->
do IniSection
s <- forall e t. Parser e t e
getenv
forall e t a. Fatal -> Parser e t a
fatal (IniSection -> Text -> Fatal
MissingField IniSection
s Text
name)
fieldMbOf :: Text -> (Text -> Either String a) -> SectionParser (Maybe a)
fieldMbOf :: forall a.
Text -> (Text -> Either [Char] a) -> SectionParser (Maybe a)
fieldMbOf Text
name Text -> Either [Char] a
validate =
do Maybe IniValue
mb <- forall e t. Text -> Parser e t (Maybe t)
request Text
name
case Maybe IniValue
mb of
Maybe IniValue
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
Just IniValue
val ->
case Text -> Either [Char] a
validate (IniValue -> Text
getVal IniValue
val) of
Left [Char]
e ->
do IniSection
sec <- forall e t. Parser e t e
getenv
forall e t a. Fatal -> Parser e t a
fatal (IniSection -> IniValue -> [Char] -> Fatal
BadField IniSection
sec IniValue
val [Char]
e)
Right a
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just a
x)
fieldMb :: Text -> SectionParser (Maybe Text)
fieldMb :: Text -> SectionParser (Maybe Text)
fieldMb Text
name = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IniValue -> Text
getVal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e t. Text -> Parser e t (Maybe t)
request Text
name
fieldDefOf :: Text -> (Text -> Either String a) -> a -> SectionParser a
fieldDefOf :: forall a. Text -> (Text -> Either [Char] a) -> a -> SectionParser a
fieldDefOf Text
name Text -> Either [Char] a
validate a
def = forall a. a -> Maybe a -> a
fromMaybe a
def forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
Text -> (Text -> Either [Char] a) -> SectionParser (Maybe a)
fieldMbOf Text
name Text -> Either [Char] a
validate
fieldFlagDef :: Text -> Bool -> SectionParser Bool
fieldFlagDef :: Text -> Bool -> SectionParser Bool
fieldFlagDef Text
name Bool
def = forall a. Text -> (Text -> Either [Char] a) -> a -> SectionParser a
fieldDefOf Text
name Text -> Either [Char] Bool
flag Bool
def
getVal :: IniValue -> Text
getVal :: IniValue -> Text
getVal = Text -> Text
T.strip forall b c a. (b -> c) -> (a -> b) -> a -> c
. IniValue -> Text
vValue