{-# 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 :: forall (tree :: * -> *). Mode (tree (Tok Token))
haskellAbstract = Mode (tree (Tok Token))
forall syntax. Mode syntax
emptyMode
  Mode (tree (Tok Token))
-> (Mode (tree (Tok Token)) -> Mode (tree (Tok Token)))
-> Mode (tree (Tok Token))
forall a b. a -> (a -> b) -> b
& ((String -> YiString -> Bool)
 -> Identity (String -> YiString -> Bool))
-> Mode (tree (Tok Token)) -> Identity (Mode (tree (Tok Token)))
forall syntax (f :: * -> *).
Functor f =>
((String -> YiString -> Bool) -> f (String -> YiString -> Bool))
-> Mode syntax -> f (Mode syntax)
modeAppliesA (((String -> YiString -> Bool)
  -> Identity (String -> YiString -> Bool))
 -> Mode (tree (Tok Token)) -> Identity (Mode (tree (Tok Token))))
-> (String -> YiString -> Bool)
-> Mode (tree (Tok Token))
-> Mode (tree (Tok Token))
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [String] -> Parser () -> String -> YiString -> Bool
extensionOrContentsMatch [String]
extensions (Parser Text -> Parser ()
forall a. Parser a -> Parser ()
shebangParser Parser Text
"runhaskell")
  Mode (tree (Tok Token))
-> (Mode (tree (Tok Token)) -> Mode (tree (Tok Token)))
-> Mode (tree (Tok Token))
forall a b. a -> (a -> b) -> b
& (Text -> Identity Text)
-> Mode (tree (Tok Token)) -> Identity (Mode (tree (Tok Token)))
forall syntax (f :: * -> *).
Functor f =>
(Text -> f Text) -> Mode syntax -> f (Mode syntax)
modeNameA ((Text -> Identity Text)
 -> Mode (tree (Tok Token)) -> Identity (Mode (tree (Tok Token))))
-> Text -> Mode (tree (Tok Token)) -> Mode (tree (Tok Token))
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
"haskell"
  Mode (tree (Tok Token))
-> (Mode (tree (Tok Token)) -> Mode (tree (Tok Token)))
-> Mode (tree (Tok Token))
forall a b. a -> (a -> b) -> b
& (Maybe (BufferM ()) -> Identity (Maybe (BufferM ())))
-> Mode (tree (Tok Token)) -> Identity (Mode (tree (Tok Token)))
forall syntax (f :: * -> *).
Functor f =>
(Maybe (BufferM ()) -> f (Maybe (BufferM ())))
-> Mode syntax -> f (Mode syntax)
modeToggleCommentSelectionA ((Maybe (BufferM ()) -> Identity (Maybe (BufferM ())))
 -> Mode (tree (Tok Token)) -> Identity (Mode (tree (Tok Token))))
-> Maybe (BufferM ())
-> Mode (tree (Tok Token))
-> Mode (tree (Tok Token))
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 :: [String]
extensions = [String
"hs", String
"x", String
"hsc", String
"hsinc"]

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

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

literateMode :: Mode (Paren.Tree TT)
literateMode :: Mode (Tree (Tok Token))
literateMode = Mode (Tree (Tok Token))
forall (tree :: * -> *). Mode (tree (Tok Token))
haskellAbstract
  Mode (Tree (Tok Token))
-> (Mode (Tree (Tok Token)) -> Mode (Tree (Tok Token)))
-> Mode (Tree (Tok Token))
forall a b. a -> (a -> b) -> b
& (Text -> Identity Text)
-> Mode (Tree (Tok Token)) -> Identity (Mode (Tree (Tok Token)))
forall syntax (f :: * -> *).
Functor f =>
(Text -> f Text) -> Mode syntax -> f (Mode syntax)
modeNameA ((Text -> Identity Text)
 -> Mode (Tree (Tok Token)) -> Identity (Mode (Tree (Tok Token))))
-> Text -> Mode (Tree (Tok Token)) -> Mode (Tree (Tok Token))
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
"literate haskell"
  Mode (Tree (Tok Token))
-> (Mode (Tree (Tok Token)) -> Mode (Tree (Tok Token)))
-> Mode (Tree (Tok Token))
forall a b. a -> (a -> b) -> b
& ((String -> YiString -> Bool)
 -> Identity (String -> YiString -> Bool))
-> Mode (Tree (Tok Token)) -> Identity (Mode (Tree (Tok Token)))
forall syntax (f :: * -> *).
Functor f =>
((String -> YiString -> Bool) -> f (String -> YiString -> Bool))
-> Mode syntax -> f (Mode syntax)
modeAppliesA (((String -> YiString -> Bool)
  -> Identity (String -> YiString -> Bool))
 -> Mode (Tree (Tok Token)) -> Identity (Mode (Tree (Tok Token))))
-> (String -> YiString -> Bool)
-> Mode (Tree (Tok Token))
-> Mode (Tree (Tok Token))
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [String] -> String -> YiString -> Bool
forall a. [String] -> String -> a -> Bool
anyExtension [String
"lhs"]
  Mode (Tree (Tok Token))
-> (Mode (Tree (Tok Token)) -> Mode (Tree (Tok Token)))
-> Mode (Tree (Tok Token))
forall a b. a -> (a -> b) -> b
& (ExtHL (Tree (Tok Token)) -> Identity (ExtHL (Tree (Tok Token))))
-> Mode (Tree (Tok Token)) -> Identity (Mode (Tree (Tok Token)))
forall syntax (f :: * -> *).
Functor f =>
(ExtHL syntax -> f (ExtHL syntax))
-> Mode syntax -> f (Mode syntax)
modeHLA ((ExtHL (Tree (Tok Token)) -> Identity (ExtHL (Tree (Tok Token))))
 -> Mode (Tree (Tok Token)) -> Identity (Mode (Tree (Tok Token))))
-> ExtHL (Tree (Tok Token))
-> Mode (Tree (Tok Token))
-> Mode (Tree (Tok Token))
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Scanner
   (State (State Token HlState) (Tok Token) (Tree (Tok Token)))
   (Tree (Tok Token))
 -> Scanner
      (State (State Token HlState) (Tok Token) (Tree (Tok Token)))
      (Tree (Tok Token)))
