{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GADTs, DeriveFunctor, ScopedTypeVariables #-}
{-# LANGUAGE CPP #-}

-- | Applicative config parser.
--
-- This parses config files in the style of optparse-applicative. It supports
-- automatic generation of a default config both as datatype and in printed
-- form.
--
-- Example:
--
-- @
-- data Config = Config
--   { test :: Text
--   , foobar :: Int
--   }
--
-- confParser :: ConfParser Config
-- confParser = Config
--          \<$\> option "test" "default value" "Help for test"
--          \<*\> option "foobar" 42 "Help for foobar"
-- @
--
-- This parses a config file like the following:
--
-- > # This is a comment
-- > test = "something"
-- > foobar = 23
module ConfigParser
       ( OptParser
       , parseConfig
       , parseConfigFile
       , option
       , customOption
       , parserDefault
       , parserExample
       , ConfParseError
       , OParser
       , Option
       , OptionArgument()
       ) where

import           Control.Applicative hiding (many, some)
import           Control.Applicative.Free
import           Control.Monad
import           Data.Functor.Identity
import           Data.Semigroup ((<>))
import qualified Data.List.NonEmpty as NE

import qualified Data.Set as S
-- import           Data.Set (Set)
import           Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import           Text.Megaparsec hiding (option)
import           Text.Megaparsec.Char
import           Data.Maybe
-- import           Text.Megaparsec.Text

-- | Errors that can occur during parsing. Use the 'Show' instance for printing.
data ConfParseError = UnknownOption Text
                    | TypeError Text Text -- Type and Option name
  deriving (ConfParseError -> ConfParseError -> Bool
(ConfParseError -> ConfParseError -> Bool)
-> (ConfParseError -> ConfParseError -> Bool) -> Eq ConfParseError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConfParseError -> ConfParseError -> Bool
$c/= :: ConfParseError -> ConfParseError -> Bool
== :: ConfParseError -> ConfParseError -> Bool
$c== :: ConfParseError -> ConfParseError -> Bool
Eq, Eq ConfParseError
Eq ConfParseError
-> (ConfParseError -> ConfParseError -> Ordering)
-> (ConfParseError -> ConfParseError -> Bool)
-> (ConfParseError -> ConfParseError -> Bool)
-> (ConfParseError -> ConfParseError -> Bool)
-> (ConfParseError -> ConfParseError -> Bool)
-> (ConfParseError -> ConfParseError -> ConfParseError)
-> (ConfParseError -> ConfParseError -> ConfParseError)
-> Ord ConfParseError
ConfParseError -> ConfParseError -> Bool
ConfParseError -> ConfParseError -> Ordering
ConfParseError -> ConfParseError -> ConfParseError
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ConfParseError -> ConfParseError -> ConfParseError
$cmin :: ConfParseError -> ConfParseError -> ConfParseError
max :: ConfParseError -> ConfParseError -> ConfParseError
$cmax :: ConfParseError -> ConfParseError -> ConfParseError
>= :: ConfParseError -> ConfParseError -> Bool
$c>= :: ConfParseError -> ConfParseError -> Bool
> :: ConfParseError -> ConfParseError -> Bool
$c> :: ConfParseError -> ConfParseError -> Bool
<= :: ConfParseError -> ConfParseError -> Bool
$c<= :: ConfParseError -> ConfParseError -> Bool
< :: ConfParseError -> ConfParseError -> Bool
$c< :: ConfParseError -> ConfParseError -> Bool
compare :: ConfParseError -> ConfParseError -> Ordering
$ccompare :: ConfParseError -> ConfParseError -> Ordering
$cp1Ord :: Eq ConfParseError
Ord, Int -> ConfParseError -> ShowS
[ConfParseError] -> ShowS
ConfParseError -> String
(Int -> ConfParseError -> ShowS)
-> (ConfParseError -> String)
-> ([ConfParseError] -> ShowS)
-> Show ConfParseError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConfParseError] -> ShowS
$cshowList :: [ConfParseError] -> ShowS
show :: ConfParseError -> String
$cshow :: ConfParseError -> String
showsPrec :: Int -> ConfParseError -> ShowS
$cshowsPrec :: Int -> ConfParseError -> ShowS
Show)

instance ShowErrorComponent ConfParseError where
  showErrorComponent :: ConfParseError -> String
showErrorComponent (UnknownOption Text
name) = String
"Unknown option " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
name
  showErrorComponent (TypeError Text
typ Text
name) =
    String
"in " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
typ String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" argument for option " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
name

type OParser = Parsec ConfParseError Text

type CustomParseError = ParseErrorBundle Text ConfParseError

-- | Parse a config file from a 'Text'.
parseConfig :: FilePath -- ^ File path to use in error messages
            -> Text -- ^ The input test
            -> OptParser a -- ^ The parser to use
            -> Either CustomParseError a
parseConfig :: String -> Text -> OptParser a -> Either CustomParseError a
parseConfig String
path Text
input OptParser a
parser = case Parsec ConfParseError Text [Assignment]
-> String -> Text -> Either CustomParseError [Assignment]
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse (Parsec ConfParseError Text [Assignment]
assignmentList Parsec ConfParseError Text [Assignment]
-> ParsecT ConfParseError Text Identity ()
-> Parsec ConfParseError Text [Assignment]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT ConfParseError Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) String
path Text
input of
  Left CustomParseError
err -> CustomParseError -> Either CustomParseError a
forall a b. a -> Either a b
Left CustomParseError
err
  Right [Assignment]
res -> [Assignment] -> OptParser a -> Either CustomParseError a
forall a. [Assignment] -> OptParser a -> Either CustomParseError a
runOptionParser [Assignment]
res OptParser a
parser

-- | Parse a config file from an actual file in the filesystem.
parseConfigFile :: FilePath -- ^ Path to the file
                -> OptParser a -- ^ The parser to use
                -> IO (Either CustomParseError a)
parseConfigFile :: String -> OptParser a -> IO (Either CustomParseError a)
parseConfigFile String
path OptParser a
parser = do
  Text
input <- String -> IO Text
T.readFile String
path
  Either CustomParseError a -> IO (Either CustomParseError a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either CustomParseError a -> IO (Either CustomParseError a))
-> Either CustomParseError a -> IO (Either CustomParseError a)
forall a b. (a -> b) -> a -> b
$ String -> Text -> OptParser a -> Either CustomParseError a
forall a.
String -> Text -> OptParser a -> Either CustomParseError a
parseConfig String
path Text
input OptParser a
parser

-- | An option in the config file. Use 'option' as a smart constructor.
data Option a = Option
  { Option a -> OParser a
optParser :: OParser a
  , Option a -> Text
optType :: Text -- Something like "string" or "integer"
  , Option a -> Text
optName :: Text
  , Option a -> Text
optHelp :: Text
  , Option a -> a
optDefault :: a
  , Option a -> Text
optDefaultTxt :: Text -- printed version of optDefault
  } deriving (a -> Option b -> Option a
(a -> b) -> Option a -> Option b
(forall a b. (a -> b) -> Option a -> Option b)
-> (forall a b. a -> Option b -> Option a) -> Functor Option
forall a b. a -> Option b -> Option a
forall a b. (a -> b) -> Option a -> Option b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Option b -> Option a
$c<$ :: forall a b. a -> Option b -> Option a
fmap :: (a -> b) -> Option a -> Option b
$cfmap :: forall a b. (a -> b) -> Option a -> Option b
Functor)

-- | The main parser type. Use 'option' and the 'Applicative' instance to create those.
type OptParser a = Ap Option a

-- | Class for supported option types.
--
-- At the moment, orphan instances are not supported
class OptionArgument a where
  mkParser :: (Text, OParser a)
  printArgument :: a -> Text

-- | 'OptParser' that parses one option.
--
-- Can be combined with the 'Applicative' instance for 'OptParser'. See the
-- module documentation for an example.
option :: OptionArgument a
       => Text -- ^ The option name
       -> a -- ^ The default value
       -> Text
          -- ^ A help string for the option. Will be used by 'parserExample' to
          -- create helpful comments.
       -> OptParser a
option :: Text -> a -> Text -> OptParser a
option Text
name a
def Text
help = Option a -> OptParser a
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Option a -> OptParser a) -> Option a -> OptParser a
forall a b. (a -> b) -> a -> b
$ OParser a -> Text -> Text -> Text -> a -> Text -> Option a
forall a.
OParser a -> Text -> Text -> Text -> a -> Text -> Option a
Option OParser a
parser Text
typename Text
name Text
help a
def (a -> Text
forall a. OptionArgument a => a -> Text
printArgument a
def)
  where (Text
typename, OParser a
parser) = (Text, OParser a)
forall a. OptionArgument a => (Text, OParser a)
mkParser

