{-# 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 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
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
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
Ord, Int -> ConfParseError -> ShowS
[ConfParseError] -> ShowS
ConfParseError -> String
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 " forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
name
  showErrorComponent (TypeError Text
typ Text
name) =
    String
"in " forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
typ forall a. [a] -> [a] -> [a]
++ String
" argument for option " 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 :: forall a.
String -> Text -> OptParser a -> Either CustomParseError a
parseConfig String
path Text
input OptParser a
parser = case forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse (ParsecT ConfParseError Text Identity [Assignment]
assignmentList forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) String
path Text
input of
  Left CustomParseError
err -> forall a b. a -> Either a b
Left CustomParseError
err
  Right [Assignment]
res -> 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 :: forall a. String -> OptParser a -> IO (Either CustomParseError a)
parseConfigFile String
path OptParser a
parser = do
  Text
input <- String -> IO Text
T.readFile String
path
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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
  { forall a. Option a -> OParser a
optParser :: OParser a
  , forall a. Option a -> Text
optType :: Text -- Something like "string" or "integer"
  , forall a. Option a -> Text
optName :: Text
  , forall a. Option a -> Text
optHelp :: Text
  , forall a. Option a -> a
optDefault :: a
  , forall a. Option a -> Text
optDefaultTxt :: Text -- printed version of optDefault
  } deriving (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
<$ :: forall a b. a -> Option b -> Option a
$c<$ :: forall a b. a -> Option b -> Option a
fmap :: forall a b. (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 :: forall a. OptionArgument a => Text -> a -> Text -> OptParser a
option Text
name a
def Text
help = forall (f :: * -> *) a. f a -> Ap f a
liftAp forall a b. (a -> b) -> a -> b
$ forall a.
OParser a -> Text -> Text -> Text -> a -> Text -> Option a
Option OParser a
parser Text
typename Text
name Text
help a
def (forall a. OptionArgument a => a -> Text
printArgument a
def)
  where (Text
typename, OParser a
parser) = 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 :: forall a.
Text -> a -> Text -> Text -> Text -> OParser a -> OptParser a
customOption Text
optName a
optDefault Text
optDefaultTxt Text
optHelp Text
optType OParser a
optParser = forall (f :: * -> *) a. f a -> Ap f a
liftAp forall a b. (a -> b) -> a -> b
$ 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", forall a. Read a => OParser a
parseNumber)
  printArgument :: Int -> Text
printArgument = String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show

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

instance OptionArgument String where
  mkParser :: (Text, OParser String)
mkParser = (Text
"string",  forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle)
  printArgument :: String -> Text
printArgument = Text -> Text
quote 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many 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
"\"" forall a. Semigroup a => a -> a -> a
<> Text -> Text
escape Text
x forall a. Semigroup a => a -> a -> a
<> Text
"\""
  where
    escape :: Text -> Text
escape = Text -> Text -> Text -> Text
T.replace 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 :: forall a. [Assignment] -> OptParser a -> Either CustomParseError a
runOptionParser (Assignment
a:[Assignment]
as) OptParser a
parser =  forall a.
OptParser a -> Assignment -> Either CustomParseError (OptParser a)
parseOption OptParser a
parser Assignment
a forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. [Assignment] -> OptParser a -> Either CustomParseError a
runOptionParser [Assignment]
as
runOptionParser [] OptParser a
parser = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ 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 :: forall a. OptParser a -> a
parserDefault = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (g :: * -> *) (f :: * -> *) a.
Applicative g =>
(forall x. f x -> g x) -> Ap f a -> g a
runAp (forall a. a -> Identity a
Identity forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. OptParser a -> Text
parserExample = Text -> Text
T.strip forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 (forall a. Option a -> Text
optHelp Option a
a) forall a. Semigroup a => a -> a -> a
<> forall a. Option a -> Text
optName Option a
a forall a. Semigroup a => a -> a -> a
<> Text
" = " forall a. Semigroup a => a -> a -> a
<> forall a. Option a -> Text
optDefaultTxt Option a
a forall a. Semigroup a => a -> a -> a
<> Text
"\n\n"
        commentify :: Text -> Text
commentify = [Text] -> Text
T.unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Text
"# " forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines

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

mkCustomError :: SourcePos -> e -> ParseErrorBundle Text e
mkCustomError :: forall e. SourcePos -> e -> ParseErrorBundle Text e
mkCustomError SourcePos
pos e
e = ParseErrorBundle
  { bundleErrors :: NonEmpty (ParseError Text e)
bundleErrors = forall a. [a] -> NonEmpty a
NE.fromList [forall s e. Int -> Set (ErrorFancy e) -> ParseError s e
FancyError Int
0 (forall a. a -> Set a
S.singleton (forall e. e -> ErrorFancy e
ErrorCustom e
e))]
  , bundlePosState :: PosState Text
bundlePosState = 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 :: forall e. ParseErrorBundle Text e -> e -> ParseErrorBundle Text e
addCustomError ParseErrorBundle Text e
e e
customE =
  ParseErrorBundle Text e
e { bundleErrors :: NonEmpty (ParseError Text e)
bundleErrors = forall a. a -> NonEmpty a -> NonEmpty a
NE.cons
                      (forall s e. Int -> Set (ErrorFancy e) -> ParseError s e
FancyError Int
0 (forall a. a -> Set a
S.singleton (forall e. e -> ErrorFancy e
ErrorCustom e
customE)))
                      (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
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
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 :: ParsecT ConfParseError Text Identity [Assignment]
assignmentList = OParser ()
whitespace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT ConfParseError Text Identity Assignment
assignment forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* OParser ()
whitespace)

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

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

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

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

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

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

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

comment :: OParser ()
comment :: OParser ()
comment = forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'#' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany (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 :: forall a. Read a => OParser a
parseNumber = forall a. Read a => String -> a
read forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Semigroup a => a -> a -> a
(<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Maybe a -> [a]
maybeToList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'-')) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some 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 :: forall s e a.
(Stream s, Ord e) =>
Parsec e s a -> SourcePos -> s -> Either (ParseErrorBundle s e) a
parseWithStart Parsec e s a
p SourcePos
pos s
s = forall a b. (a, b) -> b
snd (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
          { stateInput :: s
stateInput = s
s
          , stateOffset :: Int
stateOffset = Int
0
          , statePosState :: PosState s
statePosState =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
          }