-> CharToTTScanner HlState -> ExtHL (Tree (Tok Token))
forall (tree :: * -> *) state lexState tt.
(IsTree tree, Show state) =>
(Scanner
   (State (State Token lexState) (Tok Token) (Tree (Tok Token)))
   (Tree (Tok Token))
 -> Scanner state (tree (Tok tt)))
-> CharToTTScanner lexState -> ExtHL (tree (Tok tt))
mkParenModeHL Scanner
  (State (State Token HlState) (Tok Token) (Tree (Tok Token)))
  (Tree (Tok Token))
-> Scanner
     (State (State Token HlState) (Tok Token) (Tree (Tok Token)))
     (Tree (Tok Token))
forall a. a -> a
id CharToTTScanner HlState
literateHaskellLexer
  Mode (Tree (Tok Token))
-> (Mode (Tree (Tok Token)) -> Mode (Tree (Tok Token)))
-> Mode (Tree (Tok Token))
forall a b. a -> (a -> b) -> b
& ((Tree (Tok Token) -> Point -> Point -> Point -> [Stroke])
 -> Identity
      (Tree (Tok Token) -> Point -> Point -> Point -> [Stroke]))
-> Mode (Tree (Tok Token)) -> Identity (Mode (Tree (Tok Token)))
forall syntax (f :: * -> *).
Functor f =>
((syntax -> Point -> Point -> Point -> [Stroke])
 -> f (syntax -> Point -> Point -> Point -> [Stroke]))
-> Mode syntax -> f (Mode syntax)
modeGetStrokesA (((Tree (Tok Token) -> Point -> Point -> Point -> [Stroke])
  -> Identity
       (Tree (Tok Token) -> Point -> Point -> Point -> [Stroke]))
 -> Mode (Tree (Tok Token)) -> Identity (Mode (Tree (Tok Token))))
-> (Tree (Tok Token) -> Point -> Point -> Point -> [Stroke])
-> Mode (Tree (Tok Token))
-> Mode (Tree (Tok Token))
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Tree (Tok Token) -> Point -> Point -> Point -> [Stroke]
strokesOfParenTree
    -- FIXME I think that 'begin' should not be ignored
  Mode (Tree (Tok Token))
-> (Mode (Tree (Tok Token)) -> Mode (Tree (Tok Token)))
-> Mode (Tree (Tok Token))
forall a b. a -> (a -> b) -> b
& ((Tree (Tok Token) -> IndentBehaviour -> BufferM ())
 -> Identity (Tree (Tok Token) -> IndentBehaviour -> BufferM ()))
-> Mode (Tree (Tok Token)) -> Identity (Mode (Tree (Tok Token)))
forall syntax (f :: * -> *).
Functor f =>
((syntax -> IndentBehaviour -> BufferM ())
 -> f (syntax -> IndentBehaviour -> BufferM ()))
-> Mode syntax -> f (Mode syntax)
modeIndentA (((Tree (Tok Token) -> IndentBehaviour -> BufferM ())
  -> Identity (Tree (Tok Token) -> IndentBehaviour -> BufferM ()))
 -> Mode (Tree (Tok Token)) -> Identity (Mode (Tree (Tok Token))))
-> (Tree (Tok Token) -> IndentBehaviour -> BufferM ())
-> Mode (Tree (Tok Token))
-> Mode (Tree (Tok Token))
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Tree (Tok Token) -> IndentBehaviour -> BufferM ()
cleverAutoIndentHaskellB
  Mode (Tree (Tok Token))
-> (Mode (Tree (Tok Token)) -> Mode (Tree (Tok Token)))
-> Mode (Tree (Tok Token))
forall a b. a -> (a -> b) -> b
& ((Tree (Tok Token) -> BufferM ())
 -> Identity (Tree (Tok Token) -> BufferM ()))
-> Mode (Tree (Tok Token)) -> Identity (Mode (Tree (Tok Token)))
forall syntax (f :: * -> *).
Functor f =>
((syntax -> BufferM ()) -> f (syntax -> BufferM ()))
-> Mode syntax -> f (Mode syntax)
modePrettifyA (((Tree (Tok Token) -> BufferM ())
  -> Identity (Tree (Tok Token) -> BufferM ()))
 -> Mode (Tree (Tok Token)) -> Identity (Mode (Tree (Tok Token))))
-> (Tree (Tok Token) -> BufferM ())
-> Mode (Tree (Tok Token))
-> Mode (Tree (Tok Token))
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Tok Token] -> BufferM ()
cleverPrettify ([Tok Token] -> BufferM ())
-> (Tree (Tok Token) -> [Tok Token])
-> Tree (Tok Token)
-> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree (Tok Token) -> [Tok Token]
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 (Exp (Tok Token))
preciseMode = Mode (Exp (Tok Token))
forall (tree :: * -> *). Mode (tree (Tok Token))
haskellAbstract
  Mode (Exp (Tok Token))
-> (Mode (Exp (Tok Token)) -> Mode (Exp (Tok Token)))
-> Mode (Exp (Tok Token))
forall a b. a -> (a -> b) -> b
& (Text -> Identity Text)
-> Mode (Exp (Tok Token)) -> Identity (Mode (Exp (Tok Token)))
forall syntax (f :: * -> *).
Functor f =>
(Text -> f Text) -> Mode syntax -> f (Mode syntax)
modeNameA ((Text -> Identity Text)
 -> Mode (Exp (Tok Token)) -> Identity (Mode (Exp (Tok Token))))
