{- |

This module provides an INI schema validator that is able to track unused
sections and fields in order to report warning messages to the user.


 -}
module Matterhorn.Config.Schema
  ( IniParser
  , parseIniFile
  , (<!>)

  , Fatal(..)
  , fatalString

  , Warning(..)
  , warningString

  , section
  , sectionMb
  , fieldMbOf
  , fieldMb
  , field
  , fieldDefOf
  , fieldFlagDef

  -- * Re-exports
  , 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