{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  Yi.Mode.Haskell
-- License     :  GPL-2
-- Maintainer  :  yi-devel@googlegroups.com
-- Stability   :  experimental
-- Portability :  portable
--
-- Collection of 'Mode's for working with Haskell.

module Yi.Mode.Haskell
  (
   -- * Modes
   haskellAbstract,
   cleverMode,
   preciseMode,
   literateMode,
   fastMode,

   -- * IO-level operations
   ghciGet,
   ghciSend,
   ghciLoadBuffer,
   ghciInferType,
   ghciSetProcessName,
   ghciSetProcessArgs
  ) where

import           Prelude                   hiding (all, concatMap, elem, error, notElem, exp)

import           Lens.Micro.Platform                ((&), (.~), (^.))
import           Control.Monad             (unless, void, when)
import           Data.Binary               (Binary)
import           Data.Default              (Default)
import           Data.Foldable             (all, concatMap, elem, forM_, notElem)
import           Data.Maybe                (isJust, listToMaybe)
import           Data.Monoid               ((<>))
import qualified Data.Text                 as T (any, concat, drop, pack, unpack, unwords)
import           Data.Typeable             (Typeable)
import           Text.Read                 (readMaybe)
import           Yi.Buffer
import           Yi.Core                   (sendToProcess)
import           Yi.Debug                  (error, trace)
import           Yi.Editor
import           Yi.File                   (fwriteE)
import qualified Yi.IncrementalParse       as IncrParser (State, scanner)
import           Yi.Keymap                 (YiM)
import           Yi.Lexer.Alex
import           Yi.Lexer.Haskell          as Haskell
import qualified Yi.Lexer.LiterateHaskell  as LiterateHaskell (HlState, alexScanToken, initState)
import           Yi.MiniBuffer             (noHint, withMinibufferFree, withMinibufferGen)
import qualified Yi.Mode.GHCi              as GHCi (ghciProcessArgs, ghciProcessName, spawnProcess)
import qualified Yi.Mode.Interactive       as Interactive (queryReply)
import           Yi.Mode.Common            (anyExtension, extensionOrContentsMatch, shebangParser)
import           Yi.Monad                  (gets)
import qualified Yi.Rope                   as R
import           Yi.String                 (fillText, showT)
import           Yi.Syntax                 (ExtHL (..), Scanner, skipScanner)
import qualified Yi.Syntax.Driver          as Driver (mkHighlighter)
import           Yi.Syntax.Haskell         as Hask
import           Yi.Syntax.Layout          (State)
import           Yi.Syntax.OnlineTree      as OnlineTree (Tree, manyToks)
import           Yi.Syntax.Paren           as Paren
import           Yi.Syntax.Strokes.Haskell as HS (getStrokes)
import           Yi.Syntax.Tree
import           Yi.Types                  (YiVariable)
import           Yi.Utils                  (groupBy')

-- | General ‘template’ for actual Haskell modes.
--
-- It applies over @extensions = ["hs", "x", "hsc", "hsinc"]@ which
-- may be a little questionable but for now Yi is mostly used by
-- Haskell hackers so it should be fine, at least for now.
haskellAbstract :: Mode (tree TT)
haskellAbstract :: Mode (tree TT)
haskellAbstract = Mode (tree TT)
forall syntax. Mode syntax
emptyMode
  Mode (tree TT)
-> (Mode (tree TT) -> Mode (tree TT)) -> Mode (tree TT)
forall a b. a -> (a -> b) -> b
& ((FilePath -> YiString -> Bool)
 -> Identity (FilePath -> YiString -> Bool))
-> Mode (tree TT) -> Identity (Mode (tree TT))
forall syntax. Lens' (Mode syntax) (FilePath -> YiString -> Bool)
modeAppliesA (((FilePath -> YiString -> Bool)
  -> Identity (FilePath -> YiString -> Bool))
 -> Mode (tree TT) -> Identity (Mode (tree TT)))
-> (FilePath -> YiString -> Bool)
-> Mode (tree TT)
-> Mode (tree TT)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [FilePath] -> Parser () -> FilePath -> YiString -> Bool
extensionOrContentsMatch [FilePath]
extensions (Parser Text -> Parser ()
forall a. Parser a -> Parser ()
shebangParser Parser Text
"runhaskell")
  Mode (tree TT)
-> (Mode (tree TT) -> Mode (tree TT)) -> Mode (tree TT)
forall a b. a -> (a -> b) -> b
& (Text -> Identity Text)
-> Mode (tree TT) -> Identity (Mode (tree TT))
forall syntax. Lens' (Mode syntax) Text
modeNameA ((Text -> Identity Text)
 -> Mode (tree TT) -> Identity (Mode (tree TT)))
-> Text -> Mode (tree TT) -> Mode (tree TT)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
"haskell"
  Mode (tree TT)
-> (Mode (tree TT) -> Mode (tree TT)) -> Mode (tree TT)
forall a b. a -> (a -> b) -> b
& (Maybe (BufferM ()) -> Identity (Maybe (BufferM ())))
-> Mode (tree TT) -> Identity (Mode (tree TT))
forall syntax. Lens' (Mode syntax) (Maybe (BufferM ()))
modeToggleCommentSelectionA ((Maybe (BufferM ()) -> Identity (Maybe (BufferM ())))
 -> Mode (tree TT) -> Identity (Mode (tree TT)))
-> Maybe (BufferM ()) -> Mode (tree TT) -> Mode (tree TT)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ BufferM () -> Maybe (BufferM ())
forall a. a -> Maybe a
Just (YiString -> BufferM ()
toggleCommentB YiString
"--")
  where extensions :: [FilePath]
extensions = [FilePath
"hs", FilePath
"x", FilePath
"hsc", FilePath
"hsinc"]

-- | "Clever" haskell mode, using the paren-matching syntax.
cleverMode :: Mode (Paren.Tree (Tok Haskell.Token))
cleverMode :: Mode (Tree TT)
cleverMode = Mode (Tree TT)
forall (tree :: * -> *). Mode (tree TT)
haskellAbstract
  Mode (Tree TT)
-> (Mode (Tree TT) -> Mode (Tree TT)) -> Mode (Tree TT)
forall a b. a -> (a -> b) -> b
& ((Tree TT -> IndentBehaviour -> BufferM ())
 -> Identity (Tree TT -> IndentBehaviour -> BufferM ()))
-> Mode (Tree TT) -> Identity (Mode (Tree TT))
forall syntax.
Lens' (Mode syntax) (syntax -> IndentBehaviour -> BufferM ())
modeIndentA (((Tree TT -> IndentBehaviour -> BufferM ())
  -> Identity (Tree TT -> IndentBehaviour -> BufferM ()))
 -> Mode (Tree TT) -> Identity (Mode (Tree TT)))
-> (Tree TT -> IndentBehaviour -> BufferM ())
-> Mode (Tree TT)
-> Mode (Tree TT)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Tree TT -> IndentBehaviour -> BufferM ()
cleverAutoIndentHaskellB
  Mode (Tree TT)
-> (Mode (Tree TT) -> Mode (Tree TT)) -> Mode (Tree TT)
forall a b. a -> (a -> b) -> b
& ((Tree TT -> Point -> Point -> Point -> [Stroke])
 -> Identity (Tree TT -> Point -> Point -> Point -> [Stroke]))
-> Mode (Tree TT) -> Identity (Mode (Tree TT))
forall syntax.
Lens' (Mode syntax) (syntax -> Point -> Point -> Point -> [Stroke])
modeGetStrokesA (((Tree TT -> Point -> Point -> Point -> [Stroke])
  -> Identity (Tree TT -> Point -> Point -> Point -> [Stroke]))
 -> Mode (Tree TT) -> Identity (Mode (Tree TT)))
-> (Tree TT -> Point -> Point -> Point -> [Stroke])
-> Mode (Tree TT)
-> Mode (Tree TT)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Tree TT -> Point -> Point -> Point -> [Stroke]
strokesOfParenTree
  Mode (Tree TT)
-> (Mode (Tree TT) -> Mode (Tree TT)) -> Mode (Tree TT)
forall a b. a -> (a -> b) -> b
& (ExtHL (Tree TT) -> Identity (ExtHL (Tree TT)))
-> Mode (Tree TT) -> Identity (Mode (Tree TT))
forall syntax. Lens' (Mode syntax) (ExtHL syntax)
modeHLA ((ExtHL (Tree TT) -> Identity (ExtHL (Tree TT)))
 -> Mode (Tree TT) -> Identity (Mode (Tree TT)))
-> ExtHL (Tree TT) -> Mode (Tree TT) -> Mode (Tree TT)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Scanner (State (State Token HlState) TT (Tree TT)) (Tree TT)
 -> Scanner (State (State Token HlState) TT (Tree TT)) (Tree TT))
-> CharToTTScanner HlState -> ExtHL (Tree TT)
forall (tree :: * -> *) state lexState tt.
(IsTree tree, Show state) =>
(Scanner (State (State Token lexState) TT (Tree TT)) (Tree TT)
 -> Scanner state (tree (Tok tt)))
-> CharToTTScanner lexState -> ExtHL (tree (Tok tt))
mkParenModeHL (HlState
-> Scanner (State (State Token HlState) TT (Tree TT)) (Tree TT)
-> Scanner (State (State Token HlState) TT (Tree TT)) (Tree TT)
forall st a. HlState -> Scanner st a -> Scanner st a
skipScanner HlState
50) CharToTTScanner HlState
haskellLexer
  Mode (Tree TT)
-> (Mode (Tree TT) -> Mode (Tree TT)) -> Mode (Tree TT)
forall a b. a -> (a -> b) -> b
& ((Tree TT -> BufferM ()) -> Identity (Tree TT -> BufferM ()))
-> Mode (Tree TT) -> Identity (Mode (Tree TT))
forall syntax. Lens' (Mode syntax) (syntax -> BufferM ())
modePrettifyA (((Tree TT -> BufferM ()) -> Identity (Tree TT -> BufferM ()))
 -> Mode (Tree TT) -> Identity (Mode (Tree TT)))
-> (Tree TT -> BufferM ()) -> Mode (Tree TT) -> Mode (Tree TT)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [TT] -> BufferM ()
cleverPrettify ([TT] -> BufferM ()) -> (Tree TT -> [TT]) -> Tree TT -> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree TT -> [TT]
forall (t :: * -> *) a. Foldable t => t a -> [a]
allToks

fastMode :: Mode (OnlineTree.Tree TT)
fastMode :: Mode (Tree TT)
fastMode = Mode (Tree TT)
forall (tree :: * -> *). Mode (tree TT)
haskellAbstract
  Mode (Tree TT)
-> (Mode (Tree TT) -> Mode (Tree TT)) -> Mode (Tree TT)
forall a b. a -> (a -> b) -> b
& (Text -> Identity Text)
-> Mode (Tree TT) -> Identity (Mode (Tree TT))
forall syntax. Lens' (Mode syntax) Text
modeNameA ((Text -> Identity Text)
 -> Mode (Tree TT) -> Identity (Mode (Tree TT)))
-> Text -> Mode (Tree TT) -> Mode (Tree TT)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
"fast haskell"
  Mode (Tree TT)
-> (Mode (Tree TT) -> Mode (Tree TT)) -> Mode (Tree TT)
forall a b. a -> (a -> b) -> b
& (ExtHL (Tree TT) -> Identity (ExtHL (Tree TT)))
-> Mode (Tree TT) -> Identity (Mode (Tree TT))
forall syntax. Lens' (Mode syntax) (ExtHL syntax)
modeHLA ((ExtHL (Tree TT) -> Identity (ExtHL (Tree TT)))
 -> Mode (Tree TT) -> Identity (Mode (Tree TT)))
-> ExtHL (Tree TT) -> Mode (Tree TT) -> Mode (Tree TT)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ CharToTTScanner HlState -> ExtHL (Tree TT)
forall st tt.
Show st =>
(CharScanner -> Scanner st (Tok tt)) -> ExtHL (Tree (Tok tt))
mkOnlineModeHL CharToTTScanner HlState
haskellLexer
  Mode (Tree TT)
-> (Mode (Tree TT) -> Mode (Tree TT)) -> Mode (Tree TT)
forall a b. a -> (a -> b) -> b
& ((Tree TT -> Point -> Point -> Point -> [Stroke])
 -> Identity (Tree TT -> Point -> Point -> Point -> [Stroke]))
-> Mode (Tree TT) -> Identity (Mode (Tree TT))
forall syntax.
Lens' (Mode syntax) (syntax -> Point -> Point -> Point -> [Stroke])
modeGetStrokesA (((Tree TT -> Point -> Point -> Point -> [Stroke])
  -> Identity (Tree TT -> Point -> Point -> Point -> [Stroke]))
 -> Mode (Tree TT) -> Identity (Mode (Tree TT)))
-> (Tree TT -> Point -> Point -> Point -> [Stroke])
-> Mode (Tree TT)
-> Mode (Tree TT)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (TT -> Stroke) -> Tree TT -> Point -> Point -> Point -> [Stroke]
forall (t3 :: * -> *) a b t t2 t1.
Foldable t3 =>
(a -> b) -> t3 a -> t -> t2 -> t1 -> [b]
tokenBasedStrokes TT -> Stroke
Paren.tokenToStroke

literateMode :: Mode (Paren.Tree TT)
literateMode :: Mode (Tree TT)
literateMode = Mode (Tree TT)
forall (tree :: * -> *). Mode (tree TT)
haskellAbstract
  Mode (Tree TT)
-> (Mode (Tree TT) -> Mode (Tree TT)) -> Mode (Tree TT)
forall a b. a -> (a -> b) -> b
& (Text -> Identity Text)
-> Mode (Tree TT) -> Identity (Mode (Tree TT))
forall syntax. Lens' (Mode syntax) Text
modeNameA ((Text -> Identity Text)
 -> Mode (Tree TT) -> Identity (Mode (Tree TT)))
-> Text -> Mode (Tree TT) -> Mode (Tree TT)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
"literate haskell"
  Mode (Tree TT)
-> (Mode (Tree TT) -> Mode (Tree TT)) -> Mode (Tree TT)
forall a b. a -> (a -> b) -> b
& ((FilePath -> YiString -> Bool)
 -> Identity (FilePath -> YiString -> Bool))
-> Mode (Tree TT) -> Identity (Mode (Tree TT))
forall syntax. Lens' (Mode syntax) (FilePath -> YiString -> Bool)
modeAppliesA (((FilePath -> YiString -> Bool)
  -> Identity (FilePath -> YiString -> Bool))
 -> Mode (Tree TT) -> Identity (Mode (Tree TT)))
-> (FilePath -> YiString -> Bool)
-> Mode (Tree TT)
-> Mode (Tree TT)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [FilePath] -> FilePath -> YiString -> Bool
forall a. [FilePath] -> FilePath -> a -> Bool
anyExtension [FilePath
"lhs"]
  Mode (Tree TT)
-> (Mode (Tree TT) -> Mode (Tree TT)) -> Mode (Tree TT)
forall a b. a -> (a -> b) -> b
& (ExtHL (Tree TT) -> Identity (ExtHL (Tree TT)))
-> Mode (Tree TT) -> Identity (Mode (Tree TT))
forall syntax. Lens' (Mode syntax) (ExtHL syntax)
modeHLA ((ExtHL (Tree TT) -> Identity (ExtHL (Tree TT)))
 -> Mode (Tree TT) -> Identity (Mode (Tree TT)))
-> ExtHL (Tree TT) -> Mode (Tree TT) -> Mode (Tree TT)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Scanner (State (State Token HlState) TT (Tree TT)) (Tree TT)
 -> Scanner (State (State Token HlState) TT (Tree TT)) (Tree TT))