-> Text -> Mode (Exp (Tok Token)) -> Mode (Exp (Tok Token))
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
"precise haskell"
  Mode (Exp (Tok Token))
-> (Mode (Exp (Tok Token)) -> Mode (Exp (Tok Token)))
-> Mode (Exp (Tok Token))
forall a b. a -> (a -> b) -> b
& ((Exp (Tok Token) -> IndentBehaviour -> BufferM ())
 -> Identity (Exp (Tok Token) -> IndentBehaviour -> BufferM ()))
-> Mode (Exp (Tok Token)) -> Identity (Mode (Exp (Tok Token)))
forall syntax (f :: * -> *).
Functor f =>
((syntax -> IndentBehaviour -> BufferM ())
 -> f (syntax -> IndentBehaviour -> BufferM ()))
-> Mode syntax -> f (Mode syntax)
modeIndentA (((Exp (Tok Token) -> IndentBehaviour -> BufferM ())
  -> Identity (Exp (Tok Token) -> IndentBehaviour -> BufferM ()))
 -> Mode (Exp (Tok Token)) -> Identity (Mode (Exp (Tok Token))))
-> (Exp (Tok Token) -> IndentBehaviour -> BufferM ())
-> Mode (Exp (Tok Token))
-> Mode (Exp (Tok Token))
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Exp (Tok Token) -> IndentBehaviour -> BufferM ()
cleverAutoIndentHaskellC
  Mode (Exp (Tok Token))
-> (Mode (Exp (Tok Token)) -> Mode (Exp (Tok Token)))
-> Mode (Exp (Tok Token))
forall a b. a -> (a -> b) -> b
& ((Exp (Tok Token) -> Point -> Point -> Point -> [Stroke])
 -> Identity
      (Exp (Tok Token) -> Point -> Point -> Point -> [Stroke]))
-> Mode (Exp (Tok Token)) -> Identity (Mode (Exp (Tok Token)))
forall syntax (f :: * -> *).
Functor f =>
((syntax -> Point -> Point -> Point -> [Stroke])
 -> f (syntax -> Point -> Point -> Point -> [Stroke]))
-> Mode syntax -> f (Mode syntax)
modeGetStrokesA (((Exp (Tok Token) -> Point -> Point -> Point -> [Stroke])
  -> Identity
       (Exp (Tok Token) -> Point -> Point -> Point -> [Stroke]))
 -> Mode (Exp (Tok Token)) -> Identity (Mode (Exp (Tok Token))))
-> (Exp (Tok Token) -> Point -> Point -> Point -> [Stroke])
-> Mode (Exp (Tok Token))
-> Mode (Exp (Tok Token))
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (\Exp (Tok Token)
ast Point
point Point
begin Point
end -> Point -> Point -> Point -> Exp (Tok Token) -> [Stroke]
HS.getStrokes Point
point Point
begin Point
end Exp (Tok Token)
ast)
  Mode (Exp (Tok Token))
-> (Mode (Exp (Tok Token)) -> Mode (Exp (Tok Token)))
-> Mode (Exp (Tok Token))
forall a b. a -> (a -> b) -> b
& (ExtHL (Exp (Tok Token)) -> Identity (ExtHL (Exp (Tok Token))))
-> Mode (Exp (Tok Token)) -> Identity (Mode (Exp (Tok Token)))
forall syntax (f :: * -> *).
Functor f =>
(ExtHL syntax -> f (ExtHL syntax))
-> Mode syntax -> f (Mode syntax)
modeHLA ((ExtHL (Exp (Tok Token)) -> Identity (ExtHL (Exp (Tok Token))))
 -> Mode (Exp (Tok Token)) -> Identity (Mode (Exp (Tok Token))))
-> ExtHL (Exp (Tok Token))
-> Mode (Exp (Tok Token))
-> Mode (Exp (Tok Token))
forall s t a b. ASetter s t a b -> b -> s -> t
.~ CharToTTScanner Int -> ExtHL (Exp (Tok Token))
forall st. Show st => CharToTTScanner st -> ExtHL (Exp (Tok Token))
mkHaskModeHL CharToTTScanner Int
haskellLexer
  Mode (Exp (Tok Token))
-> (Mode (Exp (Tok Token)) -> Mode (Exp (Tok Token)))
-> Mode (Exp (Tok Token))
forall a b. a -> (a -> b) -> b
& ((Exp (Tok Token) -> BufferM ())
 -> Identity (Exp (Tok Token) -> BufferM ()))
-> Mode (Exp (Tok Token)) -> Identity (Mode (Exp (Tok Token)))
forall syntax (f :: * -> *).
Functor f =>
((syntax -> BufferM ()) -> f (syntax -> BufferM ()))
-> Mode syntax -> f (Mode syntax)
modePrettifyA (((Exp (Tok Token) -> BufferM ())
  -> Identity (Exp (Tok Token) -> BufferM ()))
 -> Mode (Exp (Tok Token)) -> Identity (Mode (Exp (Tok Token))))
-> (Exp (Tok Token) -> BufferM ())
-> Mode (Exp (Tok Token))
-> Mode (Exp (Tok Token))
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Tok Token] -> BufferM ()
cleverPrettify ([Tok Token] -> BufferM ())
-> (Exp (Tok Token) -> [Tok Token])
-> Exp (Tok Token)
-> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp (Tok Token) -> [Tok Token]
forall (t :: * -> *) a. Foldable t => t a -> [a]
allToks
--
strokesOfParenTree :: Paren.Tree TT -> Point -> Point -> Point -> [Stroke]
strokesOfParenTree :: Tree (Tok Token) -> Point -> Point -> Point -> [Stroke]
strokesOfParenTree Tree (Tok Token)
t Point
p Point
b Point
e = Point -> Point -> Point -> Tree (Tok Token) -> [Stroke]
Paren.getStrokes Point
p Point
b Point
e Tree (Tok Token)
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 :: forall (tree :: * -> *) state lexState tt.
(IsTree tree, Show state) =>
(Scanner
   (State (State Token lexState) (Tok Token) (Tree (Tok Token)))
   (Tree (Tok Token))
 -> Scanner state (tree (Tok tt)))