customOption :: Text -- ^ The option name
             -> a -- ^ The default Value
             -> Text -- ^ A textual representation of the default value
             -> Text -- ^ A help string for the option
             -> Text -- ^ A description of the expected type such sas "string" or "integer"
             -> OParser a -- ^ Parser for the option
             -> OptParser a
customOption :: Text -> a -> Text -> Text -> Text -> OParser a -> OptParser a
customOption Text
optName a
optDefault Text
optDefaultTxt Text
optHelp Text
optType OParser a
optParser = Option a -> OptParser a
forall (f :: * -> *) a. f a -> Ap f a
liftAp (Option a -> OptParser a) -> Option a -> OptParser a
forall a b. (a -> b) -> a -> b
$ Option :: forall a.
OParser a -> Text -> Text -> Text -> a -> Text -> Option a
Option {a
Text
OParser a
optParser :: OParser a
optType :: Text
optHelp :: Text
optDefaultTxt :: Text
optDefault :: a
optName :: Text
optDefaultTxt :: Text
optDefault :: a
optHelp :: Text
optName :: Text
optType :: Text
optParser :: OParser a
..}

instance OptionArgument Int where
  mkParser :: (Text, OParser Int)
mkParser = (Text
"integer", OParser Int
forall a. Read a => OParser a
parseNumber)
  printArgument :: Int -> Text