-> CharToTTScanner HlState -> ExtHL (Tree TT)
forall (tree :: * -> *) state lexState tt.
(IsTree tree, Show state) =>
(Scanner (State (State Token lexState) TT (Tree TT)) (Tree TT)
 -> Scanner state (tree (Tok tt)))
-> CharToTTScanner lexState -> ExtHL (tree (Tok tt))
mkParenModeHL Scanner (State (State Token HlState) TT (Tree TT)) (Tree TT)
-> Scanner (State (State Token HlState) TT (Tree TT)) (Tree TT)
forall a. a -> a
id CharToTTScanner HlState
literateHaskellLexer
  Mode (Tree TT)
-> (Mode (Tree TT) -> Mode (Tree TT)) -> Mode (Tree TT)
forall a b. a -> (a -> b) -> b
& ((Tree TT -> Point -> Point -> Point -> [Stroke])
 -> Identity (Tree TT -> Point -> Point -> Point -> [Stroke]))
-> Mode (Tree TT) -> Identity (Mode (Tree TT))
forall syntax.
Lens' (Mode syntax) (syntax -> Point -> Point -> Point -> [Stroke])
modeGetStrokesA (((Tree TT -> Point -> Point -> Point -> [Stroke])
  -> Identity (Tree TT -> Point -> Point -> Point -> [Stroke]))
 -> Mode (Tree TT) -> Identity (Mode (Tree TT)))
-> (Tree TT -> Point -> Point -> Point -> [Stroke])
-> Mode (Tree TT)
-> Mode (Tree TT)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Tree TT -> Point -> Point -> Point -> [Stroke]
strokesOfParenTree
    -- FIXME I think that 'begin' should not be ignored
  Mode (Tree TT)
-> (Mode (Tree TT) -> Mode (Tree TT)) -> Mode (Tree TT)
forall a b. a -> (a -> b) -> b
& ((Tree TT -> IndentBehaviour -> BufferM ())
 -> Identity (Tree TT -> IndentBehaviour -> BufferM ()))
-> Mode (Tree TT) -> Identity (Mode (Tree TT))
forall syntax.
Lens' (Mode syntax) (syntax -> IndentBehaviour -> BufferM ())
modeIndentA (((Tree TT -> IndentBehaviour -> BufferM ())
  -> Identity (Tree TT -> IndentBehaviour -> BufferM ()))
 -> Mode (Tree TT) -> Identity (Mode (Tree TT)))
-> (Tree TT -> IndentBehaviour -> BufferM ())
-> Mode (Tree TT)
-> Mode (Tree TT)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Tree TT -> IndentBehaviour -> BufferM ()
cleverAutoIndentHaskellB
  Mode (Tree TT)
-> (Mode (Tree TT) -> Mode (Tree TT)) -> Mode (Tree TT)
forall a b. a -> (a -> b) -> b
& ((Tree TT -> BufferM ()) -> Identity (Tree TT -> BufferM ()))
-> Mode (Tree TT) -> Identity (Mode (Tree TT))
forall syntax. Lens' (Mode syntax) (syntax -> BufferM ())
modePrettifyA (((Tree TT -> BufferM ()) -> Identity (Tree TT -> BufferM ()))
 -> Mode (Tree TT) -> Identity (Mode (Tree TT)))
-> (Tree TT -> BufferM ()) -> Mode (Tree TT) -> Mode (Tree TT)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [TT] -> BufferM ()
cleverPrettify ([TT] -> BufferM ()) -> (Tree TT -> [TT]) -> Tree TT -> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree TT -> [TT]
forall (t :: * -> *) a. Foldable t => t a -> [a]
allToks

-- | Experimental Haskell mode, using a rather precise parser for the syntax.
preciseMode :: Mode (Hask.Tree TT)
preciseMode :: Mode (Tree TT)
preciseMode = Mode (Tree TT)
forall (tree :: * -> *). Mode (tree TT)
haskellAbstract
  Mode (Tree TT)
-> (Mode (Tree TT) -> Mode (Tree TT)) -> Mode (Tree TT)
forall a b. a -> (a -> b) -> b
& (Text -> Identity Text)
-> Mode (Tree TT) -> Identity (Mode (Tree TT))
forall syntax. Lens' (Mode syntax) Text
modeNameA ((Text -> Identity Text)
 -> Mode (Tree TT) -> Identity (Mode (Tree TT)))
-> Text -> Mode (Tree TT) -> Mode (Tree TT)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
"precise haskell"
  Mode (Tree TT)
-> (Mode (Tree TT) -> Mode (Tree TT)) -> Mode (Tree TT)
forall a b. a -> (a -> b) -> b
& ((Tree TT -> IndentBehaviour -> BufferM ())
 -> Identity (Tree TT -> IndentBehaviour -> BufferM ()))