-> CharToTTScanner lexState -> ExtHL (tree (Tok tt))
mkParenModeHL Scanner
  (State (State Token lexState) (Tok Token) (Tree (Tok Token)))
  (Tree (Tok Token))
-> 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) (Tok Token) (Tree (Tok Token)))
  (Tree (Tok Token))
-> Scanner state (tree (Tok tt))
f (Scanner
   (State (State Token lexState) (Tok Token) (Tree (Tok Token)))
   (Tree (Tok Token))
 -> Scanner state (tree (Tok tt)))
-> (CharScanner
    -> Scanner
         (State (State Token lexState) (Tok Token) (Tree (Tok Token)))
         (Tree (Tok Token)))
-> CharScanner
-> Scanner state (tree (Tok tt))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser (Tok Token) (Tree (Tok Token))
-> Scanner (State Token lexState) (Tok Token)
-> Scanner
     (State (State Token lexState) (Tok Token) (Tree (Tok Token)))
     (Tree (Tok Token))
forall st token result.
Parser token result
-> Scanner st token -> Scanner (State st token result) result
IncrParser.scanner Parser (Tok Token) (Tree (Tok Token))
Paren.parse (Scanner (State Token lexState) (Tok Token)
 -> Scanner
      (State (State Token lexState) (Tok Token) (Tree (Tok Token)))
      (Tree (Tok Token)))
-> (CharScanner -> Scanner (State Token lexState) (Tok Token))
-> CharScanner
-> Scanner
     (State (State Token lexState) (Tok Token) (Tree (Tok Token)))
     (Tree (Tok Token))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scanner (AlexState lexState) (Tok Token)
-> Scanner (State Token lexState) (Tok Token)
forall lexState.
Scanner (AlexState lexState) (Tok Token)
-> Scanner (State Token lexState) (Tok Token)
Paren.indentScanner (Scanner (AlexState lexState) (Tok Token)
 -> Scanner (State Token lexState) (Tok Token))
-> CharToTTScanner lexState
-> CharScanner
-> Scanner (State Token lexState) (Tok Token)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CharToTTScanner lexState
l

mkHaskModeHL :: Show st => CharToTTScanner st -> ExtHL (Exp (Tok Token))
mkHaskModeHL :: forall st. Show st => CharToTTScanner st -> ExtHL (Exp (Tok Token))
mkHaskModeHL CharToTTScanner st
l = Highlighter
  (Cache
     (State (State Token st) (Tok Token) (Exp (Tok Token))) Exp Token)
  (Exp (Tok Token))
-> ExtHL (Exp (Tok Token))
forall syntax cache. Highlighter cache syntax -> ExtHL syntax
ExtHL (Highlighter
   (Cache
      (State (State Token st) (Tok Token) (Exp (Tok Token))) Exp Token)
   (Exp (Tok Token))
 -> ExtHL (Exp (Tok Token)))
-> Highlighter
     (Cache
        (State (State Token st) (Tok Token) (Exp (Tok Token))) Exp Token)
     (Exp (Tok Token))
-> ExtHL (Exp (Tok Token))
forall a b. (a -> b) -> a -> b
$ (CharScanner
 -> Scanner
      (State (State Token st) (Tok Token) (Exp (Tok Token)))
      (Exp (Tok Token)))
-> Highlighter
     (Cache
        (State (State Token st) (Tok Token) (Exp (Tok Token))) Exp Token)
     (Exp (Tok Token))
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) (Tok Token) (Exp (Tok Token)))
     (Exp (Tok Token))
scnr
  where
    scnr :: CharScanner
-> Scanner
     (State (State Token st) (Tok Token) (Exp (Tok Token)))
     (Exp (Tok Token))
scnr = Parser (Tok Token) (Exp (Tok Token))
-> Scanner (State Token st) (Tok Token)
-> Scanner
     (State (State Token st) (Tok Token) (Exp (Tok Token)))
     (Exp (Tok Token))
forall st token result.
Parser token result
-> Scanner st token -> Scanner (State st token result) result
IncrParser.scanner Parser (Tok Token) (Exp (Tok Token))
Hask.parse (Scanner (State Token st) (Tok Token)
 -> Scanner
      (State (State Token st) (Tok Token) (Exp (Tok Token)))
      (Exp (Tok Token)))
-> (CharScanner -> Scanner (State Token st) (Tok Token))
-> CharScanner
-> Scanner
     (State (State Token st) (Tok Token) (Exp (Tok Token)))
     (Exp (Tok Token))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scanner (AlexState st) (Tok Token)
-> Scanner (State Token st) (Tok Token)
forall lexState.
Scanner (AlexState lexState) (Tok Token)
-> Scanner (State Token lexState) (Tok Token)
Hask.indentScanner (Scanner (AlexState st) (Tok Token)
 -> Scanner (State Token st) (Tok Token))
