ftshell-0.2: src/Evaluate.hs

-- Defines functions used in evaluating any input which is not a command.
module Evaluate (signatureCompletion, evaluate) where



import Control.Monad (liftM)
import Data.List (find, isPrefixOf, tails, sort)
import Data.Map as Map (elems)
import Data.Maybe (fromJust)
import Language.Haskell.FreeTheorems
import Language.Haskell.FreeTheorems.Syntax
import System.Console.Shell
import System.Console.Shell.ShellMonad

import Commands (cmdShowTheorem)
import ShellState



-- Provides completion support for type names entered directly at the prompt.
-- Checks against all known signature names.
signatureCompletion :: ShellState -> String -> IO [String]
signatureCompletion state input =
  return $ sort $ filter (isPrefixOf input) (getAllSignatureNames state)



-- Evaluate input at the prompt.
-- Consider any input starting with a colon as misspelled command name and
-- do nothing (it wouldn't be a proper signature, anyway).
-- Parse any other input, and if it contains a valid signature, change the
-- current context and show the according theorem.
evaluate :: String -> Sh ShellState ()
evaluate s =
  if ":" `isPrefixOf` s
    then shellPutStrLn "Ignored incomplete command."
    else do
      result <- parseInput s
      case result of
        Nothing  -> shellSpecial ShellNothing
        Just sig -> modifyShellSt (setCurrentContext sig) >> cmdShowTheorem



-- Parses the input and returns the parsed signature, if any.
-- If the input contains "::", then it is is parsed as a signature.
-- If the input is only one word, it is looked for in the list of all 
-- signatures. However, if there is no suitable list or if the input contains
-- more than one word, a new name is generated and prepended to the input
-- before it is parsed as a signature.
parseInput :: String -> Sh ShellState (Maybe ValidSignature)
parseInput s =
  if any (isPrefixOf "::") (tails s)
    then parseSignature s
    else
      case words s of
        []        -> return Nothing
        [x]       -> do maybeSig <- fromShellSt (findSignature x) 
                        case maybeSig of
                          Nothing -> createNewNameAndParse s
                          Just _  -> return maybeSig
        otherwise -> createNewNameAndParse s
  where
    createNewNameAndParse s = do
      n <- createNewSignatureName
      parseSignature (n ++ " :: " ++ s)
        


-- Creates a name for a signature which is different to any signature name
-- in the list of all signatures of the state.
createNewSignatureName :: Sh ShellState String
createNewSignatureName = do
  sigNames <- fromShellSt getAllSignatureNames
  let newNames = "f":map (\i -> "f" ++ show i) [1..]
  return $ fromJust $ find (\n -> not $ n `elem` sigNames) newNames



-- Tries to parse a string to a signature.
-- If successful, the parsed signature is added to the state and its name is
-- returned. Otherwise, an error message is printed.
parseSignature :: String -> Sh ShellState (Maybe ValidSignature)
parseSignature s = do
  parse <- fromShellSt getParser
  decls <- fromShellSt (concat . Map.elems . getAllDeclarations)
  let (vs,es) = runChecks (parse s >>= checkAgainst decls)
      sig     = filterSignatures vs
  if not (null es)
    then shellPutErrLn ("Error: " ++ show (head es)) >> return Nothing
    else case sig of
      []    -> shellPutErrLn errEmptySig >> return Nothing
      (s:_) -> do modifyShellSt (addUserSignature s)
                  return (Just s)
  where      
    errEmptySig = 
      "Error: The input was not recognised as a valid type signature."