-> Mode (Tree TT) -> Identity (Mode (Tree TT))
forall syntax.
Lens' (Mode syntax) (syntax -> IndentBehaviour -> BufferM ())
modeIndentA (((Tree TT -> IndentBehaviour -> BufferM ())
  -> Identity (Tree TT -> IndentBehaviour -> BufferM ()))
 -> Mode (Tree TT) -> Identity (Mode (Tree TT)))
-> (Tree TT -> IndentBehaviour -> BufferM ())
-> Mode (Tree TT)
-> Mode (Tree TT)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Tree TT -> IndentBehaviour -> BufferM ()
cleverAutoIndentHaskellC
  Mode (Tree TT)
-> (Mode (Tree TT) -> Mode (Tree TT)) -> Mode (Tree TT)
forall a b. a -> (a -> b) -> b
& ((Tree TT -> Point -> Point -> Point -> [Stroke])
 -> Identity (Tree TT -> Point -> Point -> Point -> [Stroke]))
-> Mode (Tree TT) -> Identity (Mode (Tree TT))
forall syntax.
Lens' (Mode syntax) (syntax -> Point -> Point -> Point -> [Stroke])
modeGetStrokesA (((Tree TT -> Point -> Point -> Point -> [Stroke])
  -> Identity (Tree TT -> Point -> Point -> Point -> [Stroke]))
 -> Mode (Tree TT) -> Identity (Mode (Tree TT)))
-> (Tree TT -> Point -> Point -> Point -> [Stroke])
-> Mode (Tree TT)
-> Mode (Tree TT)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (\Tree TT
ast Point
point Point
begin Point
end -> Point -> Point -> Point -> Tree TT -> [Stroke]
HS.getStrokes Point
point Point
begin Point
end Tree TT
ast)
  Mode (Tree TT)
-> (Mode (Tree TT) -> Mode (Tree TT)) -> Mode (Tree TT)
forall a b. a -> (a -> b) -> b
& (ExtHL (Tree TT) -> Identity (ExtHL (Tree TT)))
-> Mode (Tree TT) -> Identity (Mode (Tree TT))
forall syntax. Lens' (Mode syntax) (ExtHL syntax)
modeHLA ((ExtHL (Tree TT) -> Identity (ExtHL (Tree TT)))
 -> Mode (Tree TT) -> Identity (Mode (Tree TT)))
-> ExtHL (Tree TT) -> Mode (Tree TT) -> Mode (Tree TT)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ CharToTTScanner HlState -> ExtHL (Tree TT)
forall st. Show st => CharToTTScanner st -> ExtHL (Tree TT)
mkHaskModeHL CharToTTScanner HlState
haskellLexer
  Mode (Tree TT)
-> (Mode (Tree TT) -> Mode (Tree TT)) -> Mode (Tree TT)
forall a b. a -> (a -> b) -> b
& ((Tree TT -> BufferM ()) -> Identity (Tree TT -> BufferM ()))
-> Mode (Tree TT) -> Identity (Mode (Tree TT))
forall syntax. Lens' (Mode syntax) (syntax -> BufferM ())
modePrettifyA (((Tree TT -> BufferM ()) -> Identity (Tree TT -> BufferM ()))
 -> Mode (Tree TT) -> Identity (Mode (Tree TT)))
-> (Tree TT -> BufferM ()) -> Mode (Tree TT) -> Mode (Tree TT)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [TT] -> BufferM ()
cleverPrettify ([TT] -> BufferM ()) -> (Tree TT -> [TT]) -> Tree TT -> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree TT -> [TT]
forall (t :: * -> *) a. Foldable t => t a -> [a]
allToks
--
strokesOfParenTree :: Paren.Tree TT -> Point -> Point -> Point -> [Stroke]
strokesOfParenTree :: Tree TT -> Point -> Point -> Point -> [Stroke]
strokesOfParenTree Tree TT
t Point
p Point
b Point
e = Point -> Point -> Point -> Tree TT -> [Stroke]
Paren.getStrokes Point
p Point
b Point
e Tree TT
t

type CharToTTScanner s = CharScanner -> Scanner (AlexState s) TT

mkParenModeHL :: (IsTree tree, Show state)
              => (Scanner
                  (IncrParser.State (State Token lexState) TT (Paren.Tree TT))
                  (Paren.Tree TT)
                  -> Scanner state (tree (Tok tt)))
              -> CharToTTScanner lexState
              -> ExtHL (tree (Tok tt))
mkParenModeHL :: (Scanner (State (State Token lexState) TT (Tree TT)) (Tree TT)
 -> Scanner state (tree (Tok tt)))
-> CharToTTScanner lexState -> ExtHL (tree (Tok tt))
mkParenModeHL Scanner (State (State Token lexState) TT (Tree TT)) (Tree TT)
-> Scanner state (tree (Tok tt))
f CharToTTScanner lexState
l = Highlighter (Cache state tree tt) (tree (Tok tt))
-> ExtHL (tree (Tok tt))
forall syntax cache. Highlighter cache syntax -> ExtHL syntax
ExtHL (Highlighter (Cache state tree tt) (tree (Tok tt))
 -> ExtHL (tree (Tok tt)))
-> Highlighter (Cache state tree tt) (tree (Tok tt))
-> ExtHL (tree (Tok tt))
forall a b. (a -> b) -> a -> b
$ (CharScanner -> Scanner state (tree (Tok tt)))
-> Highlighter (Cache state tree tt) (tree (Tok tt))
forall state (tree :: * -> *) tt.
(IsTree tree, Show state) =>
(CharScanner -> Scanner state (tree (Tok tt)))
-> Highlighter (Cache state tree tt) (tree (Tok tt))
Driver.mkHighlighter CharScanner -> Scanner state (tree (Tok tt))
scnr
  where
    scnr :: CharScanner -> Scanner state (tree (Tok tt))
scnr = Scanner (State (State Token lexState) TT (Tree TT)) (Tree TT)
-> Scanner state (tree (Tok tt))
f (Scanner (State (State Token lexState) TT (Tree TT)) (Tree TT)
 -> Scanner state (tree (Tok tt)))
-> (CharScanner
    -> Scanner (State (State Token lexState) TT (Tree TT)) (Tree TT))
-> CharScanner
-> Scanner state (tree (Tok tt))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser TT (Tree TT)
-> Scanner (State Token lexState) TT
-> Scanner (State (State Token lexState) TT (Tree TT)) (Tree TT)
forall st token result.
Parser token result
-> Scanner st token -> Scanner (State st token result) result
IncrParser.scanner Parser TT (Tree TT)
Paren.parse (Scanner (State Token lexState) TT
 -> Scanner (State (State Token lexState) TT (Tree TT)) (Tree TT))
-> (CharScanner -> Scanner (State Token lexState) TT)
-> CharScanner
-> Scanner (State (State Token lexState) TT (Tree TT)) (Tree TT)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scanner (AlexState lexState) TT
-> Scanner (State Token lexState) TT
forall lexState.
Scanner (AlexState lexState) TT
-> Scanner (State Token lexState) TT
Paren.indentScanner (Scanner (AlexState lexState) TT
 -> Scanner (State Token lexState) TT)
-> CharToTTScanner lexState
-> CharScanner
-> Scanner (State Token lexState) TT
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CharToTTScanner lexState
l

mkHaskModeHL :: Show st => CharToTTScanner st -> ExtHL (Exp (Tok Token))
mkHaskModeHL :: CharToTTScanner st -> ExtHL (Tree TT)
mkHaskModeHL CharToTTScanner st
l = Highlighter
  (Cache (State (State Token st) TT (Tree TT)) Exp Token) (Tree TT)
-> ExtHL (Tree TT)
forall syntax cache. Highlighter cache syntax -> ExtHL syntax
ExtHL (Highlighter
   (Cache (State (State Token st) TT (Tree TT)) Exp Token) (Tree TT)
 -> ExtHL (Tree TT))
-> Highlighter
     (Cache (State (State Token st) TT (Tree TT)) Exp Token) (Tree TT)
-> ExtHL (Tree TT)
forall a b. (a -> b) -> a -> b
$ (CharScanner
 -> Scanner (State (State Token st) TT (Tree TT)) (Tree TT))
-> Highlighter
     (Cache (State (State Token st) TT (Tree TT)) Exp Token) (Tree TT)
forall state (tree :: * -> *) tt.
(IsTree tree, Show state) =>
(CharScanner -> Scanner state (tree (Tok tt)))
-> Highlighter (Cache state tree tt) (tree (Tok tt))
Driver.mkHighlighter CharScanner
-> Scanner (State (State Token st) TT (Tree TT)) (Tree TT)
scnr
  where
    scnr :: CharScanner
-> Scanner (State (State Token st) TT (Tree TT)) (Tree TT)
scnr = Parser TT (Tree TT)
-> Scanner (State Token st) TT
-> Scanner (State (State Token st) TT (Tree TT)) (Tree TT)
forall st token result.
Parser token result
-> Scanner st token -> Scanner (State st token result) result
IncrParser.scanner Parser TT (Tree TT)
Hask.parse (Scanner (State Token st) TT
 -> Scanner (State (State Token st) TT (Tree TT)) (Tree TT))
-> (CharScanner -> Scanner (State Token st) TT)
-> CharScanner
-> Scanner (State (State Token st) TT (Tree TT)) (Tree TT)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scanner (AlexState st) TT -> Scanner (State Token st) TT
forall lexState.
Scanner (AlexState lexState) TT
-> Scanner (State Token lexState) TT
Hask.indentScanner (Scanner (AlexState st) TT -> Scanner (State Token st) TT)
-> CharToTTScanner st -> CharScanner -> Scanner (State Token st) TT
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CharToTTScanner st
l

mkOnlineModeHL :: Show st => (CharScanner -> Scanner st (Tok tt))
               -> ExtHL (OnlineTree.Tree (Tok tt))
mkOnlineModeHL :: (CharScanner -> Scanner st (Tok tt)) -> ExtHL (Tree (Tok tt))
mkOnlineModeHL CharScanner -> Scanner st (Tok tt)
l = Highlighter
  (Cache (State st (Tok tt) (Tree (Tok tt))) Tree tt) (Tree (Tok tt))
