{- |
Module      : Language.Egison.Completion
Licence     : MIT

This module provides command-line completion.
-}

module Language.Egison.Completion
  ( completeEgison
  ) where

import           Data.HashMap.Strict         (keys)
import           Data.List
import           System.Console.Haskeline    (Completion (..), CompletionFunc, completeWord)

import           Language.Egison.Data        (Env (..))
import           Language.Egison.IExpr       (Var (..))
import           Language.Egison.Parser.NonS (lowerReservedWords, upperReservedWords)

-- |Complete Egison keywords
completeEgison :: Monad m => Env -> CompletionFunc m
completeEgison :: Env -> CompletionFunc m
completeEgison Env
_   arg :: (String, String)
arg@(Char
')':String
_, String
_) = CompletionFunc m
forall (m :: * -> *). Monad m => CompletionFunc m
completeParen (String, String)
arg
completeEgison Env
_   arg :: (String, String)
arg@(Char
']':String
_, String
_) = CompletionFunc m
forall (m :: * -> *). Monad m => CompletionFunc m
completeParen (String, String)
arg
completeEgison Env
_   arg :: (String, String)
arg@(Char
'(':String
_, String
_) = Maybe Char
-> String -> (String -> m [Completion]) -> CompletionFunc m
forall (m :: * -> *).
Monad m =>
Maybe Char
-> String -> (String -> m [Completion]) -> CompletionFunc m
completeWord Maybe Char
forall a. Maybe a
Nothing String
"" String -> m [Completion]
forall (m :: * -> *). Monad m => String -> m [Completion]
completeNothing (String, String)
arg
completeEgison Env
_   arg :: (String, String)
arg@(Char
' ':String
_, String
_) = Maybe Char
-> String -> (String -> m [Completion]) -> CompletionFunc m
forall (m :: * -> *).
Monad m =>
Maybe Char
-> String -> (String -> m [Completion]) -> CompletionFunc m
completeWord Maybe Char
forall a. Maybe a
Nothing String
"" String -> m [Completion]
forall (m :: * -> *). Monad m => String -> m [Completion]
completeNothing (String, String)
arg
completeEgison Env
_   arg :: (String, String)
arg@(Char
'[':String
_, String
_) = Maybe Char
-> String -> (String -> m [Completion]) -> CompletionFunc m
forall (m :: * -> *).
Monad m =>
Maybe Char
-> String -> (String -> m [Completion]) -> CompletionFunc m
completeWord Maybe Char
forall a. Maybe a
Nothing String
"" String -> m [Completion]
forall (m :: * -> *). Monad m => String -> m [Completion]
completeNothing (String, String)
arg
completeEgison Env
_   arg :: (String, String)
arg@([], String
_)    = Maybe Char
-> String -> (String -> m [Completion]) -> CompletionFunc m
forall (m :: * -> *).
Monad m =>
Maybe Char
-> String -> (String -> m [Completion]) -> CompletionFunc m
completeWord Maybe Char
forall a. Maybe a
Nothing String
"" String -> m [Completion]
forall (m :: * -> *). Monad m => String -> m [Completion]
completeNothing (String, String)
arg
completeEgison Env
env (String, String)
arg            = Maybe Char
-> String -> (String -> m [Completion]) -> CompletionFunc m
forall (m :: * -> *).
Monad m =>
Maybe Char
-> String -> (String -> m [Completion]) -> CompletionFunc m
completeWord Maybe Char
forall a. Maybe a
Nothing String
" \t[]{}$," (Env -> String -> m [Completion]
forall (m :: * -> *). Monad m => Env -> String -> m [Completion]
completeEgisonKeyword Env
env) (String, String)
arg

completeNothing :: Monad m => String -> m [Completion]
completeNothing :: String -> m [Completion]
completeNothing String
_ = [Completion] -> m [Completion]
forall (m :: * -> *) a. Monad m => a -> m a
return []

completeEgisonKeyword :: Monad m => Env -> String -> m [Completion]
completeEgisonKeyword :: Env -> String -> m [Completion]
completeEgisonKeyword (Env [HashMap Var ObjectRef]
env Maybe (String, [Index (Maybe ScalarData)])
_) String
str = do
  let definedWords :: [String]
definedWords = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
f ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (Var -> String) -> [Var] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(Var String
name [Index (Maybe Var)]
_) -> String
name) ([Var] -> [String]) -> [Var] -> [String]
forall a b. (a -> b) -> a -> b
$ (HashMap Var ObjectRef -> [Var])
-> [HashMap Var ObjectRef] -> [Var]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap HashMap Var ObjectRef -> [Var]
forall k v. HashMap k v -> [k]
keys [HashMap Var ObjectRef]
env
  [Completion] -> m [Completion]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Completion] -> m [Completion]) -> [Completion] -> m [Completion]
