{-# LANGUAGE PatternGuards #-}
-- Copyright (c) 2005 Don Stewart - http://www.cse.unsw.edu.au/~dons
-- GPL version 2 or later (see http://www.gnu.org/copyleft/gpl.html)

-- Another progressive plugin. Compose two (for now) plugins transparently
-- A sort of mini interpreter. Could do with some more thinking.
module Lambdabot.Plugin.Core.Compose (composePlugin) where

import Lambdabot.Command
import Lambdabot.Module
import Lambdabot.Monad
import Lambdabot.Plugin

import Control.Arrow (first)
import Control.Monad
import Control.Monad.Reader
import Data.Char
import Data.List
import Data.List.Split

type Compose = ModuleT () LB

composePlugin :: Module ()
composePlugin :: Module ()
composePlugin = Module ()
forall st. Module st
newModule
    { moduleCmds :: ModuleT () LB [Command (ModuleT () LB)]
moduleCmds = [Command (ModuleT () LB)]
-> ModuleT () LB [Command (ModuleT () LB)]
forall (m :: * -> *) a. Monad m => a -> m a
return
        [ (String -> Command Identity
command String
"@")
            { aliases :: [String]
aliases = [String
"?"]
            , help :: Cmd (ModuleT () LB) ()
help = do
                String
c <- Cmd (ModuleT () LB) String
forall (m :: * -> *). Monad m => Cmd m String
getCmdName
                let cc :: String
cc = String
cString -> String -> String
forall a. [a] -> [a] -> [a]
++String
c
                (String -> Cmd (ModuleT () LB) ())
-> [String] -> Cmd (ModuleT () LB) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> Cmd (ModuleT () LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say
                    [ String
ccString -> String -> String
forall a. [a] -> [a] -> [a]
++String
" [args]."
                    , String
ccString -> String -> String
forall a. [a] -> [a] -> [a]
++String
" executes plugin invocations in its arguments, parentheses can be used."
                    , String
" The commands are right associative."
                    , String
" For example:    "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
ccString -> String -> String
forall a. [a] -> [a] -> [a]
++String
" "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
cString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"pl "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
cString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"undo code"
                    , String
" is the same as: "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
ccString -> String -> String
forall a. [a] -> [a] -> [a]
++String
" ("String -> String -> String
forall a. [a] -> [a] -> [a]
++String
cString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"pl ("String -> String -> String
forall a. [a] -> [a] -> [a]
++String
cString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"undo code))"
                    ]
            , process :: String -> Cmd (ModuleT () LB) ()
process = String -> Cmd (ModuleT () LB) ()
evalBracket
            }
        , (String -> Command Identity
command String
".")
            { aliases :: [String]
aliases = [String
"compose"]
            , help :: Cmd (ModuleT () LB) ()
help = (String -> Cmd (ModuleT () LB) ())
-> [String] -> Cmd (ModuleT () LB) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> Cmd (ModuleT () LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say
                [ String
". <cmd1> <cmd2> [args]."
                , String
". [or compose] is the composition of two plugins"
                , String
" The following semantics are used: . f g xs == g xs >>= f"
                ]
            , process :: String -> Cmd (ModuleT () LB) ()
process = \String
args -> case String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
" " String
args of
                (String
f:String
g:[String]
xs) -> do
                    String -> LB [String]
f' <- String -> Cmd (ModuleT () LB) (String -> LB [String])
lookupP String
f
                    String -> LB [String]
g' <- String -> Cmd (ModuleT () LB) (String -> LB [String])
lookupP String
g
                    LB [String] -> Cmd (ModuleT () LB) [String]
forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb ((String -> LB [String])
-> (String -> LB [String]) -> String -> LB [String]
compose String -> LB [String]
f' String -> LB [String]
g' ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
" " [String]
xs)) Cmd (ModuleT () LB) [String]
-> ([String] -> Cmd (ModuleT () LB) ()) -> Cmd (ModuleT () LB) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> Cmd (ModuleT () LB) ())
-> [String] -> Cmd (ModuleT () LB) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> Cmd (ModuleT () LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say
                [String]
_ -> String -> Cmd (ModuleT () LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"Not enough arguments to @."
            }
        ]
    }

-- | Compose two plugin functions
compose :: (String -> LB [String]) -> (String -> LB [String]) -> (String -> LB [String])
compose :: (String -> LB [String])
-> (String -> LB [String]) -> String -> LB [String]
compose String -> LB [String]
f String -> LB [String]
g String
xs = String -> LB [String]
g String
xs LB [String] -> ([String] -> LB [String]) -> LB [String]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> LB [String]
f (String -> LB [String])
-> ([String] -> String) -> [String] -> LB [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines

------------------------------------------------------------------------
-- | Lookup the `process' method we're after, and apply it to the dummy args
--
lookupP :: String -> Cmd Compose (String -> LB [String])
lookupP :: String -> Cmd (ModuleT () LB) (String -> LB [String])
lookupP String
cmd = (forall a.
 Message a =>
 a -> Cmd (ModuleT () LB) (String -> LB [String]))
-> Cmd (ModuleT () LB) (String -> LB [String])
forall (m :: * -> *) t.
Monad m =>
(forall a. Message a => a -> Cmd m t) -> Cmd m t
withMsg ((forall a.
  Message a =>
  a -> Cmd (ModuleT () LB) (String -> LB [String]))
 -> Cmd (ModuleT () LB) (String -> LB [String]))
-> (forall a.
    Message a =>
    a -> Cmd (ModuleT () LB) (String -> LB [String]))
-> Cmd (ModuleT () LB) (String -> LB [String])
forall a b. (a -> b) -> a -> b
$ \a
a -> do
    Nick
b <- Cmd (ModuleT () LB) Nick
forall (m :: * -> *). Monad m => Cmd m Nick
getTarget
    LB (String -> LB [String])
-> Cmd (ModuleT () LB) (String -> LB [String])
forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb (LB (String -> LB [String])
 -> Cmd (ModuleT () LB) (String -> LB [String]))
-> LB (String -> LB [String])
-> Cmd (ModuleT () LB) (String -> LB [String])
forall a b. (a -> b) -> a -> b
$ String
-> LB (String -> LB [String])
-> (forall st.
    Command (ModuleT st LB) -> ModuleT st LB (String -> LB [String]))
-> LB (String -> LB [String])
forall a.
String
-> LB a
-> (forall st. Command (ModuleT st LB) -> ModuleT st LB a)
-> LB a
withCommand String
cmd
        (String -> LB (String -> LB [String])
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> LB (String -> LB [String]))
-> String -> LB (String -> LB [String])
forall a b. (a -> b) -> a -> b
$ String
"Unknown command: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
cmd)
        (\Command (ModuleT st LB)
theCmd -> do
            Bool -> ModuleT st LB () -> ModuleT st LB ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Command (ModuleT st LB) -> Bool
forall (m :: * -> *). Command m -> Bool
privileged Command (ModuleT st LB)
theCmd) (ModuleT st LB () -> ModuleT st LB ())
-> ModuleT st LB () -> ModuleT st LB ()
forall a b. (a -> b) -> a -> b
$ String -> ModuleT st LB ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Privileged commands cannot be composed"
            ModuleID st
mTag <- (ModuleInfo st -> ModuleID st) -> ModuleT st LB (ModuleID st)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ModuleInfo st -> ModuleID st
forall st. ModuleInfo st -> ModuleID st
moduleID
            (String -> LB [String]) -> ModuleT st LB (String -> LB [String])
forall (m :: * -> *) a. Monad m => a -> m a
return (ModuleID st -> LB [String] -> ModuleT st LB [String] -> LB [String]
forall st a. ModuleID st -> LB a -> ModuleT st LB a -> LB a
inModuleWithID ModuleID st
mTag ([String] -> LB [String]
forall (m :: * -> *) a. Monad m => a -> m a
return []) (ModuleT st LB [String] -> LB [String])
-> (String -> ModuleT st LB [String]) -> String -> LB [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Command (ModuleT st LB)
-> a -> Nick -> String -> String -> ModuleT st LB [String]
forall (m :: * -> *) a.
(Monad m, Message a) =>
Command m -> a -> Nick -> String -> String -> m [String]
runCommand Command (ModuleT st LB)
theCmd a
a Nick
b String
cmd))

------------------------------------------------------------------------

-- | More interesting composition/evaluation
-- @@ @f x y (@g y z)
evalBracket :: String -> Cmd Compose ()
evalBracket :: String -> Cmd (ModuleT () LB) ()
evalBracket String
args = do
    [String]
cmdPrefixes <- Config [String] -> Cmd (ModuleT () LB) [String]
forall (m :: * -> *) a. MonadConfig m => Config a -> m a
getConfig Config [String]
commandPrefixes

    let conf :: [String]
conf = [String]
cmdPrefixes
    [[String]]
xs <- (Expr -> Cmd (ModuleT () LB) [String])
-> [Expr] -> Cmd (ModuleT () LB) [[String]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Expr -> Cmd (ModuleT () LB) [String]
evalExpr (([Expr], String) -> [Expr]
forall a b. (a, b) -> a
fst (Int -> Bool -> String -> [String] -> ([Expr], String)
parseBracket Int
0 Bool
True String
args [String]
conf))
    (String -> Cmd (ModuleT () LB) ())
-> [String] -> Cmd (ModuleT () LB) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> Cmd (ModuleT () LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say (String -> Cmd (ModuleT () LB) ())
-> (String -> String) -> String -> Cmd (ModuleT () LB) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
addSpace) ([[String]] -> [String]
forall a. [[[a]]] -> [[a]]
concat' [[String]]
xs)
 where concat' :: [[[a]]] -> [[a]]
concat' ([[a]
x]:[[a]
y]:[[[a]]]
xs) = [[[a]]] -> [[a]]
concat' ([[a]
x[a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++[a]
y][[a]] -> [[[a]]] -> [[[a]]]
forall a. a -> [a] -> [a]
:[[[a]]]
xs)
       concat' [[[a]]]
xs           = [[[a]]] -> [[a]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[[a]]]
xs

       addSpace :: String -> String
       addSpace :: String -> String
addSpace (Char
' ':String
xs) = Char
' 'Char -> String -> String
forall a. a -> [a] -> [a]
:String
xs
       addSpace String
xs       = Char
' 'Char -> String -> String
forall a. a -> [a] -> [a]
:String
xs

evalExpr :: Expr -> Cmd Compose [String]
evalExpr :: Expr -> Cmd (ModuleT () LB) [String]
evalExpr (Arg String
s) = [String] -> Cmd (ModuleT () LB) [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [String
s]
evalExpr (Cmd String
c [Expr]
args) = do
     [[String]]
args' <- (Expr -> Cmd (ModuleT () LB) [String])
-> [Expr] -> Cmd (ModuleT () LB) [[String]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Expr -> Cmd (ModuleT () LB) [String]
evalExpr [Expr]
args
     let arg :: String
arg = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[String]] -> [String]) -> [[String]] -> [String]
forall a b. (a -> b) -> a -> b
$ ([String] -> [String]) -> [[String]] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map (String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
" ") [[String]]
args'
     String -> LB [String]
cmd <- String -> Cmd (ModuleT () LB) (String -> LB [String])
lookupP String
c
     ModuleT () LB [String] -> Cmd (ModuleT () LB) [String]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (LB [String] -> ModuleT () LB [String]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (String -> LB [String]
cmd String
arg))

------------------------------------------------------------------------

data Expr = Cmd String [Expr]
          | Arg String
    deriving Int -> Expr -> String -> String
[Expr] -> String -> String
Expr -> String
(Int -> Expr -> String -> String)
-> (Expr -> String) -> ([Expr] -> String -> String) -> Show Expr
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Expr] -> String -> String
$cshowList :: [Expr] -> String -> String
show :: Expr -> String
$cshow :: Expr -> String
showsPrec :: Int -> Expr -> String -> String
$cshowsPrec :: Int -> Expr -> String -> String
Show

-- TODO: rewrite this using parsec or something
-- | Parse a command invocation that can contain parentheses
--   The Int indicates how many brackets must be closed to end the current argument, or 0
--   The Bool indicates if this is a valid location for a character constant
parseBracket :: Int -> Bool -> String -> [String] -> ([Expr],String)
parseBracket :: Int -> Bool -> String -> [String] -> ([Expr], String)
parseBracket Int
0 Bool
_ [] [String]
_       = ([],[])
parseBracket Int
_ Bool
_ [] [String]
_       = String -> ([Expr], String)
forall a. HasCallStack => String -> a
error String
"Missing ')' in nested command"
parseBracket Int
1 Bool
_ (Char
')':String
xs) [String]
_ = ([],String
xs)
parseBracket Int
n Bool
_ (Char
')':String
xs) [String]
c | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
                            = ([Expr] -> [Expr]) -> ([Expr], String) -> ([Expr], String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (String -> [Expr] -> [Expr]
addArg String
")") (([Expr], String) -> ([Expr], String))
-> ([Expr], String) -> ([Expr], String)
forall a b. (a -> b) -> a -> b
$ Int -> Bool -> String -> [String] -> ([Expr], String)
parseBracket (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Bool
True String
xs [String]
c
parseBracket Int
n Bool
_ (Char
'(':String
xs) [String]
c | Just String
ys <- String -> [String] -> Maybe String
isCommand String
xs [String]
c     -- (@cmd arg arg)
                            = Int -> String -> [String] -> ([Expr], String)
parseCommand Int
n String
ys [String]
c
parseBracket Int
n Bool
_ (Char
'(':String
xs) [String]
c | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
                            = ([Expr] -> [Expr]) -> ([Expr], String) -> ([Expr], String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (String -> [Expr] -> [Expr]
addArg String
"(") (([Expr], String) -> ([Expr], String))
-> ([Expr], String) -> ([Expr], String)
forall a b. (a -> b) -> a -> b
$ Int -> Bool -> String -> [String] -> ([Expr], String)
parseBracket (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Bool
True String
xs [String]
c
parseBracket Int
n Bool
_ String
xs [String]
c       | Just (Char
'(':String
ys) <- String -> [String] -> Maybe String
isCommand String
xs [String]
c -- @(cmd arg arg)
                            = Int -> String -> [String] -> ([Expr], String)
parseCommand Int
n String
ys [String]
c
parseBracket Int
n Bool
_ String
xs [String]
c       | Just String
ys <- String -> [String] -> Maybe String
isCommand String
xs [String]
c       -- @cmd arg arg
                            = Int -> String -> [String] -> ([Expr], String)
parseInlineCommand Int
n String
ys [String]
c
parseBracket Int
n Bool
c (Char
x:String
xs) [String]
cfg | Char
x Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"\"'" Bool -> Bool -> Bool
&& (Bool
c Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\'')
                            = let (String
str, String
ys) = Char -> String -> (String, String)
parseString Char
x String
xs
                                  ([Expr]
rest,String
zs) = Int -> Bool -> String -> [String] -> ([Expr], String)
parseBracket Int
n Bool
True String
ys [String]
cfg
                              in  (String -> [Expr] -> [Expr]
addArg (Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:String
str) [Expr]
rest, String
zs)
parseBracket Int
n Bool
c (Char
x:String
xs) [String]
cfg = ([Expr] -> [Expr]) -> ([Expr], String) -> ([Expr], String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (String -> [Expr] -> [Expr]
addArg [Char
x])
                            (([Expr], String) -> ([Expr], String))
-> ([Expr], String) -> ([Expr], String)
forall a b. (a -> b) -> a -> b
$ Int -> Bool -> String -> [String] -> ([Expr], String)
parseBracket Int
n (Bool -> Bool
not (Char -> Bool
isAlphaNum Char
x) Bool -> Bool -> Bool
&& (Bool
c Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\'')) String
xs [String]
cfg

parseCommand, parseInlineCommand :: Int -> String -> [String] -> ([Expr],String)
parseCommand :: Int -> String -> [String] -> ([Expr], String)
parseCommand Int
n String
xs [String]
conf = (String -> [Expr] -> Expr
Cmd String
cmd [Expr]
argsExpr -> [Expr] -> [Expr]
forall a. a -> [a] -> [a]
:[Expr]
rest, String
ws)
    where
        (String
cmd, String
ys) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
" )") String
xs
        ([Expr]
args,String
zs) = Int -> Bool -> String -> [String] -> ([Expr], String)
parseBracket Int
1 Bool
True ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
' ') String
ys) [String]
conf
        ([Expr]
rest,String
ws) = Int -> Bool -> String -> [String] -> ([Expr], String)
parseBracket Int
n Bool
True String
zs [String]
conf

parseInlineCommand :: Int -> String -> [String] -> ([Expr], String)
parseInlineCommand Int
n String
xs [String]
conf = (String -> [Expr] -> Expr
Cmd String
cmd [Expr]
restExpr -> [Expr] -> [Expr]
forall a. a -> [a] -> [a]
:[], String
zs)
  where
    (String
cmd, String
ys) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
" )") String
xs
    ([Expr]
rest,String
zs) = Int -> Bool -> String -> [String] -> ([Expr], String)
parseBracket Int
n Bool
True ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
' ') String
ys) [String]
conf

parseString :: Char -> String -> (String, String)
parseString :: Char -> String -> (String, String)
parseString Char
_     []          = ([],[])
parseString Char
delim (Char
'\\':Char
x:String
xs) = (String -> String) -> (String, String) -> (String, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (\String
ys -> Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:String
ys) (Char -> String -> (String, String)
parseString Char
delim String
xs)
parseString Char
delim (Char
x:String
xs)
  | Char
delim Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
x                = ([Char
x],String
xs)
  | Bool
otherwise                 = (String -> String) -> (String, String) -> (String, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:) (Char -> String -> (String, String)
parseString Char
delim String
xs)


-- | Does xs start with a command prefix?
isCommand :: String -> [String] -> Maybe String
isCommand :: String -> [String] -> Maybe String
isCommand String
xs = [Maybe String] -> Maybe String
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([Maybe String] -> Maybe String)
-> ([String] -> [Maybe String]) -> [String] -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Maybe String) -> [String] -> [Maybe String]
forall a b. (a -> b) -> [a] -> [b]
map String -> Maybe String
dropPrefix
 where dropPrefix :: String -> Maybe String
dropPrefix String
p
          | String
p String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
xs = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Int -> String -> String
forall a. Int -> [a] -> [a]
drop (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
p) String
xs
          | Bool
otherwise         = Maybe String
forall a. Maybe a
Nothing

addArg :: String -> [Expr] -> [Expr]
addArg :: String -> [Expr] -> [Expr]
addArg String
s (Arg String
a:[Expr]
es) = String -> Expr
Arg (String
sString -> String -> String
forall a. [a] -> [a] -> [a]
++String
a)Expr -> [Expr] -> [Expr]
forall a. a -> [a] -> [a]
:[Expr]
es
addArg String
s [Expr]
es         = String -> Expr
Arg String
s     Expr -> [Expr] -> [Expr]
forall a. a -> [a] -> [a]
:[Expr]
es