{-# LANGUAGE CPP                        #-}
{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE TemplateHaskell            #-}
{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  Yi.Mode.GHCi
-- License     :  GPL-2
-- Maintainer  :  yi-devel@googlegroups.com
-- Stability   :  experimental
-- Portability :  portable
--
-- A mode for GHCi, implemented as tweaks on Interaction mode

module Yi.Mode.GHCi where

import           GHC.Generics (Generic)

import           Lens.Micro.Platform           (makeLenses, (%~), (&), (.~))
import           Data.Binary          (Binary (..))
import           Data.Default         (Default (..))
import           Data.Text            ()
import qualified Data.Text            as T (findIndex)
import           Data.Typeable        (Typeable)
import           Yi.Buffer
import           Yi.Keymap            (YiM, topKeymapA)
import           Yi.Keymap.Keys       (Key (KHome), important, spec, (?>>!))
import           Yi.Lexer.Alex        (Tok)
import           Yi.Lexer.Compilation (Token ())
import qualified Yi.Mode.Interactive  as I (mode, spawnProcessMode)
import qualified Yi.Rope              as R (toText)
import           Yi.Syntax.OnlineTree (Tree)
import           Yi.Types             (YiVariable)

-- | The process name to use to spawn GHCi.
data GhciProcessName = GhciProcessName
  { GhciProcessName -> FilePath
_ghciProcessName :: FilePath
    -- ^ Command to run when spawning GHCi.
  , GhciProcessName -> [FilePath]
_ghciProcessArgs :: [String]
    -- ^ Args to pass to the process.
  } deriving (Typeable, Int -> GhciProcessName -> ShowS
[GhciProcessName] -> ShowS
GhciProcessName -> FilePath
(Int -> GhciProcessName -> ShowS)
-> (GhciProcessName -> FilePath)
-> ([GhciProcessName] -> ShowS)
-> Show GhciProcessName
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [GhciProcessName] -> ShowS
$cshowList :: [GhciProcessName] -> ShowS
show :: GhciProcessName -> FilePath
$cshow :: GhciProcessName -> FilePath
showsPrec :: Int -> GhciProcessName -> ShowS
$cshowsPrec :: Int -> GhciProcessName -> ShowS
Show, (forall x. GhciProcessName -> Rep GhciProcessName x)
-> (forall x. Rep GhciProcessName x -> GhciProcessName)
-> Generic GhciProcessName
forall x. Rep GhciProcessName x -> GhciProcessName
forall x. GhciProcessName -> Rep GhciProcessName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GhciProcessName x -> GhciProcessName
$cfrom :: forall x. GhciProcessName -> Rep GhciProcessName x
Generic)

-- | The process name defaults to @ghci@.
instance Default GhciProcessName where
  def :: GhciProcessName
def = GhciProcessName :: FilePath -> [FilePath] -> GhciProcessName
GhciProcessName { _ghciProcessName :: FilePath
_ghciProcessName = FilePath
"ghci"
                        , _ghciProcessArgs :: [FilePath]
_ghciProcessArgs = []
                        }

instance Binary GhciProcessName

makeLenses ''GhciProcessName

-- | Setting this is a bit like '(setq haskell-program-name foo)' in
-- emacs' @haskell-mode@.
instance YiVariable GhciProcessName

-- | Mode used for GHCi. Currently it just overrides 'KHome' key to go
-- just before the prompt through the use of 'homeKey'.
mode :: Mode (Tree (Tok Token))
mode :: Mode (Tree (Tok Token))
mode = Mode (Tree (Tok Token))
I.mode
  Mode (Tree (Tok Token))
-> (Mode (Tree (Tok Token)) -> Mode (Tree (Tok Token)))
-> Mode (Tree (Tok Token))
forall a b. a -> (a -> b) -> b
& (Text -> Identity Text)
-> Mode (Tree (Tok Token)) -> Identity (Mode (Tree (Tok Token)))
forall syntax. Lens' (Mode syntax) Text
modeNameA ((Text -> Identity Text)
 -> Mode (Tree (Tok Token)) -> Identity (Mode (Tree (Tok Token))))
-> Text -> Mode (Tree (Tok Token)) -> Mode (Tree (Tok Token))
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
"ghci"
  Mode (Tree (Tok Token))
-> (Mode (Tree (Tok Token)) -> Mode (Tree (Tok Token)))
-> Mode (Tree (Tok Token))
forall a b. a -> (a -> b) -> b
& ((KeymapSet -> KeymapSet) -> Identity (KeymapSet -> KeymapSet))
-> Mode (Tree (Tok Token)) -> Identity (Mode (Tree (Tok Token)))
forall syntax. Lens' (Mode syntax) (KeymapSet -> KeymapSet)
modeKeymapA (((KeymapSet -> KeymapSet) -> Identity (KeymapSet -> KeymapSet))
 -> Mode (Tree (Tok Token)) -> Identity (Mode (Tree (Tok Token))))
-> (KeymapSet -> KeymapSet)
-> Mode (Tree (Tok Token))
-> Mode (Tree (Tok Token))
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Keymap -> Identity Keymap) -> KeymapSet -> Identity KeymapSet
Lens' KeymapSet Keymap
topKeymapA ((Keymap -> Identity Keymap) -> KeymapSet -> Identity KeymapSet)
-> (Keymap -> Keymap) -> KeymapSet -> KeymapSet
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Keymap -> Keymap -> Keymap
forall (f :: * -> *) w e a.
MonadInteract f w e =>
f a -> f a -> f a
important (Key -> Event
spec Key
KHome Event -> BufferM () -> Keymap
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! BufferM ()
homeKey)

-- | The GHCi prompt always begins with ">"; this goes to just before
-- it, or if one is already at the start of the prompt, goes to the
-- beginning of the line. (If at the beginning of the line, this
-- pushes you forward to it.)
homeKey :: BufferM ()
homeKey :: BufferM ()
homeKey = BufferM YiString
readLnB BufferM YiString -> (YiString -> BufferM ()) -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \YiString
l -> case (Char -> Bool) -> Text -> Maybe Int
T.findIndex (Char
'>' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) (YiString -> Text
R.toText YiString
l) of
  Maybe Int
Nothing -> BufferM ()
moveToSol
  Just Int
pos -> do
    (Int
_,Int
mypos) <- BufferM (Int, Int)
getLineAndCol
    BufferM ()
moveToSol BufferM () -> BufferM () -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> if Int
mypos Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
                 then () -> BufferM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                 else Int -> BufferM ()
moveXorEol (Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)

-- | Spawns an interactive process ("Yi.Mode.Interactive") with GHCi
-- 'mode' over it.
spawnProcess :: FilePath -- ^ Command to use.
             -> [String] -- ^ Process args.
             -> YiM BufferRef -- ^ Reference to the spawned buffer.
spawnProcess :: FilePath -> [FilePath] -> YiM BufferRef
spawnProcess = Mode (Tree (Tok Token)) -> FilePath -> [FilePath] -> YiM BufferRef
forall syntax.
Mode syntax -> FilePath -> [FilePath] -> YiM BufferRef
I.spawnProcessMode Mode (Tree (Tok Token))
mode