{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- |
-- Module     : Data.Ini.Config
-- Copyright  : (c) Getty Ritter, 2017
-- License    : BSD
-- Maintainer : Getty Ritter <config-ini@infinitenegativeutility.com>
-- Stability  : experimental
--
-- The 'config-ini' library exports some simple monadic functions to
-- make parsing INI-like configuration easier. INI files have a
-- two-level structure: the top-level named chunks of configuration,
-- and the individual key-value pairs contained within those chunks.
-- For example, the following INI file has two sections, @NETWORK@
-- and @LOCAL@, and each contains its own key-value pairs. Comments,
-- which begin with @#@ or @;@, are ignored:
--
-- > [NETWORK]
-- > host = example.com
-- > port = 7878
-- >
-- > # here is a comment
-- > [LOCAL]
-- > user = terry
--
-- The combinators provided here are designed to write quick and
-- idiomatic parsers for files of this form. Sections are parsed by
-- 'IniParser' computations, like 'section' and its variations,
-- while the fields within sections are parsed by 'SectionParser'
-- computations, like 'field' and its variations. If we want to
-- parse an INI file like the one above, treating the entire
-- @LOCAL@ section as optional, we can write it like this:
--
-- > data Config = Config
-- >   { cfNetwork :: NetworkConfig, cfLocal :: Maybe LocalConfig }
-- >     deriving (Eq, Show)
-- >
-- > data NetworkConfig = NetworkConfig
-- >   { netHost :: String, netPort :: Int }
-- >     deriving (Eq, Show)
-- >
-- > data LocalConfig = LocalConfig
-- >   { localUser :: Text }
-- >     deriving (Eq, Show)
-- >
-- > configParser :: IniParser Config
-- > configParser = do
-- >   netCf <- section "NETWORK" $ do
-- >     host <- fieldOf "host" string
-- >     port <- fieldOf "port" number
-- >     return NetworkConfig { netHost = host, netPort = port }
-- >   locCf <- sectionMb "LOCAL" $
-- >     LocalConfig <$> field "user"
-- >   return Config { cfNetwork = netCf, cfLocal = locCf }
--
--
-- We can run our computation with 'parseIniFile', which,
-- when run on our example file above, would produce the
-- following:
--
-- >>> parseIniFile example configParser
-- Right (Config {cfNetwork = NetworkConfig {netHost = "example.com", netPort = 7878}, cfLocal = Just (LocalConfig {localUser = "terry"})})
module Data.Ini.Config
  ( -- * Parsing Files
    parseIniFile,

    -- * Parser Types
    IniParser,
    SectionParser,

    -- * Section-Level Parsing
    section,
    sections,
    sectionOf,
    sectionsOf,
    sectionMb,
    sectionDef,

    -- * Field-Level Parsing
    field,
    fieldOf,
    fieldMb,
    fieldMbOf,
    fieldDef,
    fieldDefOf,
    fieldFlag,
    fieldFlagDef,

    -- * Reader Functions
    readable,
    number,
    string,
    flag,
    listWithSeparator,
  )
where

import Control.Applicative (Alternative (..))
import Control.Monad.Trans.Except
import Data.Ini.Config.Raw
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import Data.String (IsString (..))
import Data.Text (Text)
import qualified Data.Text as T
import Data.Typeable (Proxy (..), Typeable, typeRep)
import GHC.Exts (IsList (..))
import Text.Read (readMaybe)

lkp :: NormalizedText -> Seq (NormalizedText, a) -> Maybe a
lkp :: forall a. NormalizedText -> Seq (NormalizedText, a) -> Maybe a
lkp NormalizedText
t = forall {a}. ViewL (NormalizedText, a) -> Maybe a
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Seq a -> ViewL a
Seq.viewl
  where
    go :: ViewL (NormalizedText, a) -> Maybe a
go ((NormalizedText
t', a
x) Seq.:< Seq (NormalizedText, a)
rs)
      | NormalizedText
t forall a. Eq a => a -> a -> Bool
== NormalizedText
t' = forall a. a -> Maybe a
Just a
x
      | Bool
otherwise = ViewL (NormalizedText, a) -> Maybe a
go (forall a. Seq a -> ViewL a
Seq.viewl Seq (NormalizedText, a)
rs)
    go ViewL (NormalizedText, a)
Seq.EmptyL = forall a. Maybe a
Nothing

addLineInformation :: Int -> Text -> StParser s a -> StParser s a
addLineInformation :: forall s a. Int -> Text -> StParser s a -> StParser s a
addLineInformation Int
lineNo Text
sec = forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT [Char] -> [Char]
go
  where
    go :: [Char] -> [Char]
go [Char]
e =
      [Char]
"Line " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
lineNo
        forall a. [a] -> [a] -> [a]
++ [Char]
", in section "
        forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Text
sec
        forall a. [a] -> [a] -> [a]
++ [Char]
": "
        forall a. [a] -> [a] -> [a]
++ [Char]
e

type StParser s a = ExceptT String ((->) s) a

-- | An 'IniParser' value represents a computation for parsing entire
--   INI-format files.
newtype IniParser a = IniParser (StParser RawIni a)
  deriving (forall a b. a -> IniParser b -> IniParser a
forall a b. (a -> b) -> IniParser a -> IniParser b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> IniParser b -> IniParser a
$c<$ :: forall a b. a -> IniParser b -> IniParser a
fmap :: forall a b. (a -> b) -> IniParser a -> IniParser b
$cfmap :: forall a b. (a -> b) -> IniParser a -> IniParser b
Functor, Functor IniParser
forall a. a -> IniParser a
forall a b. IniParser a -> IniParser b -> IniParser a
forall a b. IniParser a -> IniParser b -> IniParser b
forall a b. IniParser (a -> b) -> IniParser a -> IniParser b
forall a b c.
(a -> b -> c) -> IniParser a -> IniParser b -> IniParser 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
<* :: forall a b. IniParser a -> IniParser b -> IniParser a
$c<* :: forall a b. IniParser a -> IniParser b -> IniParser a
*> :: forall a b. IniParser a -> IniParser b -> IniParser b
$c*> :: forall a b. IniParser a -> IniParser b -> IniParser b
liftA2 :: forall a b c.
(a -> b -> c) -> IniParser a -> IniParser b -> IniParser c
$cliftA2 :: forall a b c.
(a -> b -> c) -> IniParser a -> IniParser b -> IniParser c
<*> :: forall a b. IniParser (a -> b) -> IniParser a -> IniParser b
$c<*> :: forall a b. IniParser (a -> b) -> IniParser a -> IniParser b
pure :: forall a. a -> IniParser a
$cpure :: forall a. a -> IniParser a
Applicative, Applicative IniParser
forall a. IniParser a
forall a. IniParser a -> IniParser [a]
forall a. IniParser a -> IniParser a -> IniParser a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
many :: forall a. IniParser a -> IniParser [a]
$cmany :: forall a. IniParser a -> IniParser [a]
some :: forall a. IniParser a -> IniParser [a]
$csome :: forall a. IniParser a -> IniParser [a]
<|> :: forall a. IniParser a -> IniParser a -> IniParser a
$c<|> :: forall a. IniParser a -> IniParser a -> IniParser a
empty :: forall a. IniParser a
$cempty :: forall a. IniParser a
Alternative, Applicative IniParser
forall a. a -> IniParser a
forall a b. IniParser a -> IniParser b -> IniParser b
forall a b. IniParser a -> (a -> IniParser b) -> IniParser 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 :: forall a. a -> IniParser a
$creturn :: forall a. a -> IniParser a
>> :: forall a b. IniParser a -> IniParser b -> IniParser b
$c>> :: forall a b. IniParser a -> IniParser b -> IniParser b
>>= :: forall a b. IniParser a -> (a -> IniParser b) -> IniParser b
$c>>= :: forall a b. IniParser a -> (a -> IniParser b) -> IniParser b
Monad)

-- | A 'SectionParser' value represents a computation for parsing a single
--   section of an INI-format file.
newtype SectionParser a = SectionParser (StParser IniSection a)
  deriving (forall a b. a -> SectionParser b -> SectionParser a
forall a b. (a -> b) -> SectionParser a -> SectionParser b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> SectionParser b -> SectionParser a
$c<$ :: forall a b. a -> SectionParser b -> SectionParser a
fmap :: forall a b. (a -> b) -> SectionParser a -> SectionParser b
$cfmap :: forall a b. (a -> b) -> SectionParser a -> SectionParser b
Functor, Functor SectionParser
forall a. a -> SectionParser a
forall a b. SectionParser a -> SectionParser b -> SectionParser a
forall a b. SectionParser a -> SectionParser b -> SectionParser b
forall a b.
SectionParser (a -> b) -> SectionParser a -> SectionParser b
forall a b c.
(a -> b -> c)
-> SectionParser a -> SectionParser b -> SectionParser 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
<* :: forall a b. SectionParser a -> SectionParser b -> SectionParser a
$c<* :: forall a b. SectionParser a -> SectionParser b -> SectionParser a
*> :: forall a b. SectionParser a -> SectionParser b -> SectionParser b
$c*> :: forall a b. SectionParser a -> SectionParser b -> SectionParser b
liftA2 :: forall a b c.
(a -> b -> c)
-> SectionParser a -> SectionParser b -> SectionParser c
$cliftA2 :: forall a b c.
(a -> b -> c)
-> SectionParser a -> SectionParser b -> SectionParser c
<*> :: forall a b.
SectionParser (a -> b) -> SectionParser a -> SectionParser b
$c<*> :: forall a b.
SectionParser (a -> b) -> SectionParser a -> SectionParser b
pure :: forall a. a -> SectionParser a
$cpure :: forall a. a -> SectionParser a
Applicative, Applicative SectionParser
forall a. SectionParser a
forall a. SectionParser a -> SectionParser [a]
forall a. SectionParser a -> SectionParser a -> SectionParser a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
many :: forall a. SectionParser a -> SectionParser [a]
$cmany :: forall a. SectionParser a -> SectionParser [a]
some :: forall a. SectionParser a -> SectionParser [a]
$csome :: forall a. SectionParser a -> SectionParser [a]
<|> :: forall a. SectionParser a -> SectionParser a -> SectionParser a
$c<|> :: forall a. SectionParser a -> SectionParser a -> SectionParser a
empty :: forall a. SectionParser a
$cempty :: forall a. SectionParser a
Alternative, Applicative SectionParser
forall a. a -> SectionParser a
forall a b. SectionParser a -> SectionParser b -> SectionParser b
forall a b.
SectionParser a -> (a -> SectionParser b) -> SectionParser 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 :: forall a. a -> SectionParser a
$creturn :: forall a. a -> SectionParser a
>> :: forall a b. SectionParser a -> SectionParser b -> SectionParser b
$c>> :: forall a b. SectionParser a -> SectionParser b -> SectionParser b
>>= :: forall a b.
SectionParser a -> (a -> SectionParser b) -> SectionParser b
$c>>= :: forall a b.
SectionParser a -> (a -> SectionParser b) -> SectionParser b
Monad)

-- | Parse a 'Text' value as an INI file and run an 'IniParser' over it
parseIniFile :: Text -> IniParser a -> Either String a
parseIniFile :: forall a. Text -> IniParser a -> Either [Char] a
parseIniFile Text
text (IniParser StParser RawIni a
mote) = do
  RawIni
ini <- Text -> Either [Char] RawIni
parseRawIni Text
text
  forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT StParser RawIni a
mote RawIni
ini

-- | Find a named section in the INI file and parse it with the provided
--   section parser, failing if the section does not exist. In order to
--   support classic INI files with capitalized section names, section
--   lookup is __case-insensitive__.
--
--   >>> parseIniFile "[ONE]\nx = hello\n" $ section "ONE" (field "x")
--   Right "hello"
--   >>> parseIniFile "[ONE]\nx = hello\n" $ section "TWO" (field "x")
--   Left "No top-level section named \"TWO\""
section :: Text -> SectionParser a -> IniParser a
section :: forall a. Text -> SectionParser a -> IniParser a
section Text
name (SectionParser StParser IniSection a
thunk) = forall a. StParser RawIni a -> IniParser a
IniParser forall a b. (a -> b) -> a -> b
$
  forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ \(RawIni Seq (NormalizedText, IniSection)
ini) ->
    case forall a. NormalizedText -> Seq (NormalizedText, a) -> Maybe a
lkp (Text -> NormalizedText
normalize Text
name) Seq (NormalizedText, IniSection)
ini of
      Maybe IniSection
Nothing -> forall a b. a -> Either a b
Left ([Char]
"No top-level section named " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Text
name)
      Just IniSection
sec -> forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT StParser IniSection a
thunk IniSection
sec

-- | Find multiple named sections in the INI file and parse them all
--   with the provided section parser. In order to support classic INI
--   files with capitalized section names, section lookup is
--   __case-insensitive__.
--
--   >>> parseIniFile "[ONE]\nx = hello\n[ONE]\nx = goodbye\n" $ sections "ONE" (field "x")
--   Right (fromList ["hello","goodbye"])
--   >>> parseIniFile "[ONE]\nx = hello\n" $ sections "TWO" (field "x")
--   Right (fromList [])
sections :: Text -> SectionParser a -> IniParser (Seq a)
sections :: forall a. Text -> SectionParser a -> IniParser (Seq a)
sections Text
name (SectionParser StParser IniSection a
thunk) = forall a. StParser RawIni a -> IniParser a
IniParser forall a b. (a -> b) -> a -> b
$
  forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ \(RawIni Seq (NormalizedText, IniSection)
ini) ->
    let name' :: NormalizedText
name' = Text -> NormalizedText
normalize Text
name
     in forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
          (forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT StParser IniSection a
thunk forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)
          (forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter (\(NormalizedText
t, IniSection
_) -> NormalizedText
t forall a. Eq a => a -> a -> Bool
== NormalizedText
name') Seq (NormalizedText, IniSection)
ini)

-- | A call to @sectionOf f@ will apply @f@ to each section name and,
--   if @f@ produces a "Just" value, pass the extracted value in order
--   to get the "SectionParser" to use for that section. This will
--   find at most one section, and will produce an error if no section
--   exists.
--
--   >>> parseIniFile "[FOO]\nx = hello\n" $ sectionOf (T.stripSuffix "OO") (\ l -> fmap ((,) l) (field "x"))
--   Right ("F","hello")
--   >>> parseIniFile "[BAR]\nx = hello\n" $ sectionOf (T.stripSuffix "OO") (\ l -> fmap ((,) l) (field "x"))
--   Left "No matching top-level section"
sectionOf :: (Text -> Maybe b) -> (b -> SectionParser a) -> IniParser a
sectionOf :: forall b a.
(Text -> Maybe b) -> (b -> SectionParser a) -> IniParser a
sectionOf Text -> Maybe b
fn b -> SectionParser a
sectionParser = forall a. StParser RawIni a -> IniParser a
IniParser forall a b. (a -> b) -> a -> b
$
  forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ \(RawIni Seq (NormalizedText, IniSection)
ini) ->
    let go :: ViewL (NormalizedText, IniSection) -> Either [Char] a
go ViewL (NormalizedText, IniSection)
Seq.EmptyL = forall a b. a -> Either a b
Left [Char]
"No matching top-level section"
        go ((NormalizedText
t, IniSection
sec) Seq.:< Seq (NormalizedText, IniSection)
rs)
          | Just b
v <- Text -> Maybe b
fn (NormalizedText -> Text
actualText NormalizedText
t) =
            let SectionParser StParser IniSection a
thunk = b -> SectionParser a
sectionParser b
v
             in forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT StParser IniSection a
thunk IniSection
sec
          | Bool
otherwise = ViewL (NormalizedText, IniSection) -> Either [Char] a
go (forall a. Seq a -> ViewL a
Seq.viewl Seq (NormalizedText, IniSection)
rs)
     in ViewL (NormalizedText, IniSection) -> Either [Char] a
go (forall a. Seq a -> ViewL a
Seq.viewl Seq (NormalizedText, IniSection)
ini)

-- | A call to @sectionsOf f@ will apply @f@ to each section name and,
--   if @f@ produces a @Just@ value, pass the extracted value in order
--   to get the "SectionParser" to use for that section. This will
--   return every section for which the call to @f@ produces a "Just"
--   value.
--
--   >>> parseIniFile "[FOO]\nx = hello\n[BOO]\nx = goodbye\n" $ sectionsOf (T.stripSuffix "OO") (\ l -> fmap ((,) l) (field "x"))
--   Right (fromList [("F","hello"),("B","goodbye")])
--   >>> parseIniFile "[BAR]\nx = hello\n" $ sectionsOf (T.stripSuffix "OO") (\ l -> fmap ((,) l) (field "x"))
--   Right (fromList [])
sectionsOf :: (Text -> Maybe b) -> (b -> SectionParser a) -> IniParser (Seq a)
sectionsOf :: forall b a.
(Text -> Maybe b) -> (b -> SectionParser a) -> IniParser (Seq a)
sectionsOf Text -> Maybe b
fn b -> SectionParser a
sectionParser = forall a. StParser RawIni a -> IniParser a
IniParser forall a b. (a -> b) -> a -> b
$
  forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ \(RawIni Seq (NormalizedText, IniSection)
ini) ->
    let go :: ViewL (NormalizedText, IniSection) -> Either [Char] (Seq a)
go ViewL (NormalizedText, IniSection)
Seq.EmptyL = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Seq a
Seq.empty
        go ((NormalizedText
t, IniSection
sec) Seq.:< Seq (NormalizedText, IniSection)
rs)
          | Just b
v <- Text -> Maybe b
fn (NormalizedText -> Text
actualText NormalizedText
t) =
            let SectionParser StParser IniSection a
thunk = b -> SectionParser a
sectionParser b
v
             in do
                  a
x <- forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT StParser IniSection a
thunk IniSection
sec
                  Seq a
xs <- ViewL (NormalizedText, IniSection) -> Either [Char] (Seq a)
go (forall a. Seq a -> ViewL a
Seq.viewl Seq (NormalizedText, IniSection)
rs)
                  forall (m :: * -> *) a. Monad m => a -> m a
return (a
x forall a. a -> Seq a -> Seq a
Seq.<| Seq a
xs)
          | Bool
otherwise = ViewL (NormalizedText, IniSection) -> Either [Char] (Seq a)
go (forall a. Seq a -> ViewL a
Seq.viewl Seq (NormalizedText, IniSection)
rs)
     in ViewL (NormalizedText, IniSection) -> Either [Char] (Seq a)
go (forall a. Seq a -> ViewL a
Seq.viewl Seq (NormalizedText, IniSection)
ini)

-- | Find a named section in the INI file and parse it with the provided
--   section parser, returning 'Nothing' if the section does not exist.
--   In order to
--   support classic INI files with capitalized section names, section
--   lookup is __case-insensitive__.
--
--   >>> parseIniFile "[ONE]\nx = hello\n" $ sectionMb "ONE" (field "x")
--   Right (Just "hello")
--   >>> parseIniFile "[ONE]\nx = hello\n" $ sectionMb "TWO" (field "x")
--   Right Nothing
sectionMb :: Text -> SectionParser a -> IniParser (Maybe a)
sectionMb :: forall a. Text -> SectionParser a -> IniParser (Maybe a)
sectionMb Text
name (SectionParser StParser IniSection a
thunk) = forall a. StParser RawIni a -> IniParser a
IniParser forall a b. (a -> b) -> a -> b
$
  forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ \(RawIni Seq (NormalizedText, IniSection)
ini) ->
    case forall a. NormalizedText -> Seq (NormalizedText, a) -> Maybe a
lkp (Text -> NormalizedText
normalize Text
name) Seq (NormalizedText, IniSection)
ini of
      Maybe IniSection
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
      Just IniSection
sec -> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT StParser IniSection a
thunk IniSection
sec

-- | Find a named section in the INI file and parse it with the provided
--   section parser, returning a default value if the section does not exist.
--   In order to
--   support classic INI files with capitalized section names, section
--   lookup is __case-insensitive__.
--
--   >>> parseIniFile "[ONE]\nx = hello\n" $ sectionDef "ONE" "def" (field "x")
--   Right "hello"
--   >>> parseIniFile "[ONE]\nx = hello\n" $ sectionDef "TWO" "def" (field "x")
--   Right "def"
sectionDef :: Text -> a -> SectionParser a -> IniParser a
sectionDef :: forall a. Text -> a -> SectionParser a -> IniParser a
sectionDef Text
name a
def (SectionParser StParser IniSection a
thunk) = forall a. StParser RawIni a -> IniParser a
IniParser forall a b. (a -> b) -> a -> b
$
  forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ \(RawIni Seq (NormalizedText, IniSection)
ini) ->
    case forall a. NormalizedText -> Seq (NormalizedText, a) -> Maybe a
lkp (Text -> NormalizedText
normalize Text
name) Seq (NormalizedText, IniSection)
ini of
      Maybe IniSection
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return a
def
      Just IniSection
sec -> forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT StParser IniSection a
thunk IniSection
sec

---

throw :: String -> StParser s a
throw :: forall s a. [Char] -> StParser s a
throw [Char]
msg = forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (\s
_ -> forall a b. a -> Either a b
Left [Char]
msg)

getSectionName :: StParser IniSection Text
getSectionName :: StParser IniSection Text
getSectionName = forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. IniSection -> Text
isName)

rawFieldMb :: Text -> StParser IniSection (Maybe IniValue)
rawFieldMb :: Text -> StParser IniSection (Maybe IniValue)
rawFieldMb Text
name = forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ \IniSection
m ->
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. NormalizedText -> Seq (NormalizedText, a) -> Maybe a
lkp (Text -> NormalizedText
normalize Text
name) (IniSection -> Seq (NormalizedText, IniValue)
isVals IniSection
m))