-> CharToTTScanner st
-> CharScanner
-> Scanner (State Token st) (Tok Token)
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 :: forall st tt.
Show st =>
(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 Int
haskellLexer = Lexer AlexState Int (Tok Token) AlexInput -> CharToTTScanner Int
forall (l :: * -> *) s t i.
Lexer l s t i -> CharScanner -> Scanner (l s) t
lexScanner ((ASI Int -> Maybe (Tok Token, ASI Int))
-> Int -> Lexer AlexState Int (Tok Token) AlexInput
forall s t.
(ASI s -> Maybe (Tok t, ASI s))
-> s -> Lexer AlexState s (Tok t) AlexInput
commonLexer ASI Int -> Maybe (Tok Token, ASI Int)
Haskell.alexScanToken Int
Haskell.initState)

literateHaskellLexer :: CharScanner -> Scanner (AlexState LiterateHaskell.HlState) TT
literateHaskellLexer :: CharToTTScanner HlState
literateHaskellLexer = Lexer AlexState HlState (Tok Token) AlexInput
-> CharToTTScanner HlState
forall (l :: * -> *) s t i.
Lexer l s t i -> CharScanner -> Scanner (l s) t
lexScanner ((ASI HlState -> Maybe (Tok Token, ASI HlState))
-> HlState -> Lexer AlexState HlState (Tok Token) AlexInput
forall s t.
(ASI s -> Maybe (Tok t, ASI s))
-> s -> Lexer AlexState s (Tok t) AlexInput
commonLexer ASI HlState -> Maybe (Tok Token, 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 (Int, Int, Int, Point, Point)
indentInfoB = do
  Int
indentLevel    <- IndentSettings -> Int
shiftWidth (IndentSettings -> Int) -> BufferM IndentSettings -> BufferM Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM IndentSettings
indentSettingsB
  Int
previousIndent <- YiString -> BufferM Int
indentOfB (YiString -> BufferM Int) -> BufferM YiString -> BufferM Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Direction -> BufferM YiString
getNextNonBlankLineB Direction
Backward
  Int
nextIndent     <- YiString -> BufferM Int
indentOfB (YiString -> BufferM Int) -> BufferM YiString -> BufferM Int
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
  (Int, Int, Int, Point, Point)
-> BufferM (Int, Int, Int, Point, Point)
forall a. a -> BufferM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
indentLevel, Int
previousIndent, Int
nextIndent, Point
solPnt, Point
eolPnt)

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

cleverAutoIndentHaskellC :: Exp TT -> IndentBehaviour -> BufferM ()
cleverAutoIndentHaskellC :: Exp (Tok Token) -> IndentBehaviour -> BufferM ()
cleverAutoIndentHaskellC Exp (Tok Token)
e IndentBehaviour
behaviour = do
  (Int
indentLevel, Int
previousIndent, Int
nextIndent, Point
solPnt, Point
eolPnt) <- BufferM (Int, Int, Int, 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 :: [Exp (Tok Token)] -> Maybe (Tok Token)
firstTokNotOnLine = [Tok Token] -> Maybe (Tok Token)
forall a. [a] -> Maybe a
listToMaybe ([Tok Token] -> Maybe (Tok Token))
-> ([Exp (Tok Token)] -> [Tok Token])
-> [Exp (Tok Token)]
-> Maybe (Tok Token)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                              (Tok Token -> Bool) -> [Tok Token] -> [Tok Token]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Tok Token -> Bool) -> Tok Token -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point -> Bool
onThisLine (Point -> Bool) -> (Tok Token -> Point) -> Tok Token -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Posn -> Point
posnOfs (Posn -> Point) -> (Tok Token -> Posn) -> Tok Token -> Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tok Token -> Posn
forall t. Tok t -> Posn
tokPosn) ([Tok Token] -> [Tok Token])
-> ([Exp (Tok Token)] -> [Tok Token])
-> [Exp (Tok Token)]
-> [Tok Token]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                              (Tok Token -> Bool) -> [Tok Token] -> [Tok Token]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Tok Token -> Bool) -> Tok Token -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token -> Bool
isErrorTok (Token -> Bool) -> (Tok Token -> Token) -> Tok Token -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tok Token -> Token
forall t. Tok t -> t
tokT) ([Tok Token] -> [Tok Token])
-> ([Exp (Tok Token)] -> [Tok Token])
-> [Exp (Tok Token)]
-> [Tok Token]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Exp (Tok Token) -> [Tok Token])
-> [Exp (Tok Token)] -> [Tok Token]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Exp (Tok Token) -> [Tok Token]
forall (t :: * -> *) a. Foldable t => t a -> [a]
allToks
  let stopsOf :: [Hask.Exp TT] -> [Int]
      stopsOf :: [Exp (Tok Token)] -> [Int]
stopsOf (g :: Exp (Tok Token)
g@(Hask.Paren (Hask.PAtom Tok Token
open [Tok Token]
_) [Exp (Tok Token)]
ctnt (Hask.PAtom Tok Token
close [Tok Token]
_)):[Exp (Tok Token)]
ts)
          | Token -> Bool
isErrorTok (Tok Token -> Token
forall t. Tok t -> t
tokT Tok Token
close) Bool -> Bool -> Bool
|| Exp (Tok Token) -> Point
forall (t :: * -> *) t1. Foldable t => t (Tok t1) -> Point
getLastOffset Exp (Tok Token)
g Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
>= Point
solPnt
              = [Tok Token -> [Exp (Tok Token)] -> Int
groupIndent Tok Token
open [Exp (Tok Token)]
ctnt]
            -- stop here: we want to be "inside" that group.
          | Bool
