-- |
-- Directives for PSCI.
--
module Language.PureScript.Interactive.Directive where

import Prelude

import Data.Maybe (fromJust)
import Data.List (isPrefixOf)
import Data.Tuple (swap)

import Language.PureScript.Interactive.Types (Directive(..))

-- |
-- A mapping of directives to the different strings that can be used to invoke
-- them.
--
directiveStrings :: [(Directive, [String])]
directiveStrings :: [(Directive, [String])]
directiveStrings =
    [ (Directive
Help      , [String
"?", String
"help"])
    , (Directive
Quit      , [String
"quit"])
    , (Directive
Reload    , [String
"reload"])
    , (Directive
Clear     , [String
"clear"])
    , (Directive
Browse    , [String
"browse"])
    , (Directive
Type      , [String
"type"])
    , (Directive
Kind      , [String
"kind"])
    , (Directive
Show      , [String
"show"])
    , (Directive
Paste     , [String
"paste"])
    , (Directive
Complete  , [String
"complete"])
    , (Directive
Print     , [String
"print"])
    ]

-- |
-- Like directiveStrings, but the other way around.
--
directiveStrings' :: [(String, Directive)]
directiveStrings' :: [(String, Directive)]
directiveStrings' = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {t} {a}. (t, [a]) -> [(a, t)]
go [(Directive, [String])]
directiveStrings
  where
  go :: (t, [a]) -> [(a, t)]
go (t
dir, [a]
strs) = forall a b. (a -> b) -> [a] -> [b]
map (, t
dir) [a]
strs

-- |
-- Returns all possible string representations of a directive.
--
stringsFor :: Directive -> [String]
stringsFor :: Directive -> [String]
stringsFor Directive
d = forall a. HasCallStack => Maybe a -> a
fromJust (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Directive
d [(Directive, [String])]
directiveStrings)

-- |
-- Returns the default string representation of a directive.
--
stringFor :: Directive -> String
stringFor :: Directive -> String
stringFor = forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. Directive -> [String]
stringsFor

-- |
-- Returns the list of directives which could be expanded from the string
-- argument, together with the string alias that matched.
--
directivesFor' :: String -> [(Directive, String)]
directivesFor' :: String -> [(Directive, String)]
directivesFor' String
str = [(String, Directive)] -> [(Directive, String)]
go [(String, Directive)]
directiveStrings'
  where
  go :: [(String, Directive)] -> [(Directive, String)]
go = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> (b, a)
swap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter ((String
str forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)

directivesFor :: String -> [Directive]
directivesFor :: String -> [Directive]
directivesFor = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [(Directive, String)]
directivesFor'

directiveStringsFor :: String -> [String]
directiveStringsFor :: String -> [String]
directiveStringsFor = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [(Directive, String)]
directivesFor'

-- |
-- The help menu.
--
help :: [(Directive, String, String)]
help :: [(Directive, String, String)]
help =
  [ (Directive
Help,     String
"",          String
"Show this help menu")
  , (Directive
Quit,     String
"",          String
"Quit PSCi")
  , (Directive
Reload,   String
"",          String
"Reload all imported modules while discarding bindings")
  , (Directive
Clear,    String
"",          String
"Discard all imported modules and declared bindings")
  , (Directive
Browse,   String
"<module>",  String
"See all functions in <module>")
  , (Directive
Type,     String
"<expr>",    String
"Show the type of <expr>")
  , (Directive
Kind,     String
"<type>",    String
"Show the kind of <type>")
  , (Directive
Show,     String
"import",    String
"Show all imported modules")
  , (Directive
Show,     String
"loaded",    String
"Show all loaded modules")
  , (Directive
Show,     String
"print",     String
"Show the repl's current printing function")
  , (Directive
Paste,    String
"paste",     String
"Enter multiple lines, terminated by ^D")
  , (Directive
Complete, String
"<prefix>",  String
"Show completions for <prefix> as if pressing tab")
  , (Directive
Print,    String
"<fn>",      String
"Set the repl's printing function to <fn> (which must be fully qualified)")
  ]