rawField :: Text -> StParser IniSection IniValue
rawField :: Text -> StParser IniSection IniValue
rawField Text
name = do
  Text
sec <- StParser IniSection Text
getSectionName
  Maybe IniValue
valMb <- Text -> StParser IniSection (Maybe IniValue)
rawFieldMb Text
name
  case Maybe IniValue
valMb of
    Maybe IniValue
Nothing ->
      forall s a. [Char] -> StParser s a
throw
        ( [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 Text
sec
        )
    Just IniValue
x -> forall (m :: * -> *) a. Monad m => a -> m a
return IniValue
x

getVal :: IniValue -> Text
getVal :: IniValue -> Text
getVal = Text -> Text
T.strip forall b c a. (b -> c) -> (a -> b) -> a -> c
. IniValue -> Text
vValue

-- | Retrieve a field, failing if it doesn't exist, and return its raw value.
--
--   >>> parseIniFile "[MAIN]\nx = hello\n" $ section "MAIN" (field "x")
--   Right "hello"
--   >>> parseIniFile "[MAIN]\nx = hello\n" $ section "MAIN" (field "y")
--   Left "Missing field \"y\" in section \"MAIN\""
field :: Text -> SectionParser Text
field :: Text -> SectionParser Text
field Text
name = forall a. StParser IniSection a -> SectionParser a
SectionParser forall a b. (a -> b) -> a -> b
$ IniValue -> Text
getVal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Text -> StParser IniSection IniValue
rawField Text
name

-- | Retrieve a field and use the supplied parser to parse it as a value,
--   failing if the field does not exist, or if the parser fails to
--   produce a value.
--
--   >>> parseIniFile "[MAIN]\nx = 72\n" $ section "MAIN" (fieldOf "x" number)
--   Right 72
--   >>> parseIniFile "[MAIN]\nx = hello\n" $ section "MAIN" (fieldOf "x" number)
--   Left "Line 2, in section \"MAIN\": Unable to parse \"hello\" as a value of type Integer"
--   >>> parseIniFile "[MAIN]\nx = 72\n" $ section "MAIN" (fieldOf "y" number)
--   Left "Missing field \"y\" in section \"MAIN\""
fieldOf :: Text -> (Text -> Either String a) -> SectionParser a
fieldOf :: forall a. Text -> (Text -> Either [Char] a) -> SectionParser a
fieldOf Text
name Text -> Either [Char] a
parse = forall a. StParser IniSection a -> SectionParser a
SectionParser forall a b. (a -> b) -> a -> b
$ do
  Text
sec <- StParser IniSection Text
getSectionName
  IniValue
val <- Text -> StParser IniSection IniValue
rawField Text
name
  case Text -> Either [Char] a
parse (IniValue -> Text
getVal IniValue
val) of
    Left [Char]
err -> forall s a. Int -> Text -> StParser s a -> StParser s a
addLineInformation (IniValue -> Int
vLineNo IniValue
val) Text
sec (forall s a. [Char] -> StParser s a
throw [Char]
err)
    Right a
x -> forall (m :: * -> *) a. Monad m => a -> m a
return a
x

-- | Retrieve a field, returning a @Nothing@ value if it does not exist.
--
--   >>> parseIniFile "[MAIN]\nx = hello\n" $ section "MAIN" (fieldMb "x")
--   Right (Just "hello")
--   >>> parseIniFile "[MAIN]\nx = hello\n" $ section "MAIN" (fieldMb "y")
--   Right Nothing
fieldMb :: Text -> SectionParser (Maybe Text)
fieldMb :: Text -> SectionParser (Maybe Text)
fieldMb Text
name = forall a. StParser IniSection a -> SectionParser a
SectionParser forall a b. (a -> b) -> a -> b
$ 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
`fmap` Text -> StParser IniSection (Maybe IniValue)
rawFieldMb Text
name

-- | Retrieve a field and parse it according to the given parser, returning
--   @Nothing@ if it does not exist. If the parser fails, then this will
--   fail.
--
--   >>> parseIniFile "[MAIN]\nx = 72\n" $ section "MAIN" (fieldMbOf "x" number)
--   Right (Just 72)
--   >>> parseIniFile "[MAIN]\nx = hello\n" $ section "MAIN" (fieldMbOf "x" number)
--   Left "Line 2, in section \"MAIN\": Unable to parse \"hello\" as a value of type Integer"
--   >>> parseIniFile "[MAIN]\nx = 72\n" $ section "MAIN" (fieldMbOf "y" number)
--   Right Nothing
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
parse = forall a. StParser IniSection a -> SectionParser a
SectionParser forall a b. (a -> b) -> a -> b
$ do
  Text
sec <- StParser IniSection Text
getSectionName
  Maybe IniValue
mb <- Text -> StParser IniSection (Maybe IniValue)
rawFieldMb Text
name
  case Maybe IniValue
mb of
    Maybe IniValue
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    Just IniValue
v -> case Text -> Either [Char] a
parse (IniValue -> Text
getVal IniValue
v) of
      Left [Char]
err -> forall s a. Int -> Text -> StParser s a -> StParser s a
addLineInformation (IniValue -> Int
vLineNo IniValue
v) Text
sec (forall s a. [Char] -> StParser s a
throw [Char]
err)
      Right a
x -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just a
x)