printArgument = String -> Text
T.pack (String -> Text) -> (Int -> String) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show

instance OptionArgument Integer where
  mkParser :: (Text, OParser Integer)
mkParser = (Text
"integer", OParser Integer
forall a. Read a => OParser a
parseNumber)
  printArgument :: Integer -> Text
printArgument = String -> Text
T.pack (String -> Text) -> (Integer -> String) -> Integer -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String
forall a. Show a => a -> String
show

instance OptionArgument String where
  mkParser :: (Text, OParser String)
mkParser = (Text
"string",  ParsecT ConfParseError Text Identity Char -> OParser String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT ConfParseError Text Identity Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle)
  printArgument :: String -> Text
printArgument = Text -> Text
quote (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

instance OptionArgument Text where
  mkParser :: (Text, OParser Text)
mkParser = (Text
"string",  String -> Text
T.pack (String -> Text) -> OParser String -> OParser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT ConfParseError Text Identity Char -> OParser String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT ConfParseError Text Identity Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle)
  printArgument :: Text -> Text
printArgument = Text -> Text
quote

quote :: Text -> Text
quote :: Text -> Text
quote Text
x = Text
"\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
escape Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""
  where
    escape :: Text -> Text
escape = Text -> Text -> Text -> Text
T.replace Text
"\"" Text
"\\\"" (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> Text
T.replace Text
"\\" Text
"\\\\"

runOptionParser :: [Assignment] -> OptParser a -> Either CustomParseError a
runOptionParser :: [Assignment] -> OptParser a -> Either CustomParseError a
runOptionParser (Assignment
a:[Assignment]
as) OptParser a
parser =  OptParser a -> Assignment -> Either CustomParseError (OptParser a)
forall a.
OptParser a -> Assignment -> Either CustomParseError (OptParser a)
parseOption OptParser a
parser Assignment
a Either CustomParseError (OptParser a)
-> (OptParser a -> Either CustomParseError a)
-> Either CustomParseError a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Assignment] -> OptParser a -> Either CustomParseError a
forall a. [Assignment] -> OptParser a -> Either CustomParseError a
runOptionParser [Assignment]
as
runOptionParser [] OptParser a
parser = a -> Either CustomParseError a
forall a b. b -> Either a b
Right (a -> Either CustomParseError a) -> a -> Either CustomParseError a
forall a b. (a -> b) -> a -> b
$ OptParser a -> a
forall a. OptParser a -> a
parserDefault OptParser a
parser

-- | Returns the default value of a given parser.
--
-- This default value is computed from the default arguments of the 'option'
-- constructor. For the parser from the module description, the default value
-- would be:
--
-- > Config { test = "default value"
-- >        , foobar :: 42
-- >        }
parserDefault :: OptParser a -> a
parserDefault :: OptParser a -> a
parserDefault = Identity a -> a
forall a. Identity a -> a
runIdentity (Identity a -> a)
-> (OptParser a -> Identity a) -> OptParser a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall x. Option x -> Identity x) -> OptParser a -> Identity a
forall (g :: * -> *) (f :: * -> *) a.
Applicative g =>
(forall x. f x -> g x) -> Ap f a -> g a
runAp (x -> Identity x
forall a. a -> Identity a
Identity (x -> Identity x) -> (Option x -> x) -> Option x -> Identity x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Option x -> x
forall a. Option a -> a
optDefault)

