<commit_before>-- |
-- Module      :  REPL.Haskeline
-- Copyright   :  (c) 2013-2016 Galois, Inc.
-- License     :  BSD3
-- Maintainer  :  <EMAIL>
-- Stability   :  provisional
-- Portability :  portable

{-# LANGUAGE CPP #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE PatternGuards #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module REPL.Haskeline where

import           Cryptol.REPL.Command
import           Cryptol.REPL.Monad
import           Cryptol.REPL.Trie
import           Cryptol.Utils.PP
import           Cryptol.Utils.Logger(stdoutLogger)
import           Cryptol.Utils.Ident(modNameToText, interactiveName)

import qualified Control.Exception as X
import           Control.Monad (guard, join)
import qualified Control.Monad.Trans.Class as MTL
#if !MIN_VERSION_base(4,14,0)
import           Control.Monad.Trans.Control
#endif
import           Data.Char (isAlphaNum, isSpace)
import           Data.Function (on)
import           Data.List (isPrefixOf,nub,sortBy,sort)
import           Data.Maybe(isJust)
import qualified Data.Set as Set
import qualified Data.Text as T (unpack)
import           System.Console.ANSI (setTitle, hSupportsANSI)
import           System.Console.Haskeline
import           System.Directory ( doesFileExist
                                  , getHomeDirectory
                                  , getCurrentDirectory)
import           System.FilePath ((</>))
import           System.IO (stdout)

import           Prelude ()
import           Prelude.Compat


-- | One REPL invocation, either from a file or from the terminal.
crySession :: Maybe FilePath -> Bool -> REPL CommandExitCode
crySession mbBatch stopOnError =
  do settings <- io (setHistoryFile (replSettings isBatch))
     let act = runInputTBehavior behavior settings (withInterrupt loop)
     if isBatch then asBatch act else act
  where
  (isBatch,behavior) = case mbBatch of
    Nothing   -> (False,defaultBehavior)
    Just path -> (True,useFile path)

  loop :: InputT REPL CommandExitCode
  loop =
    do ln <- getInputLines =<< MTL.lift getPrompt
       case ln of
         NoMoreLines -> return CommandOk
         Interrupted
           | isBatch && stopOnError -> return CommandError
           | otherwise -> loop
         NextLine line
           | all isSpace line -> loop
           | otherwise        -> doCommand line

  doCommand txt =
    case parseCommand findCommandExact txt of
      Nothing | isBatch && stopOnError  -> return CommandError
              | otherwise -> loop -- say somtething?
      Just cmd -> join $ MTL.lift $
        do status <- handleInterrupt (handleCtrlC CommandError) (runCommand cmd)
           case status of
             CommandError | isBatch && stopOnError -> return (return status)
             _ -> do goOn <- shouldContinue
                     return (if goOn then loop else return status)


data NextLine = NextLine String | NoMoreLines | Interrupted

getInputLines :: String -> InputT REPL NextLine
getInputLines = handleInterrupt (MTL.lift (handleCtrlC Interrupted)) . loop []
  where
  loop ls prompt =
    do mb <- getInputLine prompt
       let newPropmpt = map (\_ -> ' ') prompt
       case mb of
         Nothing -> return NoMoreLines
         Just l
           | not (null l) && last l == '\\' -> loop (init l : ls) newPropmpt
           | otherwise -> return $ NextLine $ unlines $ reverse $ l : ls

loadCryRC :: Cryptolrc -> REPL CommandExitCode
loadCryRC cryrc =
  case cryrc of
    CryrcDisabled   -> return CommandOk
    CryrcDefault    -> check [ getCurrentDirectory, getHomeDirectory ]
    CryrcFiles opts -> loadMany opts
  where
  check [] = return CommandOk
  check (place : others) =
    do dir <- io place
       let file = dir </> ".cryptolrc"
       present <- io (doesFileExist file)
       if present
         then crySession (Just file) True
         else check others

  loadMany []       = return CommandOk
  loadMany (f : fs) = do status <- crySession (Just f) True
                         case status of
                           CommandOk -> loadMany fs
                           _         -> return status

-- | Haskeline-specific repl implementation.
repl :: Cryptolrc -> Maybe FilePath -> Bool -> REPL () -> IO CommandExitCode
repl cryrc mbBatch stopOnError begin =
  runREPL (isJust mbBatch) stdoutLogger $
  do status <- loadCryRC cryrc
     case status of
       CommandOk -> begin >> crySession mbBatch stopOnError
       _         -> return status



-- | Try to set the history file.
setHistoryFile :: Settings REPL -> IO (Settings REPL)
setHistoryFile ss =
  do dir <- getHomeDirectory
     return ss { historyFile = Just (dir </> ".cryptol_history") }
   `X.catch` \(X.SomeException {}) -> return ss

-- | Haskeline settings for the REPL.
replSettings :: Bool -> Settings REPL
replSettings isBatch = Settings
  { complete       = cryptolCommand
  , historyFile    = Nothing
  , autoAddHistory = not isBatch
  }

-- .cryptolrc ------------------------------------------------------------------

-- | Configuration of @.cryptolrc@ file behavior. The default option
-- searches the following locations in order, and evaluates the first
-- file that exists in batch mode on interpreter startup:
--
-- 1. $PWD/.cryptolrc
-- 2. $HOME/.cryptolrc
--
-- If files are specified, they will all be evaluated, but none of the
-- default files will be (unless they are explicitly specified).
--
-- The disabled option inhibits any reading of any .cryptolrc files.
data Cryptolrc =
    CryrcDefault
  | CryrcDisabled
  | CryrcFiles [FilePath]
  deriving (Show)

-- Utilities -------------------------------------------------------------------

#if !MIN_VERSION_base(4,14,0)
instance MonadException REPL where<commit_msg>Select exceptions/MonadExceptions from haskeline version, not base.<commit_after>-- |
-- Module      :  REPL.Haskeline
-- Copyright   :  (c) 2013-2016 Galois, Inc.
-- License     :  BSD3
-- Maintainer  :  <EMAIL>
-- Stability   :  provisional
-- Portability :  portable

{-# LANGUAGE CPP #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE PatternGuards #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module REPL.Haskeline where

import           Cryptol.REPL.Command
import           Cryptol.REPL.Monad
import           Cryptol.REPL.Trie
import           Cryptol.Utils.PP
import           Cryptol.Utils.Logger(stdoutLogger)
import           Cryptol.Utils.Ident(modNameToText, interactiveName)

import qualified Control.Exception as X
import           Control.Monad (guard, join)
import qualified Control.Monad.Trans.Class as MTL
#if !MIN_VERSION_haskeline(0,8,0)
import           Control.Monad.Trans.Control
#endif
import           Data.Char (isAlphaNum, isSpace)
import           Data.Function (on)
import           Data.List (isPrefixOf,nub,sortBy,sort)
import           Data.Maybe(isJust)
import qualified Data.Set as Set
import qualified Data.Text as T (unpack)
import           System.Console.ANSI (setTitle, hSupportsANSI)
import           System.Console.Haskeline
import           System.Directory ( doesFileExist
                                  , getHomeDirectory
                                  , getCurrentDirectory)
import           System.FilePath ((</>))
import           System.IO (stdout)

import           Prelude ()
import           Prelude.Compat


-- | One REPL invocation, either from a file or from the terminal.
crySession :: Maybe FilePath -> Bool -> REPL CommandExitCode
crySession mbBatch stopOnError =
  do settings <- io (setHistoryFile (replSettings isBatch))
     let act = runInputTBehavior behavior settings (withInterrupt loop)
     if isBatch then asBatch act else act
  where
  (isBatch,behavior) = case mbBatch of
    Nothing   -> (False,defaultBehavior)
    Just path -> (True,useFile path)

  loop :: InputT REPL CommandExitCode
  loop =
    do ln <- getInputLines =<< MTL.lift getPrompt
       case ln of
         NoMoreLines -> return CommandOk
         Interrupted
           | isBatch && stopOnError -> return CommandError
           | otherwise -> loop
         NextLine line
           | all isSpace line -> loop
           | otherwise        -> doCommand line

  doCommand txt =
    case parseCommand findCommandExact txt of
      Nothing | isBatch && stopOnError  -> return CommandError
              | otherwise -> loop -- say somtething?
      Just cmd -> join $ MTL.lift $
        do status <- handleInterrupt (handleCtrlC CommandError) (runCommand cmd)
           case status of
             CommandError | isBatch && stopOnError -> return (return status)
             _ -> do goOn <- shouldContinue
                     return (if goOn then loop else return status)


data NextLine = NextLine String | NoMoreLines | Interrupted

getInputLines :: String -> InputT REPL NextLine
getInputLines = handleInterrupt (MTL.lift (handleCtrlC Interrupted)) . loop []
  where
  loop ls prompt =
    do mb <- getInputLine prompt
       let newPropmpt = map (\_ -> ' ') prompt
       case mb of
         Nothing -> return NoMoreLines
         Just l
           | not (null l) && last l == '\\' -> loop (init l : ls) newPropmpt
           | otherwise -> return $ NextLine $ unlines $ reverse $ l : ls

loadCryRC :: Cryptolrc -> REPL CommandExitCode
loadCryRC cryrc =
  case cryrc of
    CryrcDisabled   -> return CommandOk
    CryrcDefault    -> check [ getCurrentDirectory, getHomeDirectory ]
    CryrcFiles opts -> loadMany opts
  where
  check [] = return CommandOk
  check (place : others) =
    do dir <- io place
       let file = dir </> ".cryptolrc"
       present <- io (doesFileExist file)
       if present
         then crySession (Just file) True
         else check others

  loadMany []       = return CommandOk
  loadMany (f : fs) = do status <- crySession (Just f) True
                         case status of
                           CommandOk -> loadMany fs
                           _         -> return status

-- | Haskeline-specific repl implementation.
repl :: Cryptolrc -> Maybe FilePath -> Bool -> REPL () -> IO CommandExitCode
repl cryrc mbBatch stopOnError begin =
  runREPL (isJust mbBatch) stdoutLogger $
  do status <- loadCryRC cryrc
     case status of
       CommandOk -> begin >> crySession mbBatch stopOnError
       _         -> return status



-- | Try to set the history file.
setHistoryFile :: Settings REPL -> IO (Settings REPL)
setHistoryFile ss =
  do dir <- getHomeDirectory
     return ss { historyFile = Just (dir </> ".cryptol_history") }
   `X.catch` \(X.SomeException {}) -> return ss

-- | Haskeline settings for the REPL.
replSettings :: Bool -> Settings REPL
replSettings isBatch = Settings
  { complete       = cryptolCommand
  , historyFile    = Nothing
  , autoAddHistory = not isBatch
  }

-- .cryptolrc ------------------------------------------------------------------

-- | Configuration of @.cryptolrc@ file behavior. The default option
-- searches the following locations in order, and evaluates the first
-- file that exists in batch mode on interpreter startup:
--
-- 1. $PWD/.cryptolrc
-- 2. $HOME/.cryptolrc
--
-- If files are specified, they will all be evaluated, but none of the
-- default files will be (unless they are explicitly specified).
--
-- The disabled option inhibits any reading of any .cryptolrc files.
data Cryptolrc =
    CryrcDefault
  | CryrcDisabled
  | CryrcFiles [FilePath]
  deriving (Show)

-- Utilities -------------------------------------------------------------------

#if !MIN_VERSION_haskeline(0,8,0)
instance MonadException REPL where
{'fraction_non_alphanumeric': 0.10772854152128401, 'fraction_numerical': 0.00314026517794836, 'mean_word_length': 2.1523233434149023, 'pattern_counts': {'":': 0, '<': 35, '<?xml version=': 0, '>': 83, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 6, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '4088398', 'n_tokens_mistral': 3247, 'n_tokens_neox': 3114, 'n_words': 1033}