{-# 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 Show
data Macro
= Macro
{ macroSpec :: MacroSpec
, macroCommands :: [[ExpansionChunk]]
} deriving Show
data MacroSpec where
MacroSpec :: (forall r. Args r [String]) -> MacroSpec
instance Show MacroSpec where
show MacroSpec{} = "MacroSpec"
noMacroArguments :: MacroSpec
noMacroArguments = MacroSpec (pure [])
parseMacroSpecs :: Text -> Maybe MacroSpec
parseMacroSpecs txt =
case parseOnly (macroSpecs <* endOfInput) txt of
Left{} -> Nothing
Right spec -> Just spec
macroSpecs :: Parser MacroSpec
macroSpecs =
cons <$> P.takeWhile1 isAlpha
<*> optional (char '?')
<* P.skipSpace
<*> macroSpecs
<|> pure (MacroSpec (pure []))
where
add1 desc = liftA2 (:) (simpleToken (Text.unpack desc))
cons desc (Just _) (MacroSpec rest) = MacroSpec (fromMaybe [] <$> optionalArg (add1 desc rest))
cons desc Nothing (MacroSpec rest) = MacroSpec (add1 desc rest)
parseExpansion :: Text -> Maybe [ExpansionChunk]
parseExpansion txt =
case parseOnly (many parseChunk <* endOfInput) txt of
Left{} -> Nothing
Right chunks -> Just chunks
parseChunk :: Parser ExpansionChunk
parseChunk =
choice
[ LiteralChunk <$> P.takeWhile1 (/= '$')
, LiteralChunk "$" <$ P.string "$$"
, string "${" *> parseDefaulted <* char '}'
, char '$' *> parseVariable
]
parseDefaulted :: Parser ExpansionChunk
parseDefaulted =
construct
<$> parseVariable
<*> optional (char '|' *> P.takeWhile1 (/= '}'))
where
construct ch Nothing = ch
construct ch (Just l) = DefaultChunk ch l
parseVariable :: Parser ExpansionChunk
parseVariable = IntegerChunk <$> P.decimal
<|> VariableChunk <$> P.takeWhile1 isAlpha
resolveMacroExpansions ::
(Text -> Maybe Text) ->
(Integer -> Maybe Text) ->
[ExpansionChunk] ->
Maybe Text
resolveMacroExpansions var arg xs = Text.concat <$> traverse resolve1 xs
where
resolve1 (LiteralChunk lit) = Just lit
resolve1 (VariableChunk v) = var v
resolve1 (IntegerChunk i) = arg i
resolve1 (DefaultChunk p d) = resolve1 p <|> Just d