-> ExtHL (Tree (Tok tt))
forall syntax cache. Highlighter cache syntax -> ExtHL syntax
ExtHL (Highlighter
   (Cache (State st (Tok tt) (Tree (Tok tt))) Tree tt) (Tree (Tok tt))
 -> ExtHL (Tree (Tok tt)))
-> Highlighter
     (Cache (State st (Tok tt) (Tree (Tok tt))) Tree tt) (Tree (Tok tt))
-> ExtHL (Tree (Tok tt))
forall a b. (a -> b) -> a -> b
$ (CharScanner
 -> Scanner (State st (Tok tt) (Tree (Tok tt))) (Tree (Tok tt)))
-> Highlighter
     (Cache (State st (Tok tt) (Tree (Tok tt))) Tree tt) (Tree (Tok tt))
forall state (tree :: * -> *) tt.
(IsTree tree, Show state) =>
(CharScanner -> Scanner state (tree (Tok tt)))
-> Highlighter (Cache state tree tt) (tree (Tok tt))
Driver.mkHighlighter CharScanner
-> Scanner (State st (Tok tt) (Tree (Tok tt))) (Tree (Tok tt))
scnr
  where
    scnr :: CharScanner
-> Scanner (State st (Tok tt) (Tree (Tok tt))) (Tree (Tok tt))
scnr = Parser (Tok tt) (Tree (Tok tt))
-> Scanner st (Tok tt)
-> Scanner (State st (Tok tt) (Tree (Tok tt))) (Tree (Tok tt))
forall st token result.
Parser token result
-> Scanner st token -> Scanner (State st token result) result
IncrParser.scanner Parser (Tok tt) (Tree (Tok tt))
forall t. P (Tok t) (Tree (Tok t))
OnlineTree.manyToks (Scanner st (Tok tt)
 -> Scanner (State st (Tok tt) (Tree (Tok tt))) (Tree (Tok tt)))
-> (CharScanner -> Scanner st (Tok tt))
-> CharScanner
-> Scanner (State st (Tok tt) (Tree (Tok tt))) (Tree (Tok tt))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CharScanner -> Scanner st (Tok tt)
l

haskellLexer :: CharScanner -> Scanner (AlexState Haskell.HlState) TT
haskellLexer :: CharToTTScanner HlState
haskellLexer = Lexer AlexState HlState TT AlexInput -> CharToTTScanner HlState
forall (l :: * -> *) s t i.
Lexer l s t i -> CharScanner -> Scanner (l s) t
lexScanner ((ASI HlState -> Maybe (TT, ASI HlState))
-> HlState -> Lexer AlexState HlState TT AlexInput
forall s t.
(ASI s -> Maybe (Tok t, ASI s))
-> s -> Lexer AlexState s (Tok t) AlexInput
commonLexer ASI HlState -> Maybe (TT, ASI HlState)
Haskell.alexScanToken HlState
Haskell.initState)

literateHaskellLexer :: CharScanner -> Scanner (AlexState LiterateHaskell.HlState) TT
literateHaskellLexer :: CharToTTScanner HlState
literateHaskellLexer = Lexer AlexState HlState TT AlexInput -> CharToTTScanner HlState
forall (l :: * -> *) s t i.
Lexer l s t i -> CharScanner -> Scanner (l s) t
lexScanner ((ASI HlState -> Maybe (TT, ASI HlState))
-> HlState -> Lexer AlexState HlState TT AlexInput
forall s t.
(ASI s -> Maybe (Tok t, ASI s))
-> s -> Lexer AlexState s (Tok t) AlexInput
commonLexer ASI HlState -> Maybe (TT, ASI HlState)
LiterateHaskell.alexScanToken HlState
LiterateHaskell.initState)

-- | Returns true if the token should be indented to look as "inside"
-- the group.
insideGroup :: Token -> Bool
insideGroup :: Token -> Bool
insideGroup (Special Char
c) = (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c) Text
"',;})]"
insideGroup Token
_ = Bool
True

-- | Helper method for taking information needed for both Haskell auto-indenters:
indentInfoB :: BufferM (Int, Int, Int, Point, Point)
indentInfoB :: BufferM (HlState, HlState, HlState, Point, Point)
indentInfoB = do
  HlState
indentLevel    <- IndentSettings -> HlState
shiftWidth (IndentSettings -> HlState)
-> BufferM IndentSettings -> BufferM HlState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM IndentSettings
indentSettingsB
  HlState
previousIndent <- YiString -> BufferM HlState
indentOfB (YiString -> BufferM HlState)
-> BufferM YiString -> BufferM HlState
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Direction -> BufferM YiString
getNextNonBlankLineB Direction
Backward
  HlState
nextIndent     <- YiString -> BufferM HlState
indentOfB (YiString -> BufferM HlState)
-> BufferM YiString -> BufferM HlState
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Direction -> BufferM YiString
getNextNonBlankLineB Direction
Forward
  Point
solPnt         <- BufferM () -> BufferM Point
forall a. BufferM a -> BufferM Point
pointAt BufferM ()
moveToSol
  Point
eolPnt         <- BufferM () -> BufferM Point
forall a. BufferM a -> BufferM Point
pointAt BufferM ()
moveToEol
  (HlState, HlState, HlState, Point, Point)
-> BufferM (HlState, HlState, HlState, Point, Point)
forall (m :: * -> *) a. Monad m => a -> m a
return (HlState
indentLevel, HlState
previousIndent, HlState
nextIndent, Point
solPnt, Point
eolPnt)

cleverAutoIndentHaskellB :: Paren.Tree TT -> IndentBehaviour -> BufferM ()
cleverAutoIndentHaskellB :: Tree TT -> IndentBehaviour -> BufferM ()
cleverAutoIndentHaskellB Tree TT
e IndentBehaviour
behaviour = do
  (HlState
indentLevel, HlState
previousIndent, HlState
nextIndent, Point
solPnt, Point
eolPnt) <- BufferM (HlState, HlState, HlState, Point, Point)
indentInfoB
  let onThisLine :: Point -> Bool
onThisLine Point
ofs = Point
ofs Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
>= Point
solPnt Bool -> Bool -> Bool
&& Point
ofs Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
<= Point
eolPnt
      firstTokNotOnLine :: [Tree TT] -> Maybe TT
firstTokNotOnLine = [TT] -> Maybe TT
forall a. [a] -> Maybe a
listToMaybe ([TT] -> Maybe TT) -> ([Tree TT] -> [TT]) -> [Tree TT] -> Maybe TT
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                              (TT -> Bool) -> [TT] -> [TT]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (TT -> Bool) -> TT -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point -> Bool
onThisLine (Point -> Bool) -> (TT -> Point) -> TT -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Posn -> Point
posnOfs (Posn -> Point) -> (TT -> Posn) -> TT -> Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TT -> Posn
forall t. Tok t -> Posn
tokPosn) ([TT] -> [TT]) -> ([Tree TT] -> [TT]) -> [Tree TT] -> [TT]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                              (TT -> Bool) -> [TT] -> [TT]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (TT -> Bool) -> TT -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token -> Bool
isErrorTok (Token -> Bool) -> (TT -> Token) -> TT -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TT -> Token
forall t. Tok t -> t
tokT) ([TT] -> [TT]) -> ([Tree TT] -> [TT]) -> [Tree TT] -> [TT]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tree TT -> [TT]) -> [Tree TT] -> [TT]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Tree TT -> [TT]
forall (t :: * -> *) a. Foldable t => t a -> [a]
allToks
  let stopsOf :: [Paren.Tree TT] -> [Int]
      stopsOf :: [Tree TT] -> [HlState]
stopsOf (g :: Tree TT
g@(Paren.Paren TT
open [Tree TT]
ctnt TT
close):[Tree TT]
ts')
          | Token -> Bool
isErrorTok (TT -> Token
forall t. Tok t -> t
tokT TT
close) Bool -> Bool -> Bool
|| Tree TT -> Point
forall (t :: * -> *) t1. Foldable t => t (Tok t1) -> Point
getLastOffset Tree TT
g Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
>= Point
solPnt
              = [TT -> [Tree TT] -> HlState
groupIndent TT
open [Tree TT]
ctnt]  -- stop here: we want to be "inside" that group.
          | Bool
otherwise = [Tree TT] -> [HlState]
stopsOf [Tree TT]
ts' -- this group is closed before this line; just skip it.
      stopsOf (Paren.Atom (Tok {tokT :: forall t. Tok t -> t
tokT = Token
t}):[Tree TT]
_) | Token -> Bool
startsLayout Token
t = [HlState
nextIndent, HlState
previousIndent HlState -> HlState -> HlState
forall a. Num a => a -> a -> a
+ HlState
indentLevel]
        -- of; where; etc. we want to start the block here.
        -- Also use the next line's indent:
        -- maybe we are putting a new 1st statement in the block here.
      stopsOf (Paren.Atom TT
_:[Tree TT]
ts) = [Tree TT] -> [HlState]
stopsOf [Tree TT]
ts
         -- any random part of expression, we ignore it.
      stopsOf (t :: Tree TT
t@(Paren.Block [Tree TT]
_):[Tree TT]
ts) = HlState
shiftBlock HlState -> HlState -> HlState
forall a. Num a => a -> a -> a
+ HlState -> (TT -> HlState) -> Maybe TT -> HlState
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HlState
0 (Posn -> HlState
posnCol (Posn -> HlState) -> (TT -> Posn) -> TT -> HlState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TT -> Posn
forall t. Tok t -> Posn
tokPosn) (Tree TT -> Maybe TT
forall (t :: * -> *) a. Foldable t => t a -> Maybe a
getFirstElement Tree TT
t) HlState -> [HlState] -> [HlState]
forall a. a -> [a] -> [a]
: [Tree TT] -> [HlState]
stopsOf [Tree TT]
ts
      stopsOf (Tree TT
_:[Tree TT]
ts) = [Tree TT] -> [HlState]
stopsOf [Tree TT]
ts
      stopsOf [] = []
      firstTokOnLine :: Maybe Token
firstTokOnLine = (TT -> Token) -> Maybe TT -> Maybe Token
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TT -> Token
forall t. Tok t -> t
tokT (Maybe TT -> Maybe Token) -> Maybe TT -> Maybe Token
forall a b. (a -> b) -> a -> b
$ [TT] -> Maybe TT
forall a. [a] -> Maybe a
listToMaybe ([TT] -> Maybe TT) -> [TT] -> Maybe TT
forall a b. (a -> b) -> a -> b
$
          (TT -> Bool) -> [TT] -> [TT]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile ((Point
solPnt Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
>) (Point -> Bool) -> (TT -> Point) -> TT -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TT -> Point
forall t. Tok t -> Point
tokBegin) ([TT] -> [TT]) -> [TT] -> [TT]
forall a b. (a -> b) -> a -> b
$
          (TT -> Bool) -> [TT] -> [TT]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile ((Point
eolPnt Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
>) (Point -> Bool) -> (TT -> Point) -> TT -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TT -> Point
forall t. Tok t -> Point
tokBegin) ([TT] -> [TT]) -> [TT] -> [TT]
forall a b. (a -> b) -> a -> b
$ -- for laziness.
          (TT -> Bool) -> [TT] -> [TT]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (TT -> Bool) -> TT -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token -> Bool
isErrorTok (Token -> Bool) -> (TT -> Token) -> TT -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TT -> Token
forall t. Tok t -> t
tokT) ([TT] -> [TT]) -> [TT] -> [TT]
forall a b. (a -> b) -> a -> b
$ Tree TT -> [TT]
forall (t :: * -> *) a. Foldable t => t a -> [a]
allToks Tree TT
e
      shiftBlock :: HlState
