{-# Language OverloadedStrings, GADTs, RankNTypes #-}
module Client.Commands.Interpolation
( ExpansionChunk(..)
, parseExpansion
, resolveMacroExpansions
, Macro(..)
, MacroSpec(..)
, parseMacroSpecs
, noMacroArguments
) where
import Control.Applicative
import Data.Attoparsec.Text as P
import Data.Char
import Data.Maybe
import qualified Data.Text as Text
import Data.Text (Text)
import Client.Commands.Arguments.Spec
data ExpansionChunk
= LiteralChunk Text
| VariableChunk Text
| IntegerChunk Integer
| DefaultChunk ExpansionChunk Text
deriving Int -> ExpansionChunk -> ShowS
[ExpansionChunk] -> ShowS
ExpansionChunk -> String
(Int -> ExpansionChunk -> ShowS)
-> (ExpansionChunk -> String)
-> ([ExpansionChunk] -> ShowS)
-> Show ExpansionChunk
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExpansionChunk] -> ShowS
$cshowList :: [ExpansionChunk] -> ShowS
show :: ExpansionChunk -> String
$cshow :: ExpansionChunk -> String
showsPrec :: Int -> ExpansionChunk -> ShowS
$cshowsPrec :: Int -> ExpansionChunk -> ShowS
Show
data Macro
= Macro
{ Macro -> Text
macroName :: Text
, Macro -> MacroSpec
macroSpec :: MacroSpec
, Macro -> [[ExpansionChunk]]
macroCommands :: [[ExpansionChunk]]
} deriving Int -> Macro -> ShowS
[Macro] -> ShowS
Macro -> String
(Int -> Macro -> ShowS)
-> (Macro -> String) -> ([Macro] -> ShowS) -> Show Macro
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Macro] -> ShowS
$cshowList :: [Macro] -> ShowS
show :: Macro -> String
$cshow :: Macro -> String
showsPrec :: Int -> Macro -> ShowS
$cshowsPrec :: Int -> Macro -> ShowS
Show
data MacroSpec where
MacroSpec :: (forall r. Args r [String]) -> MacroSpec
instance Show MacroSpec where
show :: MacroSpec -> String
show MacroSpec{} = String
"MacroSpec"
noMacroArguments :: MacroSpec
noMacroArguments :: MacroSpec
noMacroArguments = (forall r. Args r [String]) -> MacroSpec
MacroSpec ([String] -> Ap (Arg r) [String]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [])
parseMacroSpecs :: Text -> Either Text MacroSpec
parseMacroSpecs :: Text -> Either Text MacroSpec
parseMacroSpecs Text
txt =
case Parser MacroSpec -> Text -> Either String MacroSpec
forall a. Parser a -> Text -> Either String a
parseOnly (Parser MacroSpec
macroSpecs Parser MacroSpec -> Parser Text () -> Parser MacroSpec
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
forall t. Chunk t => Parser t ()
endOfInput) Text
txt of
Left String
e -> Text -> Either Text MacroSpec
forall a b. a -> Either a b
Left (String -> Text
Text.pack String
e)
Right MacroSpec
spec -> MacroSpec -> Either Text MacroSpec
forall a b. b -> Either a b
Right MacroSpec
spec
macroSpecs :: Parser MacroSpec
macroSpecs :: Parser MacroSpec
macroSpecs =
do Text
var <- (Char -> Bool) -> Parser Text
P.takeWhile1 Char -> Bool
isAlpha
Maybe Bool
mode <- Parser Text Bool -> Parser Text (Maybe Bool)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Bool
True Bool -> Parser Text Char -> Parser Text Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Text Char
char Char
'?' Parser Text Bool -> Parser Text Bool -> Parser Text Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool
False Bool -> Parser Text Char -> Parser Text Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Text Char
char Char
'*')
Parser Text ()
P.skipSpace
case Maybe Bool
mode of
Maybe Bool
Nothing -> Text -> MacroSpec -> MacroSpec
addReq Text
var (MacroSpec -> MacroSpec) -> Parser MacroSpec -> Parser MacroSpec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MacroSpec
macroSpecs
Just Bool
True -> Text -> MacroSpec -> MacroSpec
addOpt Text
var (MacroSpec -> MacroSpec) -> Parser MacroSpec -> Parser MacroSpec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MacroSpec
macroSpecs
Just Bool
False -> (forall r. Args r [String]) -> MacroSpec
MacroSpec (String -> [String]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> [String]) -> Ap (Arg r) String -> Ap (Arg r) [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Ap (Arg r) String
forall r. String -> Args r String
remainingArg (Text -> String
Text.unpack Text
var)) MacroSpec -> Parser Text () -> Parser MacroSpec
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser Text ()
forall t. Chunk t => Parser t ()
P.endOfInput
Parser MacroSpec -> Parser MacroSpec -> Parser MacroSpec
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> MacroSpec
noMacroArguments MacroSpec -> Parser Text () -> Parser MacroSpec
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser Text ()
forall t. Chunk t => Parser t ()
P.endOfInput
where
add1 :: Text -> Ap (Arg r) [String] -> Ap (Arg r) [String]
add1 Text
desc = (String -> [String] -> [String])
-> Ap (Arg r) String -> Ap (Arg r) [String] -> Ap (Arg r) [String]
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (:) (String -> Ap (Arg r) String
forall r. String -> Args r String
simpleToken (Text -> String
Text.unpack Text
desc))
addBrackets :: a -> a
addBrackets a
desc = a
"[" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
desc a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"]"
addOpt :: Text -> MacroSpec -> MacroSpec
addOpt Text
var (MacroSpec forall r. Args r [String]
rest) = (forall r. Args r [String]) -> MacroSpec
MacroSpec ([String] -> Maybe [String] -> [String]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [String] -> [String])
-> Ap (Arg r) (Maybe [String]) -> Ap (Arg r) [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ap (Arg r) [String] -> Ap (Arg r) (Maybe [String])
forall r a. Args r a -> Args r (Maybe a)
optionalArg (Text -> Ap (Arg r) [String] -> Ap (Arg r) [String]
forall r. Text -> Ap (Arg r) [String] -> Ap (Arg r) [String]
add1 (Text -> Text
forall a. (Semigroup a, IsString a) => a -> a
addBrackets Text
var) Ap (Arg r) [String]
forall r. Args r [String]
rest))
addReq :: Text -> MacroSpec -> MacroSpec
addReq Text
var (MacroSpec forall r. Args r [String]
rest) = (forall r. Args r [String]) -> MacroSpec
MacroSpec (Text -> Ap (Arg r) [String] -> Ap (Arg r) [String]
forall r. Text -> Ap (Arg r) [String] -> Ap (Arg r) [String]
add1 Text
var Ap (Arg r) [String]
forall r. Args r [String]
rest)
parseExpansion :: Text -> Either Text [ExpansionChunk]
parseExpansion :: Text -> Either Text [ExpansionChunk]
parseExpansion Text
txt =
case Parser [ExpansionChunk] -> Text -> Either String [ExpansionChunk]
forall a. Parser a -> Text -> Either String a
parseOnly (Parser Text ExpansionChunk -> Parser [ExpansionChunk]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser Text ExpansionChunk
parseChunk Parser [ExpansionChunk]
-> Parser Text () -> Parser [ExpansionChunk]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
forall t. Chunk t => Parser t ()
endOfInput) Text
txt of
Left String
e -> Text -> Either Text [ExpansionChunk]
forall a b. a -> Either a b
Left (String -> Text
Text.pack String
e)
Right [ExpansionChunk]
chunks -> [ExpansionChunk] -> Either Text [ExpansionChunk]
forall a b. b -> Either a b
Right [ExpansionChunk]
chunks
parseChunk :: Parser ExpansionChunk
parseChunk :: Parser Text ExpansionChunk
parseChunk =
[Parser Text ExpansionChunk] -> Parser Text ExpansionChunk
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice
[ Text -> ExpansionChunk
LiteralChunk (Text -> ExpansionChunk)
-> Parser Text -> Parser Text ExpansionChunk
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser Text
P.takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'$')
, Text -> ExpansionChunk
LiteralChunk Text
"$" ExpansionChunk -> Parser Text -> Parser Text ExpansionChunk
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
P.string Text
"$$"
, Text -> Parser Text
string Text
"${" Parser Text
-> Parser Text ExpansionChunk -> Parser Text ExpansionChunk
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text ExpansionChunk
parseDefaulted Parser Text ExpansionChunk
-> Parser Text Char -> Parser Text ExpansionChunk
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Text Char
char Char
'}'
, Char -> Parser Text Char
char Char
'$' Parser Text Char
-> Parser Text ExpansionChunk -> Parser Text ExpansionChunk
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text ExpansionChunk
parseVariable
]
parseDefaulted :: Parser ExpansionChunk
parseDefaulted :: Parser Text ExpansionChunk
parseDefaulted =
ExpansionChunk -> Maybe Text -> ExpansionChunk
construct
(ExpansionChunk -> Maybe Text -> ExpansionChunk)
-> Parser Text ExpansionChunk
-> Parser Text (Maybe Text -> ExpansionChunk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text ExpansionChunk
parseVariable
Parser Text (Maybe Text -> ExpansionChunk)
-> Parser Text (Maybe Text) -> Parser Text ExpansionChunk
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text -> Parser Text (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Char -> Parser Text Char
char Char
'|' Parser Text Char -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser Text
P.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'}'))
where
construct :: ExpansionChunk -> Maybe Text -> ExpansionChunk
construct ExpansionChunk
ch Maybe Text
Nothing = ExpansionChunk
ch
construct ExpansionChunk
ch (Just Text
l) = ExpansionChunk -> Text -> ExpansionChunk
DefaultChunk ExpansionChunk
ch Text
l
parseVariable :: Parser ExpansionChunk
parseVariable :: Parser Text ExpansionChunk
parseVariable = Integer -> ExpansionChunk
IntegerChunk (Integer -> ExpansionChunk)
-> Parser Text Integer -> Parser Text ExpansionChunk
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Integer
forall a. Integral a => Parser a
P.decimal
Parser Text ExpansionChunk
-> Parser Text ExpansionChunk -> Parser Text ExpansionChunk
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> ExpansionChunk
VariableChunk (Text -> ExpansionChunk)
-> Parser Text -> Parser Text ExpansionChunk
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser Text
P.takeWhile1 Char -> Bool
isAlpha
resolveMacroExpansions ::
Alternative f =>
(Text -> f Text) ->
(Integer -> f Text) ->
[ExpansionChunk] ->
f Text
resolveMacroExpansions :: (Text -> f Text)
-> (Integer -> f Text) -> [ExpansionChunk] -> f Text
resolveMacroExpansions Text -> f Text
var Integer -> f Text
arg [ExpansionChunk]
xs = [Text] -> Text
Text.concat ([Text] -> Text) -> f [Text] -> f Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ExpansionChunk -> f Text) -> [ExpansionChunk] -> f [Text]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ExpansionChunk -> f Text
resolve1 [ExpansionChunk]
xs
where
resolve1 :: ExpansionChunk -> f Text
resolve1 (LiteralChunk Text
lit) = Text -> f Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
lit
resolve1 (VariableChunk Text
v) = Text -> f Text
var Text
v
resolve1 (IntegerChunk Integer
i) = Integer -> f Text
arg Integer
i
resolve1 (DefaultChunk ExpansionChunk
p Text
d) = ExpansionChunk -> f Text
resolve1 ExpansionChunk
p f Text -> f Text -> f Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> f Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
d