-- | Generate the default config file.
--
-- This returns a valid config file, filled with the default values of every
-- option and using the help string of these options as comments.
parserExample :: OptParser a -> Text
parserExample :: OptParser a -> Text
parserExample = Text -> Text
T.strip (Text -> Text) -> (OptParser a -> Text) -> OptParser a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Option a -> Text) -> OptParser a -> Text
forall m (f :: * -> *) b.
Monoid m =>
(forall a. f a -> m) -> Ap f b -> m
runAp_ forall a. Option a -> Text
example1
  where example1 :: Option a -> Text
example1 Option a
a = Text -> Text
commentify (Option a -> Text
forall a. Option a -> Text
optHelp Option a
a) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Option a -> Text
forall a. Option a -> Text
optName Option a
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Option a -> Text
forall a. Option a -> Text
optDefaultTxt Option a
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\n"
        commentify :: Text -> Text
commentify = [Text] -> Text
T.unlines ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text
"# " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines

parseOption :: OptParser a -> Assignment -> Either CustomParseError (OptParser a)
parseOption :: OptParser a -> Assignment -> Either CustomParseError (OptParser a)
parseOption (Pure a
_) Assignment
ass =
  CustomParseError -> Either CustomParseError (OptParser a)
forall a b. a -> Either a b
Left (CustomParseError -> Either CustomParseError (OptParser a))
-> CustomParseError -> Either CustomParseError (OptParser a)
forall a b. (a -> b) -> a -> b
$ SourcePos -> ConfParseError -> CustomParseError
forall e. SourcePos -> e -> ParseErrorBundle Text e
mkCustomError (Assignment -> SourcePos
assignmentPosition Assignment
ass) (Text -> ConfParseError
UnknownOption (Assignment -> Text
assignmentKey Assignment
ass))
parseOption (Ap Option a1
opt Ap Option (a1 -> a)
rest) Assignment
ass
  | Option a1 -> Text
forall a. Option a -> Text
optName Option a1
opt Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Assignment -> Text
assignmentKey Assignment
ass =
    let content :: Text
content = (AssignmentValue -> Text
valueContent (AssignmentValue -> Text) -> AssignmentValue -> Text
forall a b. (a -> b) -> a -> b
$ Assignment -> AssignmentValue
assignmentValue Assignment
ass)
        pos :: SourcePos
pos = (AssignmentValue -> SourcePos
valuePosition (AssignmentValue -> SourcePos) -> AssignmentValue -> SourcePos
forall a b. (a -> b) -> a -> b
$ Assignment -> AssignmentValue
assignmentValue Assignment
ass)
    in case Parsec ConfParseError Text a1
-> SourcePos -> Text -> Either CustomParseError a1
forall s e a.
(Stream s, Ord e) =>
Parsec e s a -> SourcePos -> s -> Either (ParseErrorBundle s e) a
parseWithStart (Option a1 -> Parsec ConfParseError Text a1
forall a. Option a -> OParser a
optParser Option a1
opt Parsec ConfParseError Text a1
-> ParsecT ConfParseError Text Identity ()
-> Parsec ConfParseError Text a1
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT ConfParseError Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) SourcePos
pos Text
content of
         Left CustomParseError
e -> CustomParseError -> Either CustomParseError (OptParser a)
forall a b. a -> Either a b
Left (CustomParseError -> Either CustomParseError (OptParser a))
-> CustomParseError -> Either CustomParseError (OptParser a)
forall a b. (a -> b) -> a -> b
$ CustomParseError -> ConfParseError -> CustomParseError
forall e. ParseErrorBundle Text e -> e -> ParseErrorBundle Text e
addCustomError CustomParseError
e (ConfParseError -> CustomParseError)
-> ConfParseError -> CustomParseError
forall a b. (a -> b) -> a -> b
$ Text -> Text -> ConfParseError
TypeError (Option a1 -> Text
forall a. Option a -> Text
optType Option a1
opt) (Assignment -> Text
assignmentKey Assignment
ass)
         Right a1