shiftBlock = case Maybe Token
firstTokOnLine of
        Just (Reserved ReservedType
t) | ReservedType
t ReservedType -> [ReservedType] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ReservedType
Where, ReservedType
Deriving] -> HlState
indentLevel
        Just (ReservedOp OpType
Haskell.Pipe) -> HlState
indentLevel
        Just (ReservedOp OpType
Haskell.Equal) -> HlState
indentLevel
        Maybe Token
_ -> HlState
0
      deepInGroup :: Bool
deepInGroup = Bool -> (Token -> Bool) -> Maybe Token -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True Token -> Bool
insideGroup Maybe Token
firstTokOnLine
      groupIndent :: TT -> [Tree TT] -> HlState
groupIndent (Tok {tokT :: forall t. Tok t -> t
tokT = Special Char
openChar, tokPosn :: forall t. Tok t -> Posn
tokPosn = Posn Point
_ HlState
_ HlState
openCol}) [Tree TT]
ctnt
          | Bool
deepInGroup = case [Tree TT] -> Maybe TT
firstTokNotOnLine [Tree TT]
ctnt of
              -- examine the first token of the group (but not on the line we are indenting!)
              Maybe TT
Nothing -> HlState
openCol HlState -> HlState -> HlState
forall a. Num a => a -> a -> a
+ Char -> HlState
nominalIndent Char
openChar -- no such token: indent normally.
              Just TT
t -> Posn -> HlState
posnCol (Posn -> HlState) -> (TT -> Posn) -> TT -> HlState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TT -> Posn
forall t. Tok t -> Posn
tokPosn (TT -> HlState) -> TT -> HlState
forall a b. (a -> b) -> a -> b
$ TT
t -- indent along that other token
          | Bool
otherwise = HlState
openCol
      groupIndent (Tok {}) [Tree TT]
_ = Text -> HlState
forall a. Text -> a
error Text
"unable to indent code"
  case [Tree TT] -> Point -> Maybe [Tree TT]
forall (tree :: * -> *) t.
IsTree tree =>
[tree (Tok t)] -> Point -> Maybe [tree (Tok t)]
getLastPath [Tree TT
e] Point
solPnt of
    Maybe [Tree TT]
Nothing -> () -> BufferM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just [Tree TT]
path -> let stops :: [HlState]
stops = [Tree TT] -> [HlState]
stopsOf [Tree TT]
path
                 in Text -> BufferM () -> BufferM ()
forall a. Text -> a -> a
trace (Text
"Stops = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [HlState] -> Text
forall a. Show a => a -> Text
showT [HlState]
stops) (BufferM () -> BufferM ()) -> BufferM () -> BufferM ()
forall a b. (a -> b) -> a -> b
$
                    Text -> BufferM () -> BufferM ()
forall a. Text -> a -> a
trace (Text
"firstTokOnLine = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Maybe Token -> Text
forall a. Show a => a -> Text
showT Maybe Token
firstTokOnLine) (BufferM () -> BufferM ()) -> BufferM () -> BufferM ()
forall a b. (a -> b) -> a -> b
$
                    IndentBehaviour -> [HlState] -> BufferM ()
cycleIndentsB IndentBehaviour
behaviour [HlState]
stops

cleverAutoIndentHaskellC :: Exp TT -> IndentBehaviour -> BufferM ()
cleverAutoIndentHaskellC :: Tree TT -> IndentBehaviour -> BufferM ()
cleverAutoIndentHaskellC Tree TT
e IndentBehaviour
behaviour = do
  (HlState
indentLevel, HlState
previousIndent, HlState
nextIndent, Point
solPnt, Point
eolPnt) <- BufferM (HlState, HlState, HlState, Point, Point)
indentInfoB
  let onThisLine :: Point -> Bool
onThisLine Point
ofs = Point
ofs Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
>= Point
solPnt Bool -> Bool -> Bool
&& Point
ofs Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
<= Point
eolPnt
      firstTokNotOnLine :: [Tree TT] -> Maybe TT
firstTokNotOnLine = [TT] -> Maybe TT
forall a. [a] -> Maybe a
listToMaybe ([TT] -> Maybe TT) -> ([Tree TT] -> [TT]) -> [Tree TT] -> Maybe TT
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                              (TT -> Bool) -> [TT] -> [TT]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (TT -> Bool) -> TT -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point -> Bool
onThisLine (Point -> Bool) -> (TT -> Point) -> TT -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Posn -> Point
posnOfs (Posn -> Point) -> (TT -> Posn) -> TT -> Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TT -> Posn
forall t. Tok t -> Posn
tokPosn) ([TT] -> [TT]) -> ([Tree TT] -> [TT]) -> [Tree TT] -> [TT]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                              (TT -> Bool) -> [TT] -> [TT]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (TT -> Bool) -> TT -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token -> Bool
isErrorTok (Token -> Bool) -> (TT -> Token) -> TT -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TT -> Token
forall t. Tok t -> t
tokT) ([TT] -> [TT]) -> ([Tree TT] -> [TT]) -> [Tree TT] -> [TT]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tree TT -> [TT]) -> [Tree TT] -> [TT]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Tree TT -> [TT]
forall (t :: * -> *) a. Foldable t => t a -> [a]
allToks
  let stopsOf :: [Hask.Exp TT] -> [Int]
      stopsOf :: [Tree TT] -> [HlState]
stopsOf (g :: Tree TT
g@(Hask.Paren (Hask.PAtom TT
open [TT]
_) [Tree TT]
ctnt (Hask.PAtom TT
close [TT]
_)):[Tree TT]
ts)
          | Token -> Bool
isErrorTok (TT -> Token
forall t. Tok t -> t
tokT TT
close) Bool -> Bool -> Bool
|| Tree TT -> Point
forall (t :: * -> *) t1. Foldable t => t (Tok t1) -> Point
getLastOffset Tree TT
g Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
>= Point
solPnt
              = [TT -> [Tree TT] -> HlState
groupIndent TT
open [Tree TT]
ctnt]
            -- stop here: we want to be "inside" that group.
          | Bool
