{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts, FlexibleInstances #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Graphics.Vty.Config
( InputMap
, Config(..)
, VtyConfigurationError(..)
, userConfig
, overrideEnvConfig
, standardIOConfig
, runParseConfig
, parseConfigFile
, defaultConfig
)
where
import Prelude
import Control.Applicative hiding (many)
import Control.Exception (catch, IOException, Exception(..), throwIO)
import Control.Monad (liftM, guard, void)
import qualified Data.ByteString as BS
#if !(MIN_VERSION_base(4,8,0))
import Data.Monoid (Monoid(..))
#endif
#if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup (Semigroup(..))
#endif
import Data.Typeable (Typeable)
import Graphics.Vty.Input.Events
import GHC.Generics
import System.Directory (getAppUserDataDirectory)
import System.Environment (lookupEnv)
import System.Posix.IO (stdInput, stdOutput)
import System.Posix.Types (Fd(..))
import Text.Parsec hiding ((<|>))
import Text.Parsec.Token ( GenLanguageDef(..) )
import qualified Text.Parsec.Token as P
data VtyConfigurationError
= VtyMissingTermEnvVar
deriving (Int -> VtyConfigurationError -> ShowS
[VtyConfigurationError] -> ShowS
VtyConfigurationError -> String
(Int -> VtyConfigurationError -> ShowS)
-> (VtyConfigurationError -> String)
-> ([VtyConfigurationError] -> ShowS)
-> Show VtyConfigurationError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VtyConfigurationError] -> ShowS
$cshowList :: [VtyConfigurationError] -> ShowS
show :: VtyConfigurationError -> String
$cshow :: VtyConfigurationError -> String
showsPrec :: Int -> VtyConfigurationError -> ShowS
$cshowsPrec :: Int -> VtyConfigurationError -> ShowS
Show, VtyConfigurationError -> VtyConfigurationError -> Bool
(VtyConfigurationError -> VtyConfigurationError -> Bool)
-> (VtyConfigurationError -> VtyConfigurationError -> Bool)
-> Eq VtyConfigurationError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VtyConfigurationError -> VtyConfigurationError -> Bool
$c/= :: VtyConfigurationError -> VtyConfigurationError -> Bool
== :: VtyConfigurationError -> VtyConfigurationError -> Bool
$c== :: VtyConfigurationError -> VtyConfigurationError -> Bool
Eq, Typeable)
instance Exception VtyConfigurationError where
displayException :: VtyConfigurationError -> String
displayException VtyMissingTermEnvVar = "TERM environment variable not set"
type InputMap = [(Maybe String, String, Event)]
data Config = Config
{
Config -> Maybe Int
vmin :: Maybe Int
, Config -> Maybe Int
vtime :: Maybe Int
, Config -> Maybe Bool
mouseMode :: Maybe Bool
, Config -> Maybe Bool
bracketedPasteMode :: Maybe Bool
, Config -> Maybe String
debugLog :: Maybe FilePath
, Config -> InputMap
inputMap :: InputMap
, Config -> Maybe Fd
inputFd :: Maybe Fd
, Config -> Maybe Fd
outputFd :: Maybe Fd
, Config -> Maybe String
termName :: Maybe String
} deriving (Int -> Config -> ShowS
[Config] -> ShowS
Config -> String
(Int -> Config -> ShowS)
-> (Config -> String) -> ([Config] -> ShowS) -> Show Config
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Config] -> ShowS
$cshowList :: [Config] -> ShowS
show :: Config -> String
$cshow :: Config -> String
showsPrec :: Int -> Config -> ShowS
$cshowsPrec :: Int -> Config -> ShowS
Show, Config -> Config -> Bool
(Config -> Config -> Bool)
-> (Config -> Config -> Bool) -> Eq Config
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Config -> Config -> Bool
$c/= :: Config -> Config -> Bool
== :: Config -> Config -> Bool
$c== :: Config -> Config -> Bool
Eq)
defaultConfig :: Config
defaultConfig :: Config
defaultConfig = Config
forall a. Monoid a => a
mempty
instance Semigroup Config where
c0 :: Config
c0 <> :: Config -> Config -> Config
<> c1 :: Config
c1 = Config :: Maybe Int
-> Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe String
-> InputMap
-> Maybe Fd
-> Maybe Fd
-> Maybe String
-> Config
Config
{ vmin :: Maybe Int
vmin = Config -> Maybe Int
vmin Config
c1 Maybe Int -> Maybe Int -> Maybe Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Config -> Maybe Int
vmin Config
c0
, vtime :: Maybe Int
vtime = Config -> Maybe Int
vtime Config
c1 Maybe Int -> Maybe Int -> Maybe Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Config -> Maybe Int
vtime Config
c0
, mouseMode :: Maybe Bool
mouseMode = Config -> Maybe Bool
mouseMode Config
c1
, bracketedPasteMode :: Maybe Bool
bracketedPasteMode = Config -> Maybe Bool
bracketedPasteMode Config
c1
, debugLog :: Maybe String
debugLog = Config -> Maybe String
debugLog Config
c1 Maybe String -> Maybe String -> Maybe String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Config -> Maybe String
debugLog Config
c0
, inputMap :: InputMap
inputMap = Config -> InputMap
inputMap Config
c0 InputMap -> InputMap -> InputMap
forall a. Semigroup a => a -> a -> a
<> Config -> InputMap
inputMap Config
c1
, inputFd :: Maybe Fd
inputFd = Config -> Maybe Fd
inputFd Config
c1 Maybe Fd -> Maybe Fd -> Maybe Fd
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Config -> Maybe Fd
inputFd Config
c0
, outputFd :: Maybe Fd
outputFd = Config -> Maybe Fd
outputFd Config
c1 Maybe Fd -> Maybe Fd -> Maybe Fd
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Config -> Maybe Fd
outputFd Config
c0
, termName :: Maybe String
termName = Config -> Maybe String
termName Config
c1 Maybe String -> Maybe String -> Maybe String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Config -> Maybe String
termName Config
c0
}
instance Monoid Config where
mempty :: Config
mempty = Config :: Maybe Int
-> Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe String
-> InputMap
-> Maybe Fd
-> Maybe Fd
-> Maybe String
-> Config
Config
{ vmin :: Maybe Int
vmin = Maybe Int
forall a. Maybe a
Nothing
, vtime :: Maybe Int
vtime = Maybe Int
forall a. Maybe a
Nothing
, mouseMode :: Maybe Bool
mouseMode = Maybe Bool
forall a. Maybe a
Nothing
, bracketedPasteMode :: Maybe Bool
bracketedPasteMode = Maybe Bool
forall a. Maybe a
Nothing
, debugLog :: Maybe String
debugLog = Maybe String
forall a. Monoid a => a
mempty
, inputMap :: InputMap
inputMap = InputMap
forall a. Monoid a => a
mempty
, inputFd :: Maybe Fd
inputFd = Maybe Fd
forall a. Maybe a
Nothing
, outputFd :: Maybe Fd
outputFd = Maybe Fd
forall a. Maybe a
Nothing
, termName :: Maybe String
termName = Maybe String
forall a. Maybe a
Nothing
}
#if !(MIN_VERSION_base(4,11,0))
mappend = (<>)
#endif
userConfig :: IO Config
userConfig :: IO Config
userConfig = do
Config
configFile <- (String -> ShowS
forall a. Monoid a => a -> a -> a
mappend (String -> ShowS) -> IO String -> IO ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
getAppUserDataDirectory "vty" IO ShowS -> IO String -> IO String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> IO String
forall (f :: * -> *) a. Applicative f => a -> f a
pure "/config") IO String -> (String -> IO Config) -> IO Config
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO Config
parseConfigFile
Config
overrideConfig <- IO Config -> (String -> IO Config) -> Maybe String -> IO Config
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Config -> IO Config
forall (m :: * -> *) a. Monad m => a -> m a
return Config
defaultConfig) String -> IO Config
parseConfigFile (Maybe String -> IO Config) -> IO (Maybe String) -> IO Config
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO (Maybe String)
lookupEnv "VTY_CONFIG_FILE"
let base :: Config
base = Config
configFile Config -> Config -> Config
forall a. Semigroup a => a -> a -> a
<> Config
overrideConfig
Config -> Config -> Config
forall a. Monoid a => a -> a -> a
mappend Config
base (Config -> Config) -> IO Config -> IO Config
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Config
overrideEnvConfig
overrideEnvConfig :: IO Config
overrideEnvConfig :: IO Config
overrideEnvConfig = do
Maybe String
d <- String -> IO (Maybe String)
lookupEnv "VTY_DEBUG_LOG"
Config -> IO Config
forall (m :: * -> *) a. Monad m => a -> m a
return (Config -> IO Config) -> Config -> IO Config
forall a b. (a -> b) -> a -> b
$ Config
defaultConfig { debugLog :: Maybe String
debugLog = Maybe String
d }
standardIOConfig :: IO Config
standardIOConfig :: IO Config
standardIOConfig = do
Maybe String
mb <- String -> IO (Maybe String)
lookupEnv "TERM"
case Maybe String
mb of
Nothing -> VtyConfigurationError -> IO Config
forall e a. Exception e => e -> IO a
throwIO VtyConfigurationError
VtyMissingTermEnvVar
Just t :: String
t ->
Config -> IO Config
forall (m :: * -> *) a. Monad m => a -> m a
return Config
defaultConfig
{ vmin :: Maybe Int
vmin = Int -> Maybe Int
forall a. a -> Maybe a
Just 1
, mouseMode :: Maybe Bool
mouseMode = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
, bracketedPasteMode :: Maybe Bool
bracketedPasteMode = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
, vtime :: Maybe Int
vtime = Int -> Maybe Int
forall a. a -> Maybe a
Just 100
, inputFd :: Maybe Fd
inputFd = Fd -> Maybe Fd
forall a. a -> Maybe a
Just Fd
stdInput
, outputFd :: Maybe Fd
outputFd = Fd -> Maybe Fd
forall a. a -> Maybe a
Just Fd
stdOutput
, termName :: Maybe String
termName = String -> Maybe String
forall a. a -> Maybe a
Just String
t
}
parseConfigFile :: FilePath -> IO Config
parseConfigFile :: String -> IO Config
parseConfigFile path :: String
path = do
IO Config -> (IOException -> IO Config) -> IO Config
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (String -> ByteString -> Config
runParseConfig String
path (ByteString -> Config) -> IO ByteString -> IO Config
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
BS.readFile String
path)
(\(IOException
_ :: IOException) -> Config -> IO Config
forall (m :: * -> *) a. Monad m => a -> m a
return Config
defaultConfig)
runParseConfig :: String -> BS.ByteString -> Config
runParseConfig :: String -> ByteString -> Config
runParseConfig name :: String
name cfgTxt :: ByteString
cfgTxt =
case Parsec ByteString () Config
-> () -> String -> ByteString -> Either ParseError Config
forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> String -> s -> Either ParseError a
runParser Parsec ByteString () Config
parseConfig () String
name ByteString
cfgTxt of
Right cfg :: Config
cfg -> Config
cfg
Left{} -> Config
defaultConfig
type Parser = Parsec BS.ByteString ()
configLanguage :: Monad m => P.GenLanguageDef BS.ByteString () m
configLanguage :: GenLanguageDef ByteString () m
configLanguage = LanguageDef :: forall s u (m :: * -> *).
String
-> String
-> String
-> Bool
-> ParsecT s u m Char
-> ParsecT s u m Char
-> ParsecT s u m Char
-> ParsecT s u m Char
-> [String]
-> [String]
-> Bool
-> GenLanguageDef s u m
LanguageDef
{ commentStart :: String
commentStart = "{-"
, commentEnd :: String
commentEnd = "-}"
, commentLine :: String
commentLine = "--"
, nestedComments :: Bool
nestedComments = Bool
True
, identStart :: ParsecT ByteString () m Char
identStart = ParsecT ByteString () m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter ParsecT ByteString () m Char
-> ParsecT ByteString () m Char -> ParsecT ByteString () m Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> ParsecT ByteString () m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '_'
, identLetter :: ParsecT ByteString () m Char
identLetter = ParsecT ByteString () m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum ParsecT ByteString () m Char
-> ParsecT ByteString () m Char -> ParsecT ByteString () m Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> ParsecT ByteString () m Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf "_'"
, opStart :: ParsecT ByteString () m Char
opStart = GenLanguageDef ByteString () m -> ParsecT ByteString () m Char
forall s u (m :: * -> *).
GenLanguageDef s u m -> ParsecT s u m Char
opLetter GenLanguageDef ByteString () m
forall (m :: * -> *). Monad m => GenLanguageDef ByteString () m
configLanguage
, opLetter :: ParsecT ByteString () m Char
opLetter = String -> ParsecT ByteString () m Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf ":!#$%&*+./<=>?@\\^|-~"
, reservedOpNames :: [String]
reservedOpNames = []
, reservedNames :: [String]
reservedNames = []
, caseSensitive :: Bool
caseSensitive = Bool
True
}
configLexer :: Monad m => P.GenTokenParser BS.ByteString () m
configLexer :: GenTokenParser ByteString () m
configLexer = GenLanguageDef ByteString () m -> GenTokenParser ByteString () m
forall s (m :: * -> *) u.
Stream s m Char =>
GenLanguageDef s u m -> GenTokenParser s u m
P.makeTokenParser GenLanguageDef ByteString () m
forall (m :: * -> *). Monad m => GenLanguageDef ByteString () m
configLanguage
mapDecl :: Parser Config
mapDecl :: Parsec ByteString () Config
mapDecl = do
String
"map" <- GenTokenParser ByteString () Identity
-> ParsecT ByteString () Identity String
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m String
P.identifier GenTokenParser ByteString () Identity
forall (m :: * -> *). Monad m => GenTokenParser ByteString () m
configLexer
Maybe String
termIdent <- (Char -> ParsecT ByteString () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '_' ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity ()
-> ParsecT ByteString () Identity ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenTokenParser ByteString () Identity
-> ParsecT ByteString () Identity ()
forall s u (m :: * -> *). GenTokenParser s u m -> ParsecT s u m ()
P.whiteSpace GenTokenParser ByteString () Identity
forall (m :: * -> *). Monad m => GenTokenParser ByteString () m
configLexer ParsecT ByteString () Identity ()
-> ParsecT ByteString () Identity (Maybe String)
-> ParsecT ByteString () Identity (Maybe String)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe String -> ParsecT ByteString () Identity (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing)
ParsecT ByteString () Identity (Maybe String)
-> ParsecT ByteString () Identity (Maybe String)
-> ParsecT ByteString () Identity (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String)
-> ParsecT ByteString () Identity String
-> ParsecT ByteString () Identity (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenTokenParser ByteString () Identity
-> ParsecT ByteString () Identity String
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m String
P.stringLiteral GenTokenParser ByteString () Identity
forall (m :: * -> *). Monad m => GenTokenParser ByteString () m
configLexer)
String
bytes <- GenTokenParser ByteString () Identity
-> ParsecT ByteString () Identity String
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m String
P.stringLiteral GenTokenParser ByteString () Identity
forall (m :: * -> *). Monad m => GenTokenParser ByteString () m
configLexer
Key
key <- Parser Key
forall a. Parse a => Parser a
parseValue
[Modifier]
modifiers <- Parser [Modifier]
forall a. Parse a => Parser a
parseValue
Config -> Parsec ByteString () Config
forall (m :: * -> *) a. Monad m => a -> m a
return Config
defaultConfig { inputMap :: InputMap
inputMap = [(Maybe String
termIdent, String
bytes, Key -> [Modifier] -> Event
EvKey Key
key [Modifier]
modifiers)] }
debugLogDecl :: Parser Config
debugLogDecl :: Parsec ByteString () Config
debugLogDecl = do
String
"debugLog" <- GenTokenParser ByteString () Identity
-> ParsecT ByteString () Identity String
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m String
P.identifier GenTokenParser ByteString () Identity
forall (m :: * -> *). Monad m => GenTokenParser ByteString () m
configLexer
String
path <- GenTokenParser ByteString () Identity
-> ParsecT ByteString () Identity String
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m String
P.stringLiteral GenTokenParser ByteString () Identity
forall (m :: * -> *). Monad m => GenTokenParser ByteString () m
configLexer
Config -> Parsec ByteString () Config
forall (m :: * -> *) a. Monad m => a -> m a
return Config
defaultConfig { debugLog :: Maybe String
debugLog = String -> Maybe String
forall a. a -> Maybe a
Just String
path }
ignoreLine :: Parser ()
ignoreLine :: ParsecT ByteString () Identity ()
ignoreLine = ParsecT ByteString () Identity String
-> ParsecT ByteString () Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT ByteString () Identity String
-> ParsecT ByteString () Identity ())
-> ParsecT ByteString () Identity String
-> ParsecT ByteString () Identity ()
forall a b. (a -> b) -> a -> b
$ ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity String
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT ByteString () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar ParsecT ByteString () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline
parseConfig :: Parser Config
parseConfig :: Parsec ByteString () Config
parseConfig = ([Config] -> Config)
-> ParsecT ByteString () Identity [Config]
-> Parsec ByteString () Config
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [Config] -> Config
forall a. Monoid a => [a] -> a
mconcat (ParsecT ByteString () Identity [Config]
-> Parsec ByteString () Config)
-> ParsecT ByteString () Identity [Config]
-> Parsec ByteString () Config
forall a b. (a -> b) -> a -> b
$ Parsec ByteString () Config
-> ParsecT ByteString () Identity [Config]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (Parsec ByteString () Config
-> ParsecT ByteString () Identity [Config])
-> Parsec ByteString () Config
-> ParsecT ByteString () Identity [Config]
forall a b. (a -> b) -> a -> b
$ do
GenTokenParser ByteString () Identity
-> ParsecT ByteString () Identity ()
forall s u (m :: * -> *). GenTokenParser s u m -> ParsecT s u m ()
P.whiteSpace GenTokenParser ByteString () Identity
forall (m :: * -> *). Monad m => GenTokenParser ByteString () m
configLexer
let directives :: [Parsec ByteString () Config]
directives = [Parsec ByteString () Config -> Parsec ByteString () Config
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parsec ByteString () Config
mapDecl, Parsec ByteString () Config -> Parsec ByteString () Config
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parsec ByteString () Config
debugLogDecl]
[Parsec ByteString () Config] -> Parsec ByteString () Config
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [Parsec ByteString () Config]
directives Parsec ByteString () Config
-> Parsec ByteString () Config -> Parsec ByteString () Config
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ParsecT ByteString () Identity ()
ignoreLine ParsecT ByteString () Identity ()
-> Parsec ByteString () Config -> Parsec ByteString () Config
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Config -> Parsec ByteString () Config
forall (m :: * -> *) a. Monad m => a -> m a
return Config
defaultConfig)
class Parse a where parseValue :: Parser a
instance Parse Char where parseValue :: ParsecT ByteString () Identity Char
parseValue = GenTokenParser ByteString () Identity
-> ParsecT ByteString () Identity Char
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m Char
P.charLiteral GenTokenParser ByteString () Identity
forall (m :: * -> *). Monad m => GenTokenParser ByteString () m
configLexer
instance Parse Int where parseValue :: Parser Int
parseValue = Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Int)
-> ParsecT ByteString () Identity Integer -> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenTokenParser ByteString () Identity
-> ParsecT ByteString () Identity Integer
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m Integer
P.natural GenTokenParser ByteString () Identity
forall (m :: * -> *). Monad m => GenTokenParser ByteString () m
configLexer
instance Parse Key where parseValue :: Parser Key
parseValue = Parser Key
forall a. (Generic a, GParse (Rep a)) => Parser a
genericParse
instance Parse Modifier where parseValue :: Parser Modifier
parseValue = Parser Modifier
forall a. (Generic a, GParse (Rep a)) => Parser a
genericParse
instance Parse a => Parse [a] where
parseValue :: Parser [a]
parseValue = GenTokenParser ByteString () Identity -> Parser [a] -> Parser [a]
forall s u (m :: * -> *).
GenTokenParser s u m
-> forall a. ParsecT s u m a -> ParsecT s u m a
P.brackets GenTokenParser ByteString () Identity
forall (m :: * -> *). Monad m => GenTokenParser ByteString () m
configLexer
(Parser a
forall a. Parse a => Parser a
parseValue Parser a -> ParsecT ByteString () Identity String -> Parser [a]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
`sepBy` GenTokenParser ByteString () Identity
-> String -> ParsecT ByteString () Identity String
forall s u (m :: * -> *).
GenTokenParser s u m -> String -> ParsecT s u m String
P.symbol GenTokenParser ByteString () Identity
forall (m :: * -> *). Monad m => GenTokenParser ByteString () m
configLexer ",")
genericParse :: (Generic a, GParse (Rep a)) => Parser a
genericParse :: Parser a
genericParse = Rep a Any -> a
forall a x. Generic a => Rep a x -> a
to (Rep a Any -> a)
-> ParsecT ByteString () Identity (Rep a Any) -> Parser a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT ByteString () Identity (Rep a Any)
forall (f :: * -> *) a. GParse f => Parser (f a)
gparse
class GParse f where gparse :: Parser (f a)
instance GParse f => GParse (M1 S i f) where gparse :: Parser (M1 S i f a)
gparse = f a -> M1 S i f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f a -> M1 S i f a)
-> ParsecT ByteString () Identity (f a) -> Parser (M1 S i f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT ByteString () Identity (f a)
forall (f :: * -> *) a. GParse f => Parser (f a)
gparse
instance GParse U1 where gparse :: Parser (U1 a)
gparse = U1 a -> Parser (U1 a)
forall (m :: * -> *) a. Monad m => a -> m a
return U1 a
forall k (p :: k). U1 p
U1
instance Parse a => GParse (K1 i a) where gparse :: Parser (K1 i a a)
gparse = a -> K1 i a a
forall k i c (p :: k). c -> K1 i c p
K1 (a -> K1 i a a)
-> ParsecT ByteString () Identity a -> Parser (K1 i a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT ByteString () Identity a
forall a. Parse a => Parser a
parseValue
instance (GParse f, GParse g) => GParse (f :*: g) where
gparse :: Parser ((:*:) f g a)
gparse = f a -> g a -> (:*:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) (f a -> g a -> (:*:) f g a)
-> ParsecT ByteString () Identity (f a)
-> ParsecT ByteString () Identity (g a -> (:*:) f g a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT ByteString () Identity (f a)
forall (f :: * -> *) a. GParse f => Parser (f a)
gparse ParsecT ByteString () Identity (g a -> (:*:) f g a)
-> ParsecT ByteString () Identity (g a) -> Parser ((:*:) f g a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT ByteString () Identity (g a)
forall (f :: * -> *) a. GParse f => Parser (f a)
gparse
instance GParseAlts f => GParse (M1 D i f) where
gparse :: Parser (M1 D i f a)
gparse =
do String
con <- GenTokenParser ByteString () Identity
-> ParsecT ByteString () Identity String
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m String
P.identifier GenTokenParser ByteString () Identity
forall (m :: * -> *). Monad m => GenTokenParser ByteString () m
configLexer
f a -> M1 D i f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f a -> M1 D i f a)
-> ParsecT ByteString () Identity (f a) -> Parser (M1 D i f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> ParsecT ByteString () Identity (f a)
forall (f :: * -> *) a. GParseAlts f => String -> Parser (f a)
gparseAlts String
con
class GParseAlts f where
gparseAlts :: String -> Parser (f a)
instance (Constructor i, GParse f) => GParseAlts (M1 C i f) where
gparseAlts :: String -> Parser (M1 C i f a)
gparseAlts con :: String
con =
do Bool -> ParsecT ByteString () Identity ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (String
con String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== M1 C i Maybe Any -> String
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
conName (Maybe a -> M1 C i Maybe a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 Maybe a
forall a. Maybe a
Nothing :: C1 i Maybe a))
f a -> M1 C i f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f a -> M1 C i f a)
-> ParsecT ByteString () Identity (f a) -> Parser (M1 C i f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT ByteString () Identity (f a)
forall (f :: * -> *) a. GParse f => Parser (f a)
gparse
instance (GParseAlts f, GParseAlts g) => GParseAlts (f :+: g) where
gparseAlts :: String -> Parser ((:+:) f g a)
gparseAlts con :: String
con = f a -> (:+:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (f a -> (:+:) f g a)
-> ParsecT ByteString () Identity (f a) -> Parser ((:+:) f g a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> ParsecT ByteString () Identity (f a)
forall (f :: * -> *) a. GParseAlts f => String -> Parser (f a)
gparseAlts String
con Parser ((:+:) f g a)
-> Parser ((:+:) f g a) -> Parser ((:+:) f g a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> g a -> (:+:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (g a -> (:+:) f g a)
-> ParsecT ByteString () Identity (g a) -> Parser ((:+:) f g a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> ParsecT ByteString () Identity (g a)
forall (f :: * -> *) a. GParseAlts f => String -> Parser (f a)
gparseAlts String
con
instance GParseAlts V1 where gparseAlts :: String -> Parser (V1 a)
gparseAlts _ = String -> Parser (V1 a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "GParse: V1"