{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_HADDOCK show-extensions #-}
module Yi.Mode.Haskell
(
haskellAbstract,
cleverMode,
preciseMode,
literateMode,
fastMode,
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')
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"]
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
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
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)
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
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]
| Bool
otherwise = [Tree TT] -> [HlState]
stopsOf [Tree TT]
ts'
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]
stopsOf (Paren.Atom TT
_:[Tree TT]
ts) = [Tree TT] -> [HlState]
stopsOf [Tree TT]
ts
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
$
(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
Maybe TT
Nothing -> HlState
openCol HlState -> HlState -> HlState
forall a. Num a => a -> a -> a
+ Char -> HlState
nominalIndent Char
openChar
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
| 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]
| Bool
otherwise = [Tree TT] -> [HlState]
stopsOf [Tree TT]
ts
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]
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'
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'
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'
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'
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)
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'
stopsOf [] = [HlState
0]
stopsOf (Tree TT
_:[Tree TT]
ts) = [Tree TT] -> [HlState]
stopsOf [Tree TT]
ts
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)
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))
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
$
(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
Maybe TT
Nothing -> HlState
openCol HlState -> HlState -> HlState
forall a. Num a => a -> a -> a
+ Char -> HlState
nominalIndent Char
openChar
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
| 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
= (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
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
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
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
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
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")
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
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'