otherwise = [Tree TT] -> [HlState]
stopsOf [Tree TT]
ts
           -- this group is closed before this line; just skip it.
      stopsOf (Hask.PAtom (Tok {tokT :: forall t. Tok t -> t
tokT = Token
t}) [TT]
_:[Tree TT]
_) | Token -> Bool
startsLayout Token
t Bool -> Bool -> Bool
|| (Token
t Token -> Token -> Bool
forall a. Eq a => a -> a -> Bool
== OpType -> Token
ReservedOp OpType
Equal)
          = [HlState
nextIndent, HlState
previousIndent HlState -> HlState -> HlState
forall a. Num a => a -> a -> a
+ HlState
indentLevel]
        -- of; where; etc. ends the previous line. We want to start the block here.
        -- Also use the next line's indent:
        -- maybe we are putting a new 1st statement in the block here.
      stopsOf (l :: Tree TT
l@(Hask.PLet Tree TT
_ (Hask.Block [Tree TT]
_) Tree TT
_):[Tree TT]
ts') = [Tree TT -> HlState
forall (t :: * -> *). Foldable t => t TT -> HlState
colOf' Tree TT
l | Token -> Bool
lineStartsWith (ReservedType -> Token
Reserved ReservedType
Haskell.In)] [HlState] -> [HlState] -> [HlState]
forall a. Semigroup a => a -> a -> a
<> [Tree TT] -> [HlState]
stopsOf [Tree TT]
ts'
                                                       -- offer to align with let only if this is an "in"
      stopsOf (t :: Tree TT
t@(Hask.Block [Tree TT]
_):[Tree TT]
ts') = (HlState
shiftBlock HlState -> HlState -> HlState
forall a. Num a => a -> a -> a
+ Tree TT -> HlState
forall (t :: * -> *). Foldable t => t TT -> HlState
colOf' Tree TT
t) HlState -> [HlState] -> [HlState]
forall a. a -> [a] -> [a]
: [Tree TT] -> [HlState]
stopsOf [Tree TT]
ts'
                                       -- offer add another statement in the block
      stopsOf (Hask.PGuard' (PAtom TT
pipe [TT]
_) Tree TT
_ Tree TT
_:[Tree TT]
ts') = [TT -> HlState
forall t. Tok t -> HlState
tokCol TT
pipe | Token -> Bool
lineStartsWith (OpType -> Token
ReservedOp OpType
Haskell.Pipe)] [HlState] -> [HlState] -> [HlState]
forall a. Semigroup a => a -> a -> a
<> [Tree TT] -> [HlState]
stopsOf [Tree TT]
ts'
                                                                 -- offer to align against another guard
      stopsOf (d :: Tree TT
d@(Hask.PData {}):[Tree TT]
ts') = Tree TT -> HlState
forall (t :: * -> *). Foldable t => t TT -> HlState
colOf' Tree TT
d HlState -> HlState -> HlState
forall a. Num a => a -> a -> a
+ HlState
indentLevel
                                           HlState -> [HlState] -> [HlState]
forall a. a -> [a] -> [a]
: [Tree TT] -> [HlState]
stopsOf [Tree TT]
ts' --FIXME!
      stopsOf (Hask.RHS (Hask.PAtom{}) Tree TT
exp:[Tree TT]
ts')
          = [case Maybe Token
firstTokOnLine of
              Just (Operator FilePath
op') -> FilePath -> HlState -> HlState
forall (t :: * -> *) a. Foldable t => t a -> HlState -> HlState
opLength FilePath
op' (Tree TT -> HlState
forall (t :: * -> *). Foldable t => t TT -> HlState
colOf' Tree TT
exp) -- Usually operators are aligned against the '=' sign
              -- case of an operator should check so that value always is at least 1
              Maybe Token
_ -> Tree TT -> HlState
forall (t :: * -> *). Foldable t => t TT -> HlState
colOf' Tree TT
exp | Bool
lineIsExpression ] [HlState] -> [HlState] -> [HlState]
forall a. Semigroup a => a -> a -> a
<> [Tree TT] -> [HlState]
stopsOf [Tree TT]
ts'
                   -- offer to continue the RHS if this looks like an expression.
      stopsOf [] = [HlState
0] -- maybe it's new declaration in the module
      stopsOf (Tree TT
_:[Tree TT]
ts) = [Tree TT] -> [HlState]
stopsOf [Tree TT]
ts -- by default, there is no reason to indent against an expression.
       -- calculate indentation of operator (must be at least 1 to be valid)
      opLength :: t a -> HlState -> HlState
opLength t a
ts' HlState
r = let l :: HlState
l = HlState
r HlState -> HlState -> HlState
forall a. Num a => a -> a -> a
- (t a -> HlState
forall (t :: * -> *) a. Foldable t => t a -> HlState
length t a
ts' HlState -> HlState -> HlState
forall a. Num a => a -> a -> a
+ HlState
1) -- I find this dubious...
                       in  if HlState
l HlState -> HlState -> Bool
forall a. Ord a => a -> a -> Bool
> HlState
0 then HlState
l else HlState
1

      lineStartsWith :: Token -> Bool
lineStartsWith Token
tok = Maybe Token
firstTokOnLine Maybe Token -> Maybe Token -> Bool
forall a. Eq a => a -> a -> Bool
== Token -> Maybe Token
forall a. a -> Maybe a
Just Token
tok
      lineIsExpression :: Bool
lineIsExpression   = (Token -> Bool) -> [Token] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Token -> [Token] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [OpType -> Token
ReservedOp OpType
Haskell.Pipe, OpType -> Token
ReservedOp OpType
Haskell.Equal, OpType -> Token
ReservedOp OpType
RightArrow]) [Token]
toksOnLine
                           Bool -> Bool -> Bool
&& Bool -> Bool
not (Token -> Bool
lineStartsWith (ReservedType -> Token
Reserved ReservedType
Haskell.In))
      -- TODO: check the tree instead of guessing by looking at tokens
      firstTokOnLine :: Maybe Token
firstTokOnLine = [Token] -> Maybe Token
forall a. [a] -> Maybe a
listToMaybe [Token]
toksOnLine
      toksOnLine :: [Token]
toksOnLine = (TT -> Token) -> [TT] -> [Token]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TT -> Token
forall t. Tok t -> t
tokT ([TT] -> [Token]) -> [TT] -> [Token]
forall a b. (a -> b) -> a -> b
$
          (TT -> Bool) -> [TT] -> [TT]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile ((Point
solPnt Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
>) (Point -> Bool) -> (TT -> Point) -> TT -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TT -> Point
forall t. Tok t -> Point
tokBegin) ([TT] -> [TT]) -> [TT] -> [TT]
forall a b. (a -> b) -> a -> b
$
          (TT -> Bool) -> [TT] -> [TT]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile ((Point
eolPnt Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
>) (Point -> Bool) -> (TT -> Point) -> TT -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TT -> Point
forall t. Tok t -> Point
tokBegin) ([TT] -> [TT]) -> [TT] -> [TT]
forall a b. (a -> b) -> a -> b
$ -- for laziness.
          (TT -> Bool) -> [TT] -> [TT]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (TT -> Bool) -> TT -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token -> Bool
isErrorTok (Token -> Bool) -> (TT -> Token) -> TT -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TT -> Token
forall t. Tok t -> t
tokT) ([TT] -> [TT]) -> [TT] -> [TT]
forall a b. (a -> b) -> a -> b
$ Tree TT -> [TT]
forall (t :: * -> *) a. Foldable t => t a -> [a]
allToks Tree TT
e
      shiftBlock :: HlState
shiftBlock = case Maybe Token
firstTokOnLine of
        Just (Reserved ReservedType
t) | ReservedType
t ReservedType -> [ReservedType] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ReservedType
Where, ReservedType
Deriving] -> HlState
indentLevel
        Just (ReservedOp OpType
Haskell.Pipe) -> HlState
indentLevel
        Just (ReservedOp OpType
Haskell.Equal) -> HlState
indentLevel
        Maybe Token
_ -> HlState
0
      deepInGroup :: Bool
deepInGroup = Bool -> (Token -> Bool) -> Maybe Token -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True Token -> Bool
insideGroup Maybe Token
firstTokOnLine
      groupIndent :: TT -> [Tree TT] -> HlState
groupIndent (Tok {tokT :: forall t. Tok t -> t
tokT = Special Char
openChar, tokPosn :: forall t. Tok t -> Posn
tokPosn = Posn Point
_ HlState
_ HlState
openCol}) [Tree TT]
ctnt
          | Bool
deepInGroup = case [Tree TT] -> Maybe TT
firstTokNotOnLine [Tree TT]
ctnt of
              -- examine the first token of the group
              -- (but not on the line we are indenting!)
              Maybe TT
Nothing -> HlState
openCol HlState -> HlState -> HlState
forall a. Num a => a -> a -> a
+ Char -> HlState
nominalIndent Char
openChar
              -- no such token: indent normally.
              Just TT
t -> Posn -> HlState
posnCol (Posn -> HlState) -> (TT -> Posn) -> TT -> HlState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TT -> Posn
forall t. Tok t -> Posn
tokPosn (TT -> HlState) -> TT -> HlState
forall a b. (a -> b) -> a -> b
$ TT
t -- indent along that other token
          | Bool
otherwise = HlState
openCol
      groupIndent (Tok{}) [Tree TT]
_ = Text -> HlState
forall a. Text -> a
error Text
"unable to indent code"
  case [Tree TT] -> Point -> Maybe [Tree TT]
forall (tree :: * -> *) t.
IsTree tree =>
[tree (Tok t)] -> Point -> Maybe [tree (Tok t)]
getLastPath [Tree TT
e] Point
solPnt of
    Maybe [Tree TT]
Nothing -> () -> BufferM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just [Tree TT]
path ->let stops :: [HlState]
stops = [Tree TT] -> [HlState]
stopsOf [Tree TT]
path
                in Text -> BufferM () -> BufferM ()
forall a. Text -> a -> a
trace (Text
"Path = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Tree TT] -> Text
forall a. Show a => a -> Text
showT [Tree TT]
path) (BufferM () -> BufferM ()) -> BufferM () -> BufferM ()
forall a b. (a -> b) -> a -> b
$
                   Text -> BufferM () -> BufferM ()
forall a. Text -> a -> a
trace (Text
"Stops = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [HlState] -> Text
forall a. Show a => a -> Text
showT [HlState]
stops) (BufferM () -> BufferM ()) -> BufferM () -> BufferM ()
forall a b. (a -> b) -> a -> b
$
                   Text -> BufferM () -> BufferM ()
forall a. Text -> a -> a
trace (Text
"Previous indent = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> HlState -> Text
forall a. Show a => a -> Text
showT HlState
previousIndent) (BufferM () -> BufferM ()) -> BufferM () -> BufferM ()
forall a b. (a -> b) -> a -> b
$
                   Text -> BufferM () -> BufferM ()
forall a. Text -> a -> a
trace (Text
"Next indent = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> HlState -> Text
forall a. Show a => a -> Text
showT HlState
nextIndent) (BufferM () -> BufferM ()) -> BufferM () -> BufferM ()
forall a b. (a -> b) -> a -> b
$
                   Text -> BufferM () -> BufferM ()
forall a. Text -> a -> a
trace (Text
"firstTokOnLine = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Maybe Token -> Text
forall a. Show a => a -> Text
showT Maybe Token
firstTokOnLine) (BufferM () -> BufferM ()) -> BufferM () -> BufferM ()
forall a b. (a -> b) -> a -> b
$
                   IndentBehaviour -> [HlState] -> BufferM ()
cycleIndentsB IndentBehaviour
behaviour [HlState]
stops

colOf' :: Foldable t => t TT -> Int
colOf' :: t TT -> HlState
colOf' = HlState -> (TT -> HlState) -> Maybe TT -> HlState
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HlState
0 TT -> HlState
forall t. Tok t -> HlState
tokCol (Maybe TT -> HlState) -> (t TT -> Maybe TT) -> t TT -> HlState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t TT -> Maybe TT
forall (t :: * -> *) a. Foldable t => t a -> Maybe a
getFirstElement

tokCol :: Tok t -> Int
tokCol :: Tok t -> HlState
tokCol = Posn -> HlState
posnCol (Posn -> HlState) -> (Tok t -> Posn) -> Tok t -> HlState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tok t -> Posn
forall t. Tok t -> Posn
tokPosn


nominalIndent :: Char -> Int
nominalIndent :: Char -> HlState
nominalIndent Char
'{' = HlState
2
nominalIndent Char
_ = HlState
1

tokText :: Tok t -> BufferM R.YiString
tokText :: Tok t -> BufferM YiString
tokText = Region -> BufferM YiString
readRegionB (Region -> BufferM YiString)
-> (Tok t -> Region) -> Tok t -> BufferM YiString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tok t -> Region
forall t. Tok t -> Region
tokRegion

tokRegion :: Tok t -> Region
tokRegion :: Tok t -> Region
tokRegion Tok t
t = Point -> Point -> Region
mkRegion (Tok t -> Point
forall t. Tok t -> Point
tokBegin Tok t
t) (Tok t -> Point
forall t. Tok t -> Point
tokEnd Tok t
t)