res -> OptParser a -> Either CustomParseError (OptParser a)
forall a b. b -> Either a b
Right (OptParser a -> Either CustomParseError (OptParser a))
-> OptParser a -> Either CustomParseError (OptParser a)
forall a b. (a -> b) -> a -> b
$ ((a1 -> a) -> a) -> Ap Option (a1 -> a) -> OptParser a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a1 -> a) -> a1 -> a
forall a b. (a -> b) -> a -> b
$ a1
res) Ap Option (a1 -> a)
rest
  | Bool
otherwise = (Ap Option (a1 -> a) -> OptParser a)
-> Either CustomParseError (Ap Option (a1 -> a))
-> Either CustomParseError (OptParser a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Option a1 -> Ap Option (a1 -> a) -> OptParser a
forall (f :: * -> *) a1 a. f a1 -> Ap f (a1 -> a) -> Ap f a
Ap Option a1
opt) (Either CustomParseError (Ap Option (a1 -> a))
 -> Either CustomParseError (OptParser a))
-> Either CustomParseError (Ap Option (a1 -> a))
-> Either CustomParseError (OptParser a)
forall a b. (a -> b) -> a -> b
$ Ap Option (a1 -> a)
-> Assignment -> Either CustomParseError (Ap Option (a1 -> a))
forall a.
OptParser a -> Assignment -> Either CustomParseError (OptParser a)
parseOption Ap Option (a1 -> a)
rest Assignment
ass

mkCustomError :: SourcePos -> e -> ParseErrorBundle Text e
mkCustomError :: SourcePos -> e -> ParseErrorBundle Text e
mkCustomError SourcePos
pos e
e = ParseErrorBundle :: forall s e.
NonEmpty (ParseError s e) -> PosState s -> ParseErrorBundle s e
ParseErrorBundle
  { bundleErrors :: NonEmpty (ParseError Text e)
bundleErrors = [ParseError Text e] -> NonEmpty (ParseError Text e)
forall a. [a] -> NonEmpty a
NE.fromList [Int -> Set (ErrorFancy e) -> ParseError Text e
forall s e. Int -> Set (ErrorFancy e) -> ParseError s e
FancyError Int
0 (ErrorFancy e -> Set (ErrorFancy e)
forall a. a -> Set a
S.singleton (e -> ErrorFancy e
forall e. e -> ErrorFancy e
ErrorCustom e
e))]
  , bundlePosState :: PosState Text
bundlePosState = PosState :: forall s. s -> Int -> SourcePos -> Pos -> String -> PosState s
PosState
    { pstateInput :: Text
pstateInput = Text
""
    , pstateOffset :: Int
pstateOffset = Int
0
    , pstateSourcePos :: SourcePos
pstateSourcePos = SourcePos
pos
    , pstateTabWidth :: Pos
pstateTabWidth = Int -> Pos
mkPos Int
1
    , pstateLinePrefix :: String
pstateLinePrefix = String
""
    }
  }
addCustomError :: ParseErrorBundle Text e -> e -> ParseErrorBundle Text e
addCustomError :: ParseErrorBundle Text e -> e -> ParseErrorBundle Text e
addCustomError ParseErrorBundle Text e
e e
customE =
  ParseErrorBundle Text e
e { bundleErrors :: NonEmpty (ParseError Text e)
bundleErrors = ParseError Text e
-> NonEmpty (ParseError Text e) -> NonEmpty (ParseError Text e)
forall a. a -> NonEmpty a -> NonEmpty a
NE.cons
                      (Int -> Set (ErrorFancy e) -> ParseError Text e
forall s e. Int -> Set (ErrorFancy e) -> ParseError s e
FancyError Int
0 (ErrorFancy e -> Set (ErrorFancy e)
forall a. a -> Set a
S.singleton (e -> ErrorFancy e
forall e. e -> ErrorFancy e
ErrorCustom e
customE)))
                      (ParseErrorBundle Text e -> NonEmpty (ParseError Text e)
forall s e. ParseErrorBundle s e -> NonEmpty (ParseError s e)
bundleErrors ParseErrorBundle Text e
e)}

-- Low level assignment parser