forall a b. (a -> b) -> a -> b
$ (String -> Completion) -> [String] -> [Completion]
forall a b. (a -> b) -> [a] -> [b]
map (\String
kwd -> String -> String -> Bool -> Completion
Completion String
kwd String
kwd Bool
False) ([String] -> [Completion]) -> [String] -> [Completion]
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
str) ([String]
egisonKeywords [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
definedWords)
 where
   f :: String -> Bool
f [Char
_]         = Bool
False
   f [Char
_, Char
'\'']   = Bool
False
   f (Char
'b':Char
'.':String
_) = Bool
False
   f String
_           = Bool
True

egisonKeywords :: [String]
egisonKeywords :: [String]
egisonKeywords = [String]
upperReservedWords [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
lowerReservedWords

completeParen :: Monad m => CompletionFunc m
completeParen :: CompletionFunc m
completeParen (String
lstr, String
_) = case String -> Maybe String
closeParen String
lstr of
  Maybe String
Nothing    -> (String, [Completion]) -> m (String, [Completion])
forall (m :: * -> *) a. Monad m => a -> m a
return (String
lstr, [])
  Just String
paren -> (String, [Completion]) -> m (String, [Completion])
forall (m :: * -> *) a. Monad m => a -> m a
return (String
lstr, [String -> String -> Bool -> Completion
Completion String
paren String
paren Bool
False])

closeParen :: String -> Maybe String
closeParen :: String -> Maybe String
closeParen String
str = Integer -> String -> Maybe String
closeParen' Integer
0 (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String -> String
removeCharAndStringLiteral String
str

removeCharAndStringLiteral :: String -> String
removeCharAndStringLiteral :: String -> String
removeCharAndStringLiteral []              = []
removeCharAndStringLiteral (Char
'"':Char
'\\':String
str)  = Char
'"'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:String -> String
removeCharAndStringLiteral String
str
removeCharAndStringLiteral (Char
'"':String
str)       = String -> String
removeCharAndStringLiteral' String
str
removeCharAndStringLiteral (Char
'\'':Char
'\\':String
str) = Char
'\''Char -> String -> String
forall a. a -> [a] -> [a]
:Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:String -> String
removeCharAndStringLiteral String
str
removeCharAndStringLiteral (Char
'\'':String
str)      = String -> String
removeCharAndStringLiteral' String
str
removeCharAndStringLiteral (Char
c:String
str)         = Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String -> String
removeCharAndStringLiteral String
str

removeCharAndStringLiteral' :: String -> String
removeCharAndStringLiteral' :: String -> String
removeCharAndStringLiteral' []              = []
removeCharAndStringLiteral' (Char
'"':Char
'\\':String
str)  = String -> String
removeCharAndStringLiteral' String
str
removeCharAndStringLiteral' (Char
'"':String
str)       = String -> String
removeCharAndStringLiteral String
str
removeCharAndStringLiteral' (Char
'\'':Char
'\\':String
str) = String -> String
removeCharAndStringLiteral' String
str
removeCharAndStringLiteral' (Char
'\'':String
str)      = String -> String
removeCharAndStringLiteral String
str
removeCharAndStringLiteral' (Char
_:String
str)         = String -> String
removeCharAndStringLiteral' String
str

closeParen' :: Integer -> String -> Maybe String
closeParen' :: Integer -> String -> Maybe String
closeParen' Integer
_ []        = Maybe String
forall a. Maybe a
Nothing
closeParen' Integer
0 (Char
'(':String
_)   = String -> Maybe String
forall a. a -> Maybe a
Just String
")"
closeParen' Integer
0 (Char
'[':String
_)   = String -> Maybe String
forall a. a -> Maybe a
Just String
"]"
closeParen' Integer
n (Char
'(':String
str) = Integer -> String -> Maybe String
closeParen' (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1) String
str
closeParen' Integer
n (Char
'[':String
str) = Integer -> String -> Maybe String
closeParen' (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1) String
str
closeParen' Integer
n (Char
')':String
str) = Integer -> String -> Maybe String
closeParen' (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1) String
str
closeParen' Integer
n (Char
']':String
str) = Integer -> String -> Maybe String
closeParen' (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1) String
str
closeParen' Integer
n (Char
_:String
str)   = Integer -> String -> Maybe String
closeParen' Integer
n String
str