isLineComment :: TT -> Bool
isLineComment :: TT -> Bool
isLineComment = (CommentType -> Maybe CommentType
forall a. a -> Maybe a
Just CommentType
Haskell.Line Maybe CommentType -> Maybe CommentType -> Bool
forall a. Eq a => a -> a -> Bool
==) (Maybe CommentType -> Bool)
-> (TT -> Maybe CommentType) -> TT -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token -> Maybe CommentType
tokTyp (Token -> Maybe CommentType)
-> (TT -> Token) -> TT -> Maybe CommentType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TT -> Token
forall t. Tok t -> t
tokT

contiguous :: Tok t -> Tok t -> Bool
contiguous :: Tok t -> Tok t -> Bool
contiguous Tok t
a Tok t
b = HlState
lb HlState -> HlState -> HlState
forall a. Num a => a -> a -> a
- HlState
la HlState -> HlState -> Bool
forall a. Ord a => a -> a -> Bool
<= HlState
1
    where [HlState
la,HlState
lb] = (Tok t -> HlState) -> [Tok t] -> [HlState]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Posn -> HlState
posnLine (Posn -> HlState) -> (Tok t -> Posn) -> Tok t -> HlState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tok t -> Posn
forall t. Tok t -> Posn
tokPosn) [Tok t
a,Tok t
b]

coalesce :: Tok Token -> Tok Token -> Bool
coalesce :: TT -> TT -> Bool
coalesce TT
a TT
b = TT -> Bool
isLineComment TT
a Bool -> Bool -> Bool
&& TT -> Bool
isLineComment TT
b Bool -> Bool -> Bool
&& TT -> TT -> Bool
forall t. Tok t -> Tok t -> Bool
contiguous TT
a TT
b

cleverPrettify :: [TT] -> BufferM ()
cleverPrettify :: [TT] -> BufferM ()
cleverPrettify [TT]
toks = do
  Point
pnt <- BufferM Point
pointB
  let groups :: [[TT]]
groups = (TT -> TT -> Bool) -> [TT] -> [[TT]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy' TT -> TT -> Bool
coalesce [TT]
toks
      isCommentGroup :: [TT] -> Bool
isCommentGroup [TT]
g = Token -> Maybe CommentType
tokTyp (TT -> Token
forall t. Tok t -> t
tokT (TT -> Token) -> TT -> Token
forall a b. (a -> b) -> a -> b
$ [TT] -> TT
forall a. [a] -> a
head [TT]
g) Maybe CommentType -> [Maybe CommentType] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (CommentType -> Maybe CommentType)
-> [CommentType] -> [Maybe CommentType]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CommentType -> Maybe CommentType
forall a. a -> Maybe a
Just [CommentType
Haskell.Line]
      thisCommentGroup :: Maybe [TT]
thisCommentGroup = [[TT]] -> Maybe [TT]
forall a. [a] -> Maybe a
listToMaybe ([[TT]] -> Maybe [TT]) -> [[TT]] -> Maybe [TT]
forall a b. (a -> b) -> a -> b
$ ([TT] -> Bool) -> [[TT]] -> [[TT]]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile ((Point
pnt Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
>) (Point -> Bool) -> ([TT] -> Point) -> [TT] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TT -> Point
forall t. Tok t -> Point
tokEnd (TT -> Point) -> ([TT] -> TT) -> [TT] -> Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TT] -> TT
forall a. [a] -> a
last) ([[TT]] -> [[TT]]) -> [[TT]] -> [[TT]]
forall a b. (a -> b) -> a -> b
$ ([TT] -> Bool) -> [[TT]] -> [[TT]]
forall a. (a -> Bool) -> [a] -> [a]
filter [TT] -> Bool
isCommentGroup [[TT]]
groups
                         -- FIXME: laziness
  case Maybe [TT]
thisCommentGroup of
    Maybe [TT]
Nothing -> () -> BufferM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just [TT]
g -> do
      Text
text <- [Text] -> Text
T.unwords ([Text] -> Text) -> ([YiString] -> [Text]) -> [YiString] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (YiString -> Text) -> [YiString] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (HlState -> Text -> Text
T.drop HlState
2 (Text -> Text) -> (YiString -> Text) -> YiString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiString -> Text
R.toText) ([YiString] -> Text) -> BufferM [YiString] -> BufferM Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TT -> BufferM YiString) -> [TT] -> BufferM [YiString]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM TT -> BufferM YiString
forall t. Tok t -> BufferM YiString
tokText [TT]
g
      let region :: Region
region = Point -> Point -> Region
mkRegion (TT -> Point
forall t. Tok t -> Point
tokBegin (TT -> Point) -> ([TT] -> TT) -> [TT] -> Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TT] -> TT
forall a. [a] -> a
head ([TT] -> Point) -> [TT] -> Point
forall a b. (a -> b) -> a -> b
$ [TT]
g) (TT -> Point
forall t. Tok t -> Point
tokEnd (TT -> Point) -> ([TT] -> TT) -> [TT] -> Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TT] -> TT
forall a. [a] -> a
last ([TT] -> Point) -> [TT] -> Point
forall a b. (a -> b) -> a -> b
$ [TT]
g)
          mkGrp :: b -> YiString