-- | Retrieve a field and supply a default value for if it doesn't exist.
--
--   >>> parseIniFile "[MAIN]\nx = hello\n" $ section "MAIN" (fieldDef "x" "def")
--   Right "hello"
--   >>> parseIniFile "[MAIN]\nx = hello\n" $ section "MAIN" (fieldDef "y" "def")
--   Right "def"
fieldDef :: Text -> Text -> SectionParser Text
fieldDef :: Text -> Text -> SectionParser Text
fieldDef Text
name Text
def = forall a. StParser IniSection a -> SectionParser a
SectionParser forall a b. (a -> b) -> a -> b
$
  forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ \IniSection
m ->
    case forall a. NormalizedText -> Seq (NormalizedText, a) -> Maybe a
lkp (Text -> NormalizedText
normalize Text
name) (IniSection -> Seq (NormalizedText, IniValue)
isVals IniSection
m) of
      Maybe IniValue
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Text
def
      Just IniValue
x -> forall (m :: * -> *) a. Monad m => a -> m a
return (IniValue -> Text
getVal IniValue
x)

-- | Retrieve a field, parsing it according to the given parser, and returning
--   a default value if it does not exist. If the parser fails, then this will
--   fail.
--
--   >>> parseIniFile "[MAIN]\nx = 72\n" $ section "MAIN" (fieldDefOf "x" number 99)
--   Right 72
--   >>> parseIniFile "[MAIN]\nx = hello\n" $ section "MAIN" (fieldDefOf "x" number 99)
--   Left "Line 2, in section \"MAIN\": Unable to parse \"hello\" as a value of type Integer"
--   >>> parseIniFile "[MAIN]\nx = 72\n" $ section "MAIN" (fieldDefOf "y" number 99)
--   Right 99
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
parse a
def = forall a. StParser IniSection a -> SectionParser a
SectionParser forall a b. (a -> b) -> a -> b
$ do
  Text