otherwise = [Exp (Tok Token)] -> [Int]
stopsOf [Exp (Tok Token)]
ts
           -- this group is closed before this line; just skip it.
      stopsOf (Hask.PAtom (Tok {tokT :: forall t. Tok t -> t
tokT = Token
t}) [Tok Token]
_:[Exp (Tok Token)]
_) | 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)
          = [Int
nextIndent, Int
previousIndent Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
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 :: Exp (Tok Token)
l@(Hask.PLet Exp (Tok Token)
_ (Hask.Block [Exp (Tok Token)]
_) Exp (Tok Token)
_):[Exp (Tok Token)]
ts') = [Exp (Tok Token) -> Int
forall (t :: * -> *). Foldable t => t (Tok Token) -> Int
colOf' Exp (Tok Token)
l | Token -> Bool
lineStartsWith (ReservedType -> Token
Reserved ReservedType
Haskell.In)] [Int] -> [Int] -> [Int]
forall a. Semigroup a => a -> a -> a
<> [Exp (Tok Token)] -> [Int]
stopsOf [Exp (Tok Token)]
ts'
                                                       -- offer to align with let only if this is an "in"
      stopsOf (t :: Exp (Tok Token)
t@(Hask.Block [Exp (Tok Token)]
_):[Exp (Tok Token)]
ts') = (Int
shiftBlock Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Exp (Tok Token) -> Int
forall (t :: * -> *). Foldable t => t (Tok Token) -> Int
colOf' Exp (Tok Token)
t) Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Exp (Tok Token)] -> [Int]
stopsOf [Exp (Tok Token)]
ts'
                                       -- offer add another statement in the block
      stopsOf (Hask.PGuard' (PAtom Tok Token
pipe [Tok Token]
_) Exp (Tok Token)
_ Exp (Tok Token)
_:[Exp (Tok Token)]
ts') = [Tok Token -> Int
forall t. Tok t -> Int
tokCol Tok Token
pipe | Token -> Bool
lineStartsWith (OpType -> Token
ReservedOp OpType
Haskell.Pipe)] [Int] -> [Int] -> [Int]
forall a. Semigroup a => a -> a -> a
<> [Exp (Tok Token)] -> [Int]
stopsOf [Exp (Tok Token)]
ts'
                                                                 -- offer to align against another guard
      stopsOf (d :: Exp (Tok Token)
d@(Hask.PData {}):[Exp (Tok Token)]
ts') = Exp (Tok Token) -> Int
forall (t :: * -> *). Foldable t => t (Tok Token) -> Int
colOf' Exp (Tok Token)
d Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
indentLevel
                                           Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Exp (Tok Token)] -> [Int]
stopsOf [Exp (Tok Token)]
ts' --FIXME!
      stopsOf (Hask.RHS (Hask.PAtom{}) Exp (Tok Token)
exp:[Exp (Tok Token)]
ts')
          = [case Maybe Token
firstTokOnLine of
              Just (Operator String
op') -> String -> Int -> Int
forall {t :: * -> *} {a}. Foldable t => t a -> Int -> Int
opLength String
op' (Exp (Tok Token) -> Int
forall (t :: * -> *). Foldable t => t (Tok Token) -> Int
colOf' Exp (Tok Token)
exp) -- Usually operators are aligned against the '=' sign
              -- case of an operator should check so that value always is at least 1
              Maybe Token
_ -> Exp (Tok Token) -> Int
forall (t :: * -> *). Foldable t => t (Tok Token) -> Int
colOf' Exp (Tok Token)
exp | Bool
lineIsExpression ] [Int] -> [Int] -> [Int]
forall a. Semigroup a => a -> a -> a
<> [Exp (Tok Token)] -> [Int]
stopsOf [Exp (Tok Token)]
ts'
                   -- offer to continue the RHS if this looks like an expression.
      stopsOf [] = [Int
0] -- maybe it's new declaration in the module
      stopsOf (Exp (Tok Token)
_:[Exp (Tok Token)]
ts) = [Exp (Tok Token)] -> [Int]
stopsOf [Exp (Tok Token)]
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 -> Int -> Int
opLength t a
ts' Int
r = let l :: Int
l = Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
- (t a -> Int
forall a. t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
ts' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) -- I find this dubious...
                       in  if Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then Int
l else Int
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 = (Tok Token -> Token) -> [Tok Token] -> [Token]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Tok Token -> Token
forall t. Tok t -> t
tokT ([Tok Token] -> [Token]) -> [Tok Token] -> [Token]
forall a b. (a -> b) -> a -> b
$
          (Tok Token -> Bool) -> [Tok Token] -> [Tok Token]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile ((Point
solPnt Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
>) (Point -> Bool) -> (Tok Token -> Point) -> Tok Token -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tok Token -> Point
forall t. Tok t -> Point
tokBegin) ([Tok Token] -> [Tok Token]) -> [Tok Token] -> [Tok Token]
forall a b. (a -> b) -> a -> b
$
          (Tok Token -> Bool) -> [Tok Token] -> [Tok Token]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile ((Point
eolPnt Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
>) (Point -> Bool) -> (Tok Token -> Point) -> Tok Token -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tok Token -> Point
forall t. Tok t -> Point
tokBegin) ([Tok Token] -> [Tok Token]) -> [Tok Token] -> [Tok Token]
forall a b. (a -> b) -> a -> b
$ -- for laziness.
          (Tok Token -> Bool) -> [Tok Token] -> [Tok Token]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Tok Token -> Bool) -> Tok Token -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token -> Bool
isErrorTok (Token -> Bool) -> (Tok Token -> Token) -> Tok Token -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tok Token -> Token
forall t. Tok t -> t
tokT) ([Tok Token] -> [Tok Token]) -> [Tok Token] -> [Tok Token]
forall a b. (a -> b) -> a -> b
$ Exp (Tok Token) -> [Tok Token]
forall (t :: * -> *) a. Foldable t => t a -> [a]
allToks Exp (Tok Token)
e
      shiftBlock :: Int
shiftBlock = case Maybe Token
firstTokOnLine of
        Just (Reserved ReservedType
t) | ReservedType
t ReservedType -> [ReservedType] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ReservedType
Where, ReservedType
Deriving] -> Int
indentLevel
        Just (ReservedOp OpType
Haskell.Pipe) -> Int
indentLevel
        Just (ReservedOp OpType
Haskell.Equal) -> Int
indentLevel
        Maybe Token
_ -> Int
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 :: Tok Token -> [Exp (Tok Token)] -> Int
groupIndent (Tok {tokT :: forall t. Tok t -> t
tokT = Special Char
openChar, tokPosn :: forall t. Tok t -> Posn
tokPosn = Posn Point
_ Int
_ Int
openCol}) [Exp (Tok Token)]
ctnt
          | Bool
deepInGroup = case [Exp (Tok Token)] -> Maybe (Tok Token)
firstTokNotOnLine [Exp (Tok Token)]
ctnt of
              -- examine the first token of the group
              -- (but not on the line we are indenting!)
              Maybe (Tok Token)
