{-# Language OverloadedStrings, GADTs, RankNTypes #-}

{-|
Module      : Client.Commands.Interpolation
Description : Parser and evaluator for string interpolation in commands
Copyright   : (c) Eric Mertens, 2016
License     : ISC
Maintainer  : emertens@gmail.com

This module is able to parse commands with inline variables and then
to evaluate those variables to produce a complete command that varies
by the current context.

Variables are built from 1 or more letters.

Optional arguments are suffixed with a @?@

Remaining text arguments are suffixed with a @*@

-}
module Client.Commands.Interpolation
  ( ExpansionChunk(..)
  , parseExpansion
  , resolveMacroExpansions
  , Macro(..)
  , MacroSpec(..)
  , parseMacroSpecs
  , noMacroArguments
  ) where

import Client.Commands.Arguments.Spec (optionalArg, remainingArg, simpleToken, Args)
import Control.Applicative (Alternative, liftA2, (<|>), many, optional)
import Data.Attoparsec.Text as P
import Data.Char (isAlpha)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import Data.Text qualified as Text

-- | Parsed chunk of an expandable command
data ExpansionChunk
  -- | regular text
  = LiteralChunk Text
  -- | inline variable @$x@ or @${x y}@
  | VariableChunk Text
  -- | inline variable @$1@ or @${1}@
  | IntegerChunk Integer
  -- | bracketed variable with default @${x|lit}@
  | DefaultChunk ExpansionChunk Text
  deriving Int -> ExpansionChunk -> ShowS
[ExpansionChunk] -> ShowS
ExpansionChunk -> String
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
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"

-- | Specification used when unspecified, no arguments.
noMacroArguments :: MacroSpec
noMacroArguments :: MacroSpec
noMacroArguments = (forall r. Args r [String]) -> MacroSpec
MacroSpec (forall (f :: * -> *) a. Applicative f => a -> f a
pure [])

parseMacroSpecs :: Text -> Either Text MacroSpec
parseMacroSpecs :: Text -> Either Text MacroSpec
parseMacroSpecs Text
txt =
  case forall a. Parser a -> Text -> Either String a
parseOnly (Parser Text MacroSpec
macroSpecs forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall t. Chunk t => Parser t ()
endOfInput) Text
txt of
    Left String
e     -> forall a b. a -> Either a b
Left (String -> Text
Text.pack String
e)
    Right MacroSpec
spec -> forall a b. b -> Either a b
Right MacroSpec
spec

macroSpecs :: Parser MacroSpec
macroSpecs :: Parser Text MacroSpec
macroSpecs =
  do Text
var <- (Char -> Bool) -> Parser Text
P.takeWhile1 Char -> Bool
isAlpha
     Maybe Bool
mode <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Bool
True forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Char
char Char
'?' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool
False forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Char
char Char
'*')
     Parser ()
P.skipSpace
     case Maybe Bool
mode of
       Maybe Bool
Nothing    -> Text -> MacroSpec -> MacroSpec
addReq Text
var forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text MacroSpec
macroSpecs
       Just Bool
True  -> Text -> MacroSpec -> MacroSpec
addOpt Text
var forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text MacroSpec
macroSpecs
       Just Bool
False -> (forall r. Args r [String]) -> MacroSpec
MacroSpec (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r. String -> Args r String
remainingArg (Text -> String
Text.unpack Text
var)) forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall t. Chunk t => Parser t ()
P.endOfInput
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> MacroSpec
noMacroArguments forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall t. Chunk t => Parser t ()
P.endOfInput
  where
    add1 :: Text -> Ap (Arg r) [String] -> Ap (Arg r) [String]
add1 Text
desc = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (:) (forall r. String -> Args r String
simpleToken (Text -> String
Text.unpack Text
desc))
    addBrackets :: a -> a
addBrackets a
desc = a
"[" forall a. Semigroup a => a -> a -> a
<> a
desc 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 (forall a. a -> Maybe a -> a
fromMaybe [] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r a. Args r a -> Args r (Maybe a)
optionalArg (forall {r}. Text -> Ap (Arg r) [String] -> Ap (Arg r) [String]
add1 (forall {a}. (Semigroup a, IsString a) => a -> a
addBrackets Text
var) 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 (forall {r}. Text -> Ap (Arg r) [String] -> Ap (Arg r) [String]
add1 Text
var forall r. Args r [String]
rest)

-- | Parse a 'Text' searching for the expansions as specified in
-- 'ExpansionChunk'. @$$@ is used to escape a single @$@.
parseExpansion :: Text -> Either Text [ExpansionChunk]
parseExpansion :: Text -> Either Text [ExpansionChunk]
parseExpansion Text
txt =
  case forall a. Parser a -> Text -> Either String a
parseOnly (forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser ExpansionChunk
parseChunk forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall t. Chunk t => Parser t ()
endOfInput) Text
txt of
    Left String
e       -> forall a b. a -> Either a b
Left (String -> Text
Text.pack String
e)
    Right [ExpansionChunk]
chunks -> forall a b. b -> Either a b
Right [ExpansionChunk]
chunks

parseChunk :: Parser ExpansionChunk
parseChunk :: Parser ExpansionChunk
parseChunk =
  forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice
    [ Text -> ExpansionChunk
LiteralChunk     forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser Text
P.takeWhile1 (forall a. Eq a => a -> a -> Bool
/= Char
'$')
    , Text -> ExpansionChunk
LiteralChunk Text
"$" forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$  Text -> Parser Text
P.string Text
"$$"
    , Text -> Parser Text
string Text
"${" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ExpansionChunk
parseDefaulted forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
char Char
'}'
    , Char -> Parser Char
char Char
'$' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ExpansionChunk
parseVariable
    ]

parseDefaulted :: Parser ExpansionChunk
parseDefaulted :: Parser ExpansionChunk
parseDefaulted =
  ExpansionChunk -> Maybe Text -> ExpansionChunk
construct
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ExpansionChunk
parseVariable
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Char -> Parser Char
char Char
'|' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser Text
P.takeWhile (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 ExpansionChunk
parseVariable = Integer -> ExpansionChunk
IntegerChunk  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Integral a => Parser a
P.decimal
            forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> ExpansionChunk
VariableChunk forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser Text
P.takeWhile1 Char -> Bool
isAlpha

-- | Attempt to expand all of the elements in the given list using
-- the two expansion functions. If the expansion of any chunk
-- fails the whole expansion fails.
resolveMacroExpansions ::
  Alternative f =>
  (Text    -> f Text) {- ^ variable resolution           -} ->
  (Integer -> f Text) {- ^ argument index resolution     -} ->
  [ExpansionChunk]    {- ^ chunks                        -} ->
  f Text              {- ^ concatenated, expanded chunks -}
resolveMacroExpansions :: forall (f :: * -> *).
Alternative f =>
(Text -> f Text)
-> (Integer -> f Text) -> [ExpansionChunk] -> f Text
resolveMacroExpansions Text -> f Text
var Integer -> f Text
arg [ExpansionChunk]
xs = [Text] -> Text
Text.concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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) = 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 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
d