sec <- StParser IniSection Text
getSectionName
  Maybe IniValue
mb <- Text -> StParser IniSection (Maybe IniValue)
rawFieldMb Text
name
  case Maybe IniValue
mb of
    Maybe IniValue
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return a
def
    Just IniValue
v -> case Text -> Either [Char] a
parse (IniValue -> Text
getVal IniValue
v) of
      Left [Char]
err -> forall s a. Int -> Text -> StParser s a -> StParser s a
addLineInformation (IniValue -> Int
vLineNo IniValue
v) Text
sec (forall s a. [Char] -> StParser s a
throw [Char]
err)
      Right a
x -> forall (m :: * -> *) a. Monad m => a -> m a
return a
x

-- | Retrieve a field and treat it as a boolean, failing if it
--   does not exist.
--
--   >>> parseIniFile "[MAIN]\nx = yes\n" $ section "MAIN" (fieldFlag "x")
--   Right True
--   >>> parseIniFile "[MAIN]\nx = yes\n" $ section "MAIN" (fieldFlag "y")
--   Left "Missing field \"y\" in section \"MAIN\""
fieldFlag :: Text -> SectionParser Bool
fieldFlag :: Text -> SectionParser Bool
fieldFlag Text
name = forall a. Text -> (Text -> Either [Char] a) -> SectionParser a
fieldOf Text
name Text -> Either [Char] Bool
flag