data Assignment = Assignment
  { Assignment -> SourcePos
assignmentPosition :: SourcePos
  , Assignment -> Text
assignmentKey :: Text
  , Assignment -> AssignmentValue
assignmentValue :: AssignmentValue
  } deriving (Int -> Assignment -> ShowS
[Assignment] -> ShowS
Assignment -> String
(Int -> Assignment -> ShowS)
-> (Assignment -> String)
-> ([Assignment] -> ShowS)
-> Show Assignment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Assignment] -> ShowS
$cshowList :: [Assignment] -> ShowS
show :: Assignment -> String
$cshow :: Assignment -> String
showsPrec :: Int -> Assignment -> ShowS
$cshowsPrec :: Int -> Assignment -> ShowS
Show)

data AssignmentValue = AssignmentValue
  { AssignmentValue -> SourcePos
valuePosition :: SourcePos
  , AssignmentValue -> Text
valueContent :: Text
  } deriving (Int -> AssignmentValue -> ShowS
[AssignmentValue] -> ShowS
AssignmentValue -> String
(Int -> AssignmentValue -> ShowS)
-> (AssignmentValue -> String)
-> ([AssignmentValue] -> ShowS)
-> Show AssignmentValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssignmentValue] -> ShowS
$cshowList :: [AssignmentValue] -> ShowS
show :: AssignmentValue -> String
$cshow :: AssignmentValue -> String
showsPrec :: Int -> AssignmentValue -> ShowS
$cshowsPrec :: Int -> AssignmentValue -> ShowS
Show)

assignmentList :: OParser [Assignment]
assignmentList :: Parsec ConfParseError Text [Assignment]
assignmentList = ParsecT ConfParseError Text Identity ()
whitespace ParsecT ConfParseError Text Identity ()
-> Parsec ConfParseError Text [Assignment]
-> Parsec ConfParseError Text [Assignment]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT ConfParseError Text Identity Assignment
-> Parsec ConfParseError Text [Assignment]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT ConfParseError Text Identity Assignment
assignment ParsecT ConfParseError Text Identity Assignment
-> ParsecT ConfParseError Text Identity ()
-> ParsecT ConfParseError Text Identity Assignment
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT ConfParseError Text Identity ()
whitespace)

assignment :: OParser Assignment
assignment :: ParsecT ConfParseError Text Identity Assignment
assignment = do
  SourcePos -> Text -> AssignmentValue -> Assignment
Assignment
    (SourcePos -> Text -> AssignmentValue -> Assignment)
-> ParsecT ConfParseError Text Identity SourcePos
-> ParsecT
     ConfParseError
     Text
     Identity
     (Text -> AssignmentValue -> Assignment)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT ConfParseError Text Identity SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos ParsecT
  ConfParseError
  Text
  Identity
  (Text -> AssignmentValue -> Assignment)
-> OParser Text
-> ParsecT
     ConfParseError Text Identity (AssignmentValue -> Assignment)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> OParser Text
key ParsecT
  ConfParseError Text Identity (AssignmentValue -> Assignment)
-> ParsecT ConfParseError Text Identity ()
-> ParsecT
     ConfParseError Text Identity (AssignmentValue -> Assignment)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT ConfParseError Text Identity ()
whitespaceNoComment
    ParsecT
  ConfParseError Text Identity (AssignmentValue -> Assignment)
-> ParsecT ConfParseError Text Identity Char
-> ParsecT
     ConfParseError Text Identity (AssignmentValue -> Assignment)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  Token Text -> ParsecT ConfParseError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'=' ParsecT
  ConfParseError Text Identity (AssignmentValue -> Assignment)
-> ParsecT ConfParseError Text Identity ()
-> ParsecT
     ConfParseError Text Identity (AssignmentValue -> Assignment)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT ConfParseError Text Identity ()
whitespaceNoComment
    ParsecT
  ConfParseError Text Identity (AssignmentValue -> Assignment)
-> ParsecT ConfParseError Text Identity AssignmentValue
-> ParsecT ConfParseError Text Identity Assignment
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT ConfParseError Text Identity AssignmentValue
value

key :: OParser Text
key :: OParser Text
key = String -> Text
T.pack (String -> Text) -> OParser String -> OParser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT ConfParseError Text Identity Char -> OParser String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (ParsecT ConfParseError Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar ParsecT ConfParseError Text Identity Char
-> ParsecT ConfParseError Text Identity Char
-> ParsecT ConfParseError Text Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token Text -> ParsecT ConfParseError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'_' ParsecT ConfParseError Text Identity Char
-> ParsecT ConfParseError Text Identity Char
-> ParsecT ConfParseError Text Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token Text -> ParsecT ConfParseError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'-')

