{-# 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           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

-- | 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
(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"

-- | Specification used when unspecified, no arguments.
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)

-- | 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 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

-- | 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 :: (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