Nothing -> Int
openCol Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
nominalIndent Char
openChar
              -- no such token: indent normally.
              Just Tok Token
t -> Posn -> Int
posnCol (Posn -> Int) -> (Tok Token -> Posn) -> Tok Token -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tok Token -> Posn
forall t. Tok t -> Posn
tokPosn (Tok Token -> Int) -> Tok Token -> Int
forall a b. (a -> b) -> a -> b
$ Tok Token
t -- indent along that other token
          | Bool
otherwise = Int
openCol
      groupIndent (Tok{}) [Exp (Tok Token)]
_ = Text -> Int
forall a. Text -> a
error Text
"unable to indent code"
  case [Exp (Tok Token)] -> Point -> Maybe [Exp (Tok Token)]
forall (tree :: * -> *) t.
IsTree tree =>
[tree (Tok t)] -> Point -> Maybe [tree (Tok t)]
getLastPath [Exp (Tok Token)
e] Point
solPnt of
    Maybe [Exp (Tok Token)]
Nothing -> () -> BufferM ()
forall a. a -> BufferM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just [Exp (Tok Token)]
path ->let stops :: [Int]
stops = [Exp (Tok Token)] -> [Int]
stopsOf [Exp (Tok Token)]
path
                in Text -> BufferM () -> BufferM ()
forall a. Text -> a -> a
trace (Text
"Path = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Exp (Tok Token)] -> Text
forall a. Show a => a -> Text
showT [Exp (Tok Token)]
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
<> [Int] -> Text
forall a. Show a => a -> Text
showT [Int]
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
<> Int -> Text
forall a. Show a => a -> Text
showT Int
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
<> Int -> Text
forall a. Show a => a -> Text
showT Int
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 -> [Int] -> BufferM ()
cycleIndentsB IndentBehaviour
behaviour [Int]
stops

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

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


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

tokText :: Tok t -> BufferM R.YiString
tokText :: forall t. 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 :: forall t. 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 :: Tok Token -> 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)
-> (Tok Token -> Maybe CommentType) -> Tok Token -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token -> Maybe CommentType
tokTyp (Token -> Maybe CommentType)
-> (Tok Token -> Token) -> Tok Token -> Maybe CommentType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tok Token -> Token
forall t. Tok t -> t
tokT

contiguous :: Tok t -> Tok t -> Bool
contiguous :: forall t. Tok t -> Tok t -> Bool
contiguous Tok t
a Tok t
b = Int
lb Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
la Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1
    where [Int
la,Int
lb] = (Tok t -> Int) -> [Tok t] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Posn -> Int
posnLine (Posn -> Int) -> (Tok t -> Posn) -> Tok t -> Int
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 :: Tok Token -> Tok Token -> Bool
coalesce Tok Token
a Tok Token
b = Tok Token -> Bool
isLineComment Tok Token
a Bool -> Bool -> Bool
&& Tok Token -> Bool
isLineComment Tok Token
b Bool -> Bool -> Bool
&& Tok Token -> Tok Token -> Bool
forall t. Tok t -> Tok t -> Bool
contiguous Tok Token
a Tok Token
b

cleverPrettify :: [TT] -> BufferM ()
cleverPrettify :: [Tok Token] -> BufferM ()
cleverPrettify [Tok Token]
toks = do
  Point
pnt <- BufferM Point
pointB
  let groups :: [[Tok Token]]
groups = (Tok Token -> Tok Token -> Bool) -> [Tok Token] -> [[Tok Token]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy' Tok Token -> Tok Token -> Bool
coalesce [Tok Token]
toks
      isCommentGroup :: [Tok Token] -> Bool
isCommentGroup [Tok Token]
g = Token -> Maybe CommentType
tokTyp (Tok Token -> Token
forall t. Tok t -> t
tokT (Tok Token -> Token) -> Tok Token -> Token
forall a b. (a -> b) -> a -> b
$ [Tok Token] -> Tok Token
forall a. HasCallStack => [a] -> a
head [Tok Token]
g) Maybe CommentType -> [Maybe CommentType] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (CommentType -> Maybe CommentType)
-> [CommentType] -> [Maybe CommentType]
forall a b. (a -> b) -> [a] -> [b]
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 [Tok Token]
thisCommentGroup = [[Tok Token]] -> Maybe [Tok Token]
forall a. [a] -> Maybe a
listToMaybe ([[Tok Token]] -> Maybe [Tok Token])
-> [[Tok Token]] -> Maybe [Tok Token]
forall a b. (a -> b) -> a -> b
$ ([Tok Token] -> Bool) -> [[Tok Token]] -> [[Tok Token]]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile ((Point
pnt Point -> Point -> Bool
forall a. Ord a => a -> a -> Bool
>) (Point -> Bool) -> ([Tok Token] -> Point) -> [Tok Token] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tok Token -> Point
forall t. Tok t -> Point
tokEnd (Tok Token -> Point)
-> ([Tok Token] -> Tok Token) -> [Tok Token] -> Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tok Token] -> Tok Token
forall a. HasCallStack => [a] -> a
last) ([[Tok Token]] -> [[Tok Token]]) -> [[Tok Token]] -> [[Tok Token]]
forall a b. (a -> b) -> a -> b
$ ([Tok Token] -> Bool) -> [[Tok Token]] -> [[Tok Token]]
forall a. (a -> Bool) -> [a] -> [a]
filter [Tok Token] -> Bool
isCommentGroup [[Tok Token]]
groups
                         -- FIXME: laziness
  case Maybe [Tok Token]
thisCommentGroup of
    Maybe [Tok Token]