value :: OParser AssignmentValue
value :: ParsecT ConfParseError Text Identity AssignmentValue
value = SourcePos -> Text -> AssignmentValue
AssignmentValue (SourcePos -> Text -> AssignmentValue)
-> ParsecT ConfParseError Text Identity SourcePos
-> ParsecT ConfParseError Text Identity (Text -> AssignmentValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT ConfParseError Text Identity SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos ParsecT ConfParseError Text Identity (Text -> AssignmentValue)
-> OParser Text
-> ParsecT ConfParseError Text Identity AssignmentValue
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> OParser Text
content ParsecT ConfParseError Text Identity AssignmentValue
-> ParsecT ConfParseError Text Identity ()
-> ParsecT ConfParseError Text Identity AssignmentValue
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT ConfParseError Text Identity ()
whitespaceNoEOL ParsecT ConfParseError Text Identity AssignmentValue
-> ParsecT ConfParseError Text Identity ()
-> ParsecT ConfParseError Text Identity AssignmentValue
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (OParser Text -> ParsecT ConfParseError Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void OParser Text
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
eol ParsecT ConfParseError Text Identity ()
-> ParsecT ConfParseError Text Identity ()
-> ParsecT ConfParseError Text Identity ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT ConfParseError Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof)

content :: OParser Text
content :: OParser Text
content =  OParser Text
escapedString
       OParser Text -> OParser Text -> OParser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> OParser Text
bareString

bareString :: OParser Text
bareString :: OParser Text
bareString = (Text -> Text
T.strip (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> OParser String -> OParser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT ConfParseError Text Identity Char -> OParser String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ([Token Text] -> ParsecT ConfParseError Text Identity (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf (String
"#\n" :: String)))
  OParser Text -> String -> OParser Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"bare string"

escapedString :: OParser Text
escapedString :: OParser Text
escapedString = (String -> Text
T.pack (String -> Text) -> OParser String -> OParser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Token Text -> ParsecT ConfParseError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'"' ParsecT ConfParseError Text Identity Char
-> OParser String -> OParser String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT ConfParseError Text Identity Char -> OParser String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT ConfParseError Text Identity Char
escapedChar OParser String
-> ParsecT ConfParseError Text Identity Char -> OParser String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token Text -> ParsecT ConfParseError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'"'))
                OParser Text -> String -> OParser Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"quoted string"
  where escapedChar :: ParsecT ConfParseError Text Identity Char
escapedChar =  Token Text -> ParsecT ConfParseError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'\\' ParsecT ConfParseError Text Identity Char
-> ParsecT ConfParseError Text Identity Char
-> ParsecT ConfParseError Text Identity Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT ConfParseError Text Identity Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle
                   ParsecT ConfParseError Text Identity Char
-> ParsecT ConfParseError Text Identity Char
-> ParsecT ConfParseError Text Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Token Text] -> ParsecT ConfParseError Text Identity (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf (String
"\"" :: String)

whitespace :: OParser ()
whitespace :: ParsecT ConfParseError Text Identity ()
whitespace = ParsecT ConfParseError Text Identity ()
-> ParsecT ConfParseError Text Identity ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany (ParsecT ConfParseError Text Identity ()
 -> ParsecT ConfParseError Text Identity ())
-> ParsecT ConfParseError Text Identity ()
-> ParsecT ConfParseError Text Identity ()
forall a b. (a -> b) -> a -> b
$ (ParsecT ConfParseError Text Identity Char
-> ParsecT ConfParseError Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT ConfParseError Text Identity Char
 -> ParsecT ConfParseError Text Identity ())
-> ParsecT ConfParseError Text Identity Char
-> ParsecT ConfParseError Text Identity ()
forall a b. (a -> b) -> a -> b
$ [Token Text] -> ParsecT ConfParseError Text Identity (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf (String
" \t\n" :: String)) ParsecT ConfParseError Text Identity ()
-> ParsecT ConfParseError Text Identity ()
-> ParsecT ConfParseError Text Identity ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT ConfParseError Text Identity ()
comment

whitespaceNoEOL :: OParser ()
whitespaceNoEOL :: ParsecT ConfParseError Text Identity ()
whitespaceNoEOL = ParsecT ConfParseError Text Identity ()
-> ParsecT ConfParseError Text Identity ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany (ParsecT ConfParseError Text Identity ()
 -> ParsecT ConfParseError Text Identity ())
-> ParsecT ConfParseError Text Identity ()
-> ParsecT ConfParseError Text Identity ()
forall a b. (a -> b) -> a -> b
$ (ParsecT ConfParseError Text Identity Char
-> ParsecT ConfParseError Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT ConfParseError Text Identity Char
 -> ParsecT ConfParseError Text Identity ())
-> ParsecT ConfParseError Text Identity Char
-> ParsecT ConfParseError Text Identity ()
forall a b. (a -> b) -> a -> b
$ [Token Text] -> ParsecT ConfParseError Text Identity (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf (String
" \t" :: String)) ParsecT ConfParseError Text Identity ()
-> ParsecT ConfParseError Text Identity ()
-> ParsecT ConfParseError Text Identity ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT ConfParseError Text Identity ()
comment

whitespaceNoComment :: OParser ()
whitespaceNoComment :: ParsecT ConfParseError Text Identity ()
whitespaceNoComment = ParsecT ConfParseError Text Identity Char
-> ParsecT ConfParseError Text Identity ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany (ParsecT ConfParseError Text Identity Char
 -> ParsecT ConfParseError Text Identity ())
-> ParsecT ConfParseError Text Identity Char
-> ParsecT ConfParseError Text Identity ()
forall a b. (a -> b) -> a -> b
$ [Token Text] -> ParsecT ConfParseError Text Identity (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf (String
" \t" :: String)

comment :: OParser ()
comment :: ParsecT ConfParseError Text Identity ()
comment = Token Text -> ParsecT ConfParseError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'#' ParsecT ConfParseError Text Identity Char
-> ParsecT ConfParseError Text Identity ()
-> ParsecT ConfParseError Text Identity ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT ConfParseError Text Identity Char
-> ParsecT ConfParseError Text Identity ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ([Token Text] -> ParsecT ConfParseError Text Identity (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf (String
"\n" :: String))

parseNumber :: Read a => OParser a
parseNumber :: OParser a
parseNumber = String -> a
forall a. Read a => String -> a
read (String -> a) -> OParser String -> OParser a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> ShowS
forall a. Semigroup a => a -> a -> a
(<>) (String -> ShowS)
-> OParser String -> ParsecT ConfParseError Text Identity ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe Char -> String
forall a. Maybe a -> [a]
maybeToList (Maybe Char -> String)
-> ParsecT ConfParseError Text Identity (Maybe Char)
-> OParser String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT ConfParseError Text Identity Char
-> ParsecT ConfParseError Text Identity (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Token Text -> ParsecT ConfParseError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'-')) ParsecT ConfParseError Text Identity ShowS
-> OParser String -> OParser String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT ConfParseError Text Identity Char -> OParser String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT ConfParseError Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar)


-- | Like 'parse', but start at a specific source position instead of 0.
parseWithStart :: (Stream s, Ord e)
               => Parsec e s a -> SourcePos -> s -> Either (ParseErrorBundle s e) a
parseWithStart :: Parsec e s a -> SourcePos -> s -> Either (ParseErrorBundle s e) a
parseWithStart Parsec e s a
p SourcePos
pos s
s = (State s e, Either (ParseErrorBundle s e) a)
-> Either (ParseErrorBundle s e) a
forall a b. (a, b) -> b
snd (Parsec e s a
-> State s e -> (State s e, Either (ParseErrorBundle s e) a)
forall e s a.
Parsec e s a
-> State s e -> (State s e, Either (ParseErrorBundle s e) a)
runParser' Parsec e s a
p State s e
state)
  where state :: State s e
state = State :: forall s e. s -> Int -> PosState s -> [ParseError s e] -> State s e
State
          { stateInput :: s
stateInput = s
s
          , stateOffset :: Int
stateOffset = Int
0
          , statePosState :: PosState s
statePosState =PosState :: forall s. s -> Int -> SourcePos -> Pos -> String -> PosState s
PosState
            { pstateInput :: s
pstateInput = s
s
            , pstateOffset :: Int
pstateOffset = Int
0
            , pstateSourcePos :: SourcePos
pstateSourcePos = SourcePos
pos
            , pstateTabWidth :: Pos
pstateTabWidth = Int -> Pos
mkPos Int
1
            , pstateLinePrefix :: String
pstateLinePrefix = String
""
            }
#if MIN_VERSION_megaparsec(8,0,0)
          , stateParseErrors :: [ParseError s e]
stateParseErrors = []
#endif
          }