-- | Retrieve a field and treat it as a boolean, subsituting
--   a default value if it doesn't exist.
--
--   >>> parseIniFile "[MAIN]\nx = yes\n" $ section "MAIN" (fieldFlagDef "x" False)
--   Right True
--   >>> parseIniFile "[MAIN]\nx = hello\n" $ section "MAIN" (fieldFlagDef "x" False)
--   Left "Line 2, in section \"MAIN\": Unable to parse \"hello\" as a boolean"
--   >>> parseIniFile "[MAIN]\nx = yes\n" $ section "MAIN" (fieldFlagDef "y" False)
--   Right False
fieldFlagDef :: Text -> Bool -> SectionParser Bool
fieldFlagDef :: Text -> Bool -> SectionParser Bool
fieldFlagDef Text
name = forall a. Text -> (Text -> Either [Char] a) -> a -> SectionParser a
fieldDefOf Text
name Text -> Either [Char] Bool
flag

---

-- | Try to use the "Read" instance for a type to parse a value, failing
--   with a human-readable error message if reading fails.
--
--   >>> readable "(5, 7)" :: Either String (Int, Int)
--   Right (5,7)
--   >>> readable "hello" :: Either String (Int, Int)
--   Left "Unable to parse \"hello\" as a value of type (Int,Int)"
readable :: forall a. (Read a, Typeable a) => Text -> Either String a
readable :: forall a. (Read a, Typeable a) => Text -> Either [Char] a
readable Text
t = case forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
str of
  Just a