Nothing -> () -> BufferM ()
forall a. a -> BufferM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just [Tok Token]
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 a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Text -> Text
T.drop Int
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
<$> (Tok Token -> BufferM YiString)
-> [Tok Token] -> BufferM [YiString]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Tok Token -> BufferM YiString
forall t. Tok t -> BufferM YiString
tokText [Tok Token]
g
      let region :: Region
region = Point -> Point -> Region
mkRegion (Tok Token -> Point
forall t. Tok t -> Point
tokBegin (Tok Token -> Point)
-> ([Tok Token] -> Tok Token) -> [Tok Token] -> Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tok Token] -> Tok Token
forall a. HasCallStack => [a] -> a
head ([Tok Token] -> Point) -> [Tok Token] -> Point
forall a b. (a -> b) -> a -> b
$ [Tok Token]
g) (Tok Token -> Point
forall t. Tok t -> Point
tokEnd (Tok Token -> Point)
-> ([Tok Token] -> Tok Token) -> [Tok Token] -> Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tok Token] -> Tok Token
forall a. HasCallStack => [a] -> a
last ([Tok Token] -> Point) -> [Tok Token] -> Point
forall a b. (a -> b) -> a -> b
$ [Tok Token]
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
<$> Int -> YiString -> [YiString]
fillText Int
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
$cdef :: GhciBuffer
def :: 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
$cput :: GhciBuffer -> Put
put :: GhciBuffer -> Put
$cget :: Get GhciBuffer
get :: Get GhciBuffer
$cputList :: [GhciBuffer] -> Put
putList :: [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 <- String -> [String] -> YiM BufferRef
GHCi.spawnProcess (GhciProcessName
g GhciProcessName -> Getting String GhciProcessName String -> String
forall s a. s -> Getting a s a -> a
^. Getting String GhciProcessName String
Lens' GhciProcessName String
GHCi.ghciProcessName) (GhciProcessName
g GhciProcessName
-> Getting [String] GhciProcessName [String] -> [String]
forall s a. s -> Getting a s a -> a
^. Getting [String] GhciProcessName [String]
Lens' GhciProcessName [String]
GHCi.ghciProcessArgs)
  EditorM () -> YiM ()
forall a. EditorM a -> YiM a
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 a. a -> YiM a
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 a. EditorM a -> YiM a
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 a. EditorM a -> YiM a
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 a. a -> YiM a
forall (m :: * -> *) a. Monad m => a -> m a
return BufferRef
b
                else YiM BufferRef
ghci

-- | Send a command to GHCi
ghciSend :: String -> YiM ()
ghciSend :: String -> YiM ()
ghciSend String
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 -> String -> YiM ()
sendToProcess BufferRef
b (String
cmd String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\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 String
f <- BufferM (Maybe String) -> YiM (Maybe String)
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer ((FBuffer -> Maybe String) -> BufferM (Maybe String)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets FBuffer -> Maybe String
file)
    case Maybe String
f of
      Maybe String
Nothing -> Text -> YiM ()
forall a. Text -> a
error Text
"Couldn't get buffer filename in ghciLoadBuffer"
      Just String
filename -> String -> YiM ()
ghciSend (String -> YiM ()) -> String -> YiM ()
forall a b. (a -> b) -> a -> b
$ String
":load " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
forall a. Show a => a -> String
show String
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 a. a -> YiM a
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 a. a -> YiM a
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 -> String -> YiM YiString
Interactive.queryReply BufferRef
buf (String
":t " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> YiString -> String
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 a b. BufferM a -> BufferM b -> BufferM b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> BufferM ()
insertB Char
'\n' BufferM () -> BufferM () -> BufferM ()
forall a b. BufferM a -> BufferM b -> BufferM b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> BufferM ()
leftB
      BufferM () -> BufferM () -> BufferM ()
forall a b. BufferM a -> BufferM b -> BufferM b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> YiString -> BufferM ()
insertN YiString
result BufferM () -> BufferM () -> BufferM ()
forall a b. BufferM a -> BufferM b -> BufferM b
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 :: String
nm = GhciProcessName
g GhciProcessName -> Getting String GhciProcessName String -> String
forall s a. s -> Getting a s a -> a
^. Getting String GhciProcessName String
Lens' GhciProcessName String
GHCi.ghciProcessName
      prompt :: Text
prompt = [Text] -> Text
T.concat [ Text
"Command to call for GHCi, currently ‘"
                        , String -> Text
T.pack String
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
& (String -> Identity String)
-> GhciProcessName -> Identity GhciProcessName
Lens' GhciProcessName String
GHCi.ghciProcessName ((String -> Identity String)
 -> GhciProcessName -> Identity GhciProcessName)
-> String -> GhciProcessName -> GhciProcessName
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text -> String
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 :: String
nm = GhciProcessName
g GhciProcessName -> Getting String GhciProcessName String -> String
forall s a. s -> Getting a s a -> a
^. Getting String GhciProcessName String
Lens' GhciProcessName String
GHCi.ghciProcessName
      args :: [String]
args = GhciProcessName
g GhciProcessName
-> Getting [String] GhciProcessName [String] -> [String]
forall s a. s -> Getting a s a -> a
^. Getting [String] GhciProcessName [String]
Lens' GhciProcessName [String]
GHCi.ghciProcessArgs
      prompt :: Text
prompt = [Text] -> Text
T.unwords [ Text
"List of args to call "
                         , String -> Text
T.pack String
nm
                         , Text
"with, currently"
                         , String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. Show a => a -> String
show [String]
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 String -> Maybe [String]
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe [String]) -> String -> Maybe [String]
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
arg of
      Maybe [String]
Nothing -> Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg Text
"Could not parse as [String], keep old args."
      Just [String]
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
& ([String] -> Identity [String])
-> GhciProcessName -> Identity GhciProcessName
Lens' GhciProcessName [String]
GHCi.ghciProcessArgs (([String] -> Identity [String])
 -> GhciProcessName -> Identity GhciProcessName)
-> [String] -> GhciProcessName -> GhciProcessName
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [String]
arg'