mkGrp = YiString -> b -> YiString
forall a b. a -> b -> a
const (YiString -> b -> YiString)
-> ([YiString] -> YiString) -> [YiString] -> b -> YiString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [YiString] -> YiString
R.unlines ([YiString] -> b -> YiString) -> [YiString] -> b -> YiString
forall a b. (a -> b) -> a -> b
$ YiString -> YiString -> YiString
R.append YiString
"-- " (YiString -> YiString) -> [YiString] -> [YiString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HlState -> YiString -> [YiString]
fillText HlState
80 (Text -> YiString
R.fromText Text
text)
      (YiString -> YiString) -> Region -> BufferM ()
modifyRegionB YiString -> YiString
forall b. b -> YiString
mkGrp Region
region

tokTyp :: Token -> Maybe Haskell.CommentType
tokTyp :: Token -> Maybe CommentType
tokTyp (Comment CommentType
t) = CommentType -> Maybe CommentType
forall a. a -> Maybe a
Just CommentType
t
tokTyp Token
_ = Maybe CommentType
forall a. Maybe a
Nothing

-- TODO: export or remove
-- -- Keyword-based auto-indenter for haskell.
-- autoIndentHaskellB :: IndentBehaviour -> BufferM ()
-- autoIndentHaskellB =
--   autoIndentWithKeywordsB [ "if"
--                           , "then"
--                           , "else"
--                           , "|"
--                           , "->"
--                           , "case" -- hmm
--                           , "in"
--                           -- Note tempted by having '=' in here that would
--                           -- potentially work well for 'data' declarations
--                           -- but I think '=' is so common in other places
--                           -- that it would introduce many spurious/annoying
--                           -- hints.
--                           ]
--                           [ "where"
--                           , "let"
--                           , "do"
--                           , "mdo"
--                           , "{-"
--                           , "{-|"
--                           , "--"
--                           ]
--
---------------------------
-- * Interaction with GHCi

-- | Variable storing the possibe buffer reference where GHCi is
-- currently running.
newtype GhciBuffer = GhciBuffer {GhciBuffer -> Maybe BufferRef
_ghciBuffer :: Maybe BufferRef}
    deriving (GhciBuffer
GhciBuffer -> Default GhciBuffer
forall a. a -> Default a
def :: GhciBuffer
$cdef :: GhciBuffer
Default, Typeable, Get GhciBuffer
[GhciBuffer] -> Put
GhciBuffer -> Put
(GhciBuffer -> Put)
-> Get GhciBuffer -> ([GhciBuffer] -> Put) -> Binary GhciBuffer
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [GhciBuffer] -> Put
$cputList :: [GhciBuffer] -> Put
get :: Get GhciBuffer
$cget :: Get GhciBuffer
put :: GhciBuffer -> Put
$cput :: GhciBuffer -> Put
Binary)

instance YiVariable GhciBuffer

-- | Start GHCi in a buffer
ghci :: YiM BufferRef
ghci :: YiM BufferRef
ghci = do
  GhciProcessName
g <- YiM GhciProcessName
forall (m :: * -> *) a.
(MonadEditor m, YiVariable a, Default a, Functor m) =>
m a
getEditorDyn
  BufferRef
b <- FilePath -> [FilePath] -> YiM BufferRef
GHCi.spawnProcess (GhciProcessName
g GhciProcessName
-> Getting FilePath GhciProcessName FilePath -> FilePath
forall s a. s -> Getting a s a -> a
^. Getting FilePath GhciProcessName FilePath
Lens' GhciProcessName FilePath
GHCi.ghciProcessName) (GhciProcessName
g GhciProcessName
-> Getting [FilePath] GhciProcessName [FilePath] -> [FilePath]
forall s a. s -> Getting a s a -> a
^. Getting [FilePath] GhciProcessName [FilePath]
Lens' GhciProcessName [FilePath]
GHCi.ghciProcessArgs)
  EditorM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (EditorM () -> YiM ())
-> (Maybe BufferRef -> EditorM ()) -> Maybe BufferRef -> YiM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GhciBuffer -> EditorM ()
forall (m :: * -> *) a.
(MonadEditor m, YiVariable a, Functor m) =>
a -> m ()
putEditorDyn (GhciBuffer -> EditorM ())
-> (Maybe BufferRef -> GhciBuffer) -> Maybe BufferRef -> EditorM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe BufferRef -> GhciBuffer
GhciBuffer (Maybe BufferRef -> YiM ()) -> Maybe BufferRef -> YiM ()
forall a b. (a -> b) -> a -> b
$ BufferRef -> Maybe BufferRef
forall a. a -> Maybe a
Just BufferRef
b
  BufferRef -> YiM BufferRef
forall (m :: * -> *) a. Monad m => a -> m a
return BufferRef
b

-- | Return GHCi's buffer; create it if necessary.
-- Show it in another window.
ghciGet :: YiM BufferRef
ghciGet :: YiM BufferRef
ghciGet = YiM BufferRef -> YiM BufferRef
forall (m :: * -> *) a. MonadEditor m => m a -> m a
withOtherWindow (YiM BufferRef -> YiM BufferRef) -> YiM BufferRef -> YiM BufferRef
forall a b. (a -> b) -> a -> b
$ do
    GhciBuffer Maybe BufferRef
mb <- EditorM GhciBuffer -> YiM GhciBuffer
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor EditorM GhciBuffer
forall (m :: * -> *) a.
(MonadEditor m, YiVariable a, Default a, Functor m) =>
m a
getEditorDyn
    case Maybe BufferRef
mb of
        Maybe BufferRef
Nothing -> YiM BufferRef
ghci
        Just BufferRef
b -> do
            Bool
stillExists <- Maybe FBuffer -> Bool
forall a. Maybe a -> Bool
isJust (Maybe FBuffer -> Bool) -> YiM (Maybe FBuffer) -> YiM Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferRef -> YiM (Maybe FBuffer)
forall (m :: * -> *).
MonadEditor m =>
BufferRef -> m (Maybe FBuffer)
findBuffer BufferRef
b
            if Bool
stillExists
                then do EditorM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (EditorM () -> YiM ()) -> EditorM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ BufferRef -> EditorM ()
switchToBufferE BufferRef
b
                        BufferRef -> YiM BufferRef
forall (m :: * -> *) a. Monad m => a -> m a
return BufferRef
b
                else YiM BufferRef
ghci

-- | Send a command to GHCi
ghciSend :: String -> YiM ()
ghciSend :: FilePath -> YiM ()
ghciSend FilePath
cmd = do
    BufferRef
b <- YiM BufferRef
ghciGet
    BufferRef -> BufferM () -> YiM ()
forall (m :: * -> *) a.
MonadEditor m =>
BufferRef -> BufferM a -> m a
withGivenBuffer BufferRef
b BufferM ()
botB
    BufferRef -> FilePath -> YiM ()
sendToProcess BufferRef
b (FilePath
cmd FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"\n")

-- | Load current buffer in GHCi
ghciLoadBuffer :: YiM ()
ghciLoadBuffer :: YiM ()
ghciLoadBuffer = do
    YiM Bool -> YiM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void YiM Bool
fwriteE
    Maybe FilePath
f <- BufferM (Maybe FilePath) -> YiM (Maybe FilePath)
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer ((FBuffer -> Maybe FilePath) -> BufferM (Maybe FilePath)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets FBuffer -> Maybe FilePath
file)
    case Maybe FilePath
f of
      Maybe FilePath
Nothing -> Text -> YiM ()
forall a. Text -> a
error Text
"Couldn't get buffer filename in ghciLoadBuffer"
      Just FilePath
filename -> FilePath -> YiM ()
ghciSend (FilePath -> YiM ()) -> FilePath -> YiM ()
forall a b. (a -> b) -> a -> b
$ FilePath
":load " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
filename

-- Tells ghci to infer the type of the identifier at point. Doesn't
-- check for errors (yet)
ghciInferType :: YiM ()
ghciInferType :: YiM ()
ghciInferType = do
    YiString
nm <- BufferM YiString -> YiM YiString
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (TextUnit -> BufferM YiString
readUnitB TextUnit
unitWord)
    Bool -> YiM () -> YiM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (YiString -> Bool
R.null YiString
nm) (YiM () -> YiM ()) -> YiM () -> YiM ()
forall a b. (a -> b) -> a -> b
$
      Text
-> (Text -> YiM [Text])
-> Text
-> (Text -> YiM Text)
-> (Text -> YiM ())
-> (Text -> YiM ())
-> YiM ()
withMinibufferGen (YiString -> Text
R.toText YiString
nm) Text -> YiM [Text]
forall a. a -> YiM [a]
noHint Text
"Insert type of which identifier?"
      Text -> YiM Text
forall (m :: * -> *) a. Monad m => a -> m a
return (YiM () -> Text -> YiM ()
forall a b. a -> b -> a
const (YiM () -> Text -> YiM ()) -> YiM () -> Text -> YiM ()
forall a b. (a -> b) -> a -> b
$ () -> YiM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (YiString -> YiM ()
ghciInferTypeOf (YiString -> YiM ()) -> (Text -> YiString) -> Text -> YiM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> YiString
R.fromText)

ghciInferTypeOf :: R.YiString -> YiM ()
ghciInferTypeOf :: YiString -> YiM ()
ghciInferTypeOf YiString
nm = do
    BufferRef
buf <- YiM BufferRef
ghciGet
    YiString
result <- BufferRef -> FilePath -> YiM YiString
Interactive.queryReply BufferRef
buf (FilePath
":t " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> YiString -> FilePath
R.toString YiString
nm)
    let successful :: Bool
successful = (Bool -> Bool
not (Bool -> Bool) -> (YiString -> Bool) -> YiString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiString -> Bool
R.null) YiString
nm Bool -> Bool -> Bool
&& YiString
nm YiString -> YiString -> Bool
forall a. Eq a => a -> a -> Bool
== YiString
result
    Bool -> YiM () -> YiM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
successful (YiM () -> YiM ())
-> (BufferM () -> YiM ()) -> BufferM () -> YiM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BufferM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM () -> YiM ()) -> BufferM () -> YiM ()
forall a b. (a -> b) -> a -> b
$
      BufferM ()
moveToSol BufferM () -> BufferM () -> BufferM ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> BufferM ()
insertB Char
'\n' BufferM () -> BufferM () -> BufferM ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> BufferM ()
leftB
      BufferM () -> BufferM () -> BufferM ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> YiString -> BufferM ()
insertN YiString
result BufferM () -> BufferM () -> BufferM ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> BufferM ()
rightB

ghciSetProcessName :: YiM ()
ghciSetProcessName :: YiM ()
ghciSetProcessName = do
  GhciProcessName
g <- YiM GhciProcessName
forall (m :: * -> *) a.
(MonadEditor m, YiVariable a, Default a, Functor m) =>
m a
getEditorDyn
  let nm :: FilePath
nm = GhciProcessName
g GhciProcessName
-> Getting FilePath GhciProcessName FilePath -> FilePath
forall s a. s -> Getting a s a -> a
^. Getting FilePath GhciProcessName FilePath
Lens' GhciProcessName FilePath
GHCi.ghciProcessName
      prompt :: Text
prompt = [Text] -> Text
T.concat [ Text
"Command to call for GHCi, currently ‘"
                        , FilePath -> Text
T.pack FilePath
nm, Text
"’: " ]
  Text -> (Text -> YiM ()) -> YiM ()
withMinibufferFree Text
prompt ((Text -> YiM ()) -> YiM ()) -> (Text -> YiM ()) -> YiM ()
forall a b. (a -> b) -> a -> b
$ \Text
s ->
    GhciProcessName -> YiM ()
forall (m :: * -> *) a.
(MonadEditor m, YiVariable a, Functor m) =>
a -> m ()
putEditorDyn (GhciProcessName -> YiM ()) -> GhciProcessName -> YiM ()
forall a b. (a -> b) -> a -> b
$ GhciProcessName
g GhciProcessName
-> (GhciProcessName -> GhciProcessName) -> GhciProcessName
forall a b. a -> (a -> b) -> b
& (FilePath -> Identity FilePath)
-> GhciProcessName -> Identity GhciProcessName
Lens' GhciProcessName FilePath
GHCi.ghciProcessName ((FilePath -> Identity FilePath)
 -> GhciProcessName -> Identity GhciProcessName)
-> FilePath -> GhciProcessName -> GhciProcessName
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text -> FilePath
T.unpack Text
s

ghciSetProcessArgs :: YiM ()
ghciSetProcessArgs :: YiM ()
ghciSetProcessArgs = do
  GhciProcessName
g <- YiM GhciProcessName
forall (m :: * -> *) a.
(MonadEditor m, YiVariable a, Default a, Functor m) =>
m a
getEditorDyn
  let nm :: FilePath
nm = GhciProcessName
g GhciProcessName
-> Getting FilePath GhciProcessName FilePath -> FilePath
forall s a. s -> Getting a s a -> a
^. Getting FilePath GhciProcessName FilePath
Lens' GhciProcessName FilePath
GHCi.ghciProcessName
      args :: [FilePath]
args = GhciProcessName
g GhciProcessName
-> Getting [FilePath] GhciProcessName [FilePath] -> [FilePath]
forall s a. s -> Getting a s a -> a
^. Getting [FilePath] GhciProcessName [FilePath]
Lens' GhciProcessName [FilePath]
GHCi.ghciProcessArgs
      prompt :: Text
prompt = [Text] -> Text
T.unwords [ Text
"List of args to call "
                         , FilePath -> Text
T.pack FilePath
nm
                         , Text
"with, currently"
                         , FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
forall a. Show a => a -> FilePath
show [FilePath]
args
                         , Text
":"
                         ]
  Text -> (Text -> YiM ()) -> YiM ()
withMinibufferFree Text
prompt ((Text -> YiM ()) -> YiM ()) -> (Text -> YiM ()) -> YiM ()
forall a b. (a -> b) -> a -> b
$ \Text
arg ->
    case FilePath -> Maybe [FilePath]
forall a. Read a => FilePath -> Maybe a
readMaybe (FilePath -> Maybe [FilePath]) -> FilePath -> Maybe [FilePath]
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
arg of
      Maybe [FilePath]
Nothing -> Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg Text
"Could not parse as [String], keep old args."
      Just [FilePath]
arg' -> GhciProcessName -> YiM ()
forall (m :: * -> *) a.
(MonadEditor m, YiVariable a, Functor m) =>
a -> m ()
putEditorDyn (GhciProcessName -> YiM ()) -> GhciProcessName -> YiM ()
forall a b. (a -> b) -> a -> b
$ GhciProcessName
g GhciProcessName
-> (GhciProcessName -> GhciProcessName) -> GhciProcessName
forall a b. a -> (a -> b) -> b
& ([FilePath] -> Identity [FilePath])
-> GhciProcessName -> Identity GhciProcessName
Lens' GhciProcessName [FilePath]
GHCi.ghciProcessArgs (([FilePath] -> Identity [FilePath])
 -> GhciProcessName -> Identity GhciProcessName)
-> [FilePath] -> GhciProcessName -> GhciProcessName
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [FilePath]
arg'