v -> forall a b. b -> Either a b
Right a
v
  Maybe a
Nothing ->
    forall a b. a -> Either a b
Left
      ( [Char]
"Unable to parse " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show [Char]
str
          forall a. [a] -> [a] -> [a]
++ [Char]
" as a value of type "
          forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show TypeRep
typ
      )
  where
    str :: [Char]
str = Text -> [Char]
T.unpack Text
t
    typ :: TypeRep
typ = forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy a
prx
    prx :: Proxy a
    prx :: Proxy a
prx = forall {k} (t :: k). Proxy t
Proxy

-- | Try to use the "Read" instance for a numeric type to parse a value,
--   failing with a human-readable error message if reading fails.
--
--   >>> number "5" :: Either String Int
--   Right 5
--   >>> number "hello" :: Either String Int
--   Left "Unable to parse \"hello\" as a value of type Int"
number :: (Num a, Read a, Typeable a) => Text -> Either String a
number :: forall a. (Num a, Read a, Typeable a) => Text -> Either [Char] a
number = forall a. (Read a, Typeable a) => Text -> Either [Char] a
readable

-- | Convert a textual value to the appropriate string type. This will
--   never fail.
--
--   >>> string "foo" :: Either String String
--   Right "foo"
string :: (IsString a) => Text -> Either String a
string :: forall a. IsString a => Text -> Either [Char] a
string = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => [Char] -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack

-- | Convert a string that represents a boolean to a proper boolean. This
--   is case-insensitive, and matches the words @true@, @false@, @yes@,
--   @no@, as well as single-letter abbreviations for all of the above.
--   If the input does not match, then this will fail with a human-readable
--   error message.
--
--   >>> flag "TRUE"
--   Right True
--   >>> flag "y"
--   Right True
--   >>> flag "no"
--   Right False
--   >>> flag "F"
--   Right False
--   >>> flag "That's a secret!"
--   Left "Unable to parse \"That's a secret!\" as a boolean"
flag :: Text -> Either String Bool
flag :: Text -> Either [Char] Bool
flag Text
s = case Text -> Text
T.toLower Text
s of
  Text
"true" -> forall a b. b -> Either a b
Right Bool
True
  Text
"yes" -> forall a b. b -> Either a b
Right Bool
True
  Text
"t" -> forall a b. b -> Either a b
Right Bool
True
  Text
"y" -> forall a b. b -> Either a b
Right Bool
True
  Text
"false" -> forall a b. b -> Either a b
Right Bool
False
  Text
"no" -> forall a b. b -> Either a b
Right Bool
False
  Text
"f" -> forall a b. b -> Either a b
Right Bool
False
  Text
"n" -> forall a b. b -> Either a b
Right Bool
False
  Text
_ -> forall a b. a -> Either a b
Left ([Char]
"Unable to parse " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Text
s forall a. [a] -> [a] -> [a]
++ [Char]
" as a boolean")

-- | Convert a reader for a value into a reader for a list of those
--   values, separated by a chosen separator. This will split apart
--   the string on that separator, get rid of leading and trailing
--   whitespace on the individual chunks, and then attempt to parse
--   each of them according to the function provided, turning the
--   result into a list.
--
--   This is overloaded with the "IsList" typeclass, so it can be
--   used transparently to parse other list-like types.
--
--   >>> listWithSeparator "," number "2, 3, 4" :: Either String [Int]
--   Right [2,3,4]
--   >>> listWithSeparator " " number "7 8 9" :: Either String [Int]
--   Right [7,8,9]
--   >>> listWithSeparator ":" string "/bin:/usr/bin" :: Either String [FilePath]
--   Right ["/bin","/usr/bin"]
--   >>> listWithSeparator "," number "7 8 9" :: Either String [Int]
--   Left "Unable to parse \"7 8 9\" as a value of type Int"
listWithSeparator ::
  (IsList l) =>
  Text ->
  (Text -> Either String (Item l)) ->
  Text ->
  Either String l
listWithSeparator :: forall l.
IsList l =>
Text -> (Text -> Either [Char] (Item l)) -> Text -> Either [Char] l
listWithSeparator Text
sep Text -> Either [Char] (Item l)
rd =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall l. IsList l => [Item l] -> l
fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Text -> Either [Char] (Item l)
rd forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Text]
T.splitOn Text
sep

-- $setup
--
-- >>> :{
-- data NetworkConfig = NetworkConfig
--    { netHost :: String, netPort :: Int }
--     deriving (Eq, Show)
-- >>> :}
--
-- >>> :{
-- data LocalConfig = LocalConfig
--   { localUser :: Text }
--     deriving (Eq, Show)
-- >>> :}
--
-- >>> :{
-- data Config = Config
--   { cfNetwork :: NetworkConfig, cfLocal :: Maybe LocalConfig }
--     deriving (Eq, Show)
-- >>> :}
--
-- >>> :{
-- let configParser = do
--       netCf <- section "NETWORK" $ do
--         host <- fieldOf "host" string
--         port <- fieldOf "port" number
--         return NetworkConfig { netHost = host, netPort = port }
--       locCf <- sectionMb "LOCAL" $
--         LocalConfig <$> field "user"
--       return Config { cfNetwork = netCf, cfLocal = locCf }
-- >>> :}
--
-- >>> :{
--    let example = "[NETWORK]\nhost = example.com\nport = 7878\n\n# here is a comment\n[LOCAL]\nuser = terry\n"
-- >>> :}