{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_HADDOCK show-extensions #-}
module Yi.Keymap.Emacs.Utils
( UnivArgument
, argToInt
, askQuitEditor
, askSaveEditor
, modifiedQuitEditor
, withMinibuffer
, queryReplaceE
, isearchKeymap
, cabalConfigureE
, cabalBuildE
, reloadProjectE
, executeExtendedCommandE
, evalRegionE
, readUniversalArg
, scrollDownE
, scrollUpE
, switchBufferE
, killBufferE
, insertNextC
, findFile
, findFileReadOnly
, findFileNewTab
, promptFile
, promptTag
, justOneSep
, joinLinesE
, countWordsRegion
)
where
import Control.Applicative (Alternative ((<|>), many, some), optional)
import Lens.Micro.Platform (use, (.=))
import Control.Monad (filterM, replicateM_, void)
import Control.Monad.Base ()
import Data.List ((\\))
import Data.Maybe (fromMaybe)
import Data.Monoid ((<>))
import qualified Data.Text as T (Text, concat, null, pack, singleton, snoc, unpack, unwords)
import System.FilePath (takeDirectory, takeFileName, (</>))
import System.FriendlyPath ()
import Yi.Buffer
import Yi.Command (cabalBuildE, cabalConfigureE, reloadProjectE)
import Yi.Core (quitEditor)
import Yi.Editor
import Yi.Eval (execEditorAction, getAllNamesInScope)
import Yi.File (deservesSave, editFile, fwriteBufferE, openingNewFile)
import Yi.Keymap (Keymap, KeymapM, YiM, write)
import Yi.Keymap.Keys
import Yi.MiniBuffer
import Yi.Misc (promptFile)
import Yi.Monad (gets)
import Yi.Rectangle (getRectangle)
import Yi.Regex (makeSearchOptsM)
import qualified Yi.Rope as R (countNewLines, fromText, length, replicateChar, toText, words)
import Yi.Search
import Yi.String (showT)
import Yi.Tag
import Yi.Utils (io)
type UnivArgument = Maybe Int
askQuitEditor :: YiM ()
askQuitEditor :: YiM ()
askQuitEditor = Bool -> [FBuffer] -> YiM ()
askIndividualSave Bool
True ([FBuffer] -> YiM ()) -> YiM [FBuffer] -> YiM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< YiM [FBuffer]
getModifiedBuffers
askSaveEditor :: YiM ()
askSaveEditor :: YiM ()
askSaveEditor = Bool -> [FBuffer] -> YiM ()
askIndividualSave Bool
False ([FBuffer] -> YiM ()) -> YiM [FBuffer] -> YiM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< YiM [FBuffer]
getModifiedBuffers
getModifiedBuffers :: YiM [FBuffer]
getModifiedBuffers :: YiM [FBuffer]
getModifiedBuffers = (FBuffer -> YiM Bool) -> [FBuffer] -> YiM [FBuffer]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM FBuffer -> YiM Bool
deservesSave ([FBuffer] -> YiM [FBuffer]) -> YiM [FBuffer] -> YiM [FBuffer]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Editor -> [FBuffer]) -> YiM [FBuffer]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets Editor -> [FBuffer]
bufferSet
askIndividualSave :: Bool -> [FBuffer] -> YiM ()
askIndividualSave :: Bool -> [FBuffer] -> YiM ()
askIndividualSave True [] = YiM ()
modifiedQuitEditor
askIndividualSave False [] = () -> YiM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
askIndividualSave hasQuit :: Bool
hasQuit allBuffers :: [FBuffer]
allBuffers@(firstBuffer :: FBuffer
firstBuffer : others :: [FBuffer]
others) =
YiM BufferRef -> YiM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (EditorM BufferRef -> YiM BufferRef
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (Text -> KeymapEndo -> EditorM BufferRef
spawnMinibufferE Text
saveMessage (I Event Action () -> KeymapEndo
forall a b. a -> b -> a
const I Event Action ()
askKeymap)))
where
saveMessage :: Text
saveMessage = [Text] -> Text
T.concat [ "do you want to save the buffer: "
, Text
bufferName
, "? (y/n/", if Bool
hasQuit then "q/" else "", "c/!)"
]
bufferName :: Text
bufferName = FBuffer -> Text
identString FBuffer
firstBuffer
askKeymap :: I Event Action ()
askKeymap = [I Event Action ()] -> I Event Action ()
forall (m :: * -> *) w e a.
(MonadInteract m w e, MonadFail m) =>
[m a] -> m a
choice ([ Char -> Event
char 'n' Event -> YiM () -> I Event Action ()
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! YiM ()
noAction
, Char -> Event
char 'y' Event -> YiM () -> I Event Action ()
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! YiM ()
yesAction
, Char -> Event
char '!' Event -> YiM () -> I Event Action ()
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! YiM ()
allAction
, [Event] -> I Event Action Event
forall event (m :: * -> *) w.
(Ord event, MonadInteract m w event, MonadFail m) =>
[event] -> m event
oneOf [Char -> Event
char 'c', Event -> Event
ctrl (Event -> Event) -> Event -> Event
forall a b. (a -> b) -> a -> b
$ Char -> Event
char 'g']
I Event Action Event -> EditorM () -> I Event Action ()
forall (m :: * -> *) a x b.
(MonadInteract m Action Event, YiAction a x, Show x) =>
m b -> a -> m ()
>>! EditorM ()
closeBufferAndWindowE
] [I Event Action ()] -> [I Event Action ()] -> [I Event Action ()]
forall a. [a] -> [a] -> [a]
++ [Char -> Event
char 'q' Event -> YiM () -> I Event Action ()
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! YiM ()
quitEditor | Bool
hasQuit])
yesAction :: YiM ()
yesAction = do YiM Bool -> YiM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (YiM Bool -> YiM ()) -> YiM Bool -> YiM ()
forall a b. (a -> b) -> a -> b
$ BufferRef -> YiM Bool
fwriteBufferE (FBuffer -> BufferRef
bkey FBuffer
firstBuffer)
EditorM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor EditorM ()
closeBufferAndWindowE
YiM ()
continue
noAction :: YiM ()
noAction = do EditorM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor EditorM ()
closeBufferAndWindowE
YiM ()
continue
allAction :: YiM ()
allAction = do (BufferRef -> YiM Bool) -> [BufferRef] -> YiM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ BufferRef -> YiM Bool
fwriteBufferE ([BufferRef] -> YiM ()) -> [BufferRef] -> YiM ()
forall a b. (a -> b) -> a -> b
$ (FBuffer -> BufferRef) -> [FBuffer] -> [BufferRef]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FBuffer -> BufferRef
bkey [FBuffer]
allBuffers
EditorM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor EditorM ()
closeBufferAndWindowE
Bool -> [FBuffer] -> YiM ()
askIndividualSave Bool
hasQuit []
continue :: YiM ()
continue = Bool -> [FBuffer] -> YiM ()
askIndividualSave Bool
hasQuit [FBuffer]
others
modifiedQuitEditor :: YiM ()
modifiedQuitEditor :: YiM ()
modifiedQuitEditor =
do [FBuffer]
modifiedBuffers <- YiM [FBuffer]
getModifiedBuffers
if [FBuffer] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FBuffer]
modifiedBuffers
then YiM ()
quitEditor
else EditorM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (EditorM () -> YiM ()) -> EditorM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ EditorM BufferRef -> EditorM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Text -> KeymapEndo -> EditorM BufferRef
spawnMinibufferE Text
modifiedMessage (I Event Action () -> KeymapEndo
forall a b. a -> b -> a
const I Event Action ()
askKeymap))
where
modifiedMessage :: Text
modifiedMessage = "Modified buffers exist really quit? (y/n)"
askKeymap :: I Event Action ()
askKeymap = [I Event Action ()] -> I Event Action ()
forall (m :: * -> *) w e a.
(MonadInteract m w e, MonadFail m) =>
[m a] -> m a
choice [ Char -> Event
char 'n' Event -> EditorM () -> I Event Action ()
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! EditorM ()
noAction
, Char -> Event
char 'y' Event -> YiM () -> I Event Action ()
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! YiM ()
quitEditor
]
noAction :: EditorM ()
noAction = EditorM ()
closeBufferAndWindowE
selfSearchKeymap :: Keymap
selfSearchKeymap :: I Event Action ()
selfSearchKeymap = do
Event (KASCII c :: Char
c) [] <- I Event Action Event
forall event (m :: * -> *) w.
(Ord event, MonadInteract m w event) =>
m event
anyEvent
EditorM () -> I Event Action ()
forall (m :: * -> *) ev a x.
(MonadInteract m Action ev, YiAction a x, Show x) =>
a -> m ()
write (EditorM () -> I Event Action ())
-> (Text -> EditorM ()) -> Text -> I Event Action ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> EditorM ()
isearchAddE (Text -> I Event Action ()) -> Text -> I Event Action ()
forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
c
searchKeymap :: Keymap
searchKeymap :: I Event Action ()
searchKeymap = I Event Action ()
selfSearchKeymap I Event Action () -> KeymapEndo
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [I Event Action ()] -> I Event Action ()
forall (m :: * -> *) w e a.
(MonadInteract m w e, MonadFail m) =>
[m a] -> m a
choice
[
Event -> Event
ctrl (Char -> Event
char 'r') Event -> EditorM () -> I Event Action ()
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! EditorM ()
isearchPrevE
, Event -> Event
ctrl (Char -> Event
char 's') Event -> EditorM () -> I Event Action ()
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! EditorM ()
isearchNextE
, Event -> Event
ctrl (Char -> Event
char 'w') Event -> EditorM () -> I Event Action ()
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! EditorM ()
isearchWordE
, Event -> Event
meta (Char -> Event
char 'p') Event -> EditorM () -> I Event Action ()
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! Int -> EditorM ()
isearchHistory 1
, Event -> Event
meta (Char -> Event
char 'n') Event -> EditorM () -> I Event Action ()
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! Int -> EditorM ()
isearchHistory (-1)
, Key -> Event
spec Key
KBS Event -> EditorM () -> I Event Action ()
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! EditorM ()
isearchDelE
]
isearchKeymap :: Direction -> Keymap
isearchKeymap :: Direction -> I Event Action ()
isearchKeymap dir :: Direction
dir =
do EditorM () -> I Event Action ()
forall (m :: * -> *) ev a x.
(MonadInteract m Action ev, YiAction a x, Show x) =>
a -> m ()
write (EditorM () -> I Event Action ())
-> EditorM () -> I Event Action ()
forall a b. (a -> b) -> a -> b
$ Direction -> EditorM ()
isearchInitE Direction
dir
I Event Action [()] -> I Event Action ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (I Event Action [()] -> I Event Action ())
-> I Event Action [()] -> I Event Action ()
forall a b. (a -> b) -> a -> b
$ I Event Action () -> I Event Action [()]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many I Event Action ()
searchKeymap
[I Event Action ()] -> I Event Action ()
forall (m :: * -> *) w e a.
(MonadInteract m w e, MonadFail m) =>
[m a] -> m a
choice [ Event -> Event
ctrl (Char -> Event
char 'g') Event -> EditorM () -> I Event Action ()
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! EditorM ()
isearchCancelE
, [Event] -> I Event Action Event
forall event (m :: * -> *) w.
(Ord event, MonadInteract m w event, MonadFail m) =>
[event] -> m event
oneOf [Event -> Event
ctrl (Char -> Event
char 'm'), Key -> Event
spec Key
KEnter]
I Event Action Event -> EditorM () -> I Event Action ()
forall (m :: * -> *) a x b.
(MonadInteract m Action Event, YiAction a x, Show x) =>
m b -> a -> m ()
>>! EditorM () -> EditorM ()
forall a. EditorM a -> EditorM ()
isearchFinishWithE EditorM ()
resetRegexE
]
I Event Action () -> KeymapEndo
forall (f :: * -> *) w e a.
MonadInteract f w e =>
f a -> f a -> f a
<|| EditorM () -> I Event Action ()
forall (m :: * -> *) ev a x.
(MonadInteract m Action ev, YiAction a x, Show x) =>
a -> m ()
write EditorM ()
isearchFinishE
queryReplaceE :: YiM ()
queryReplaceE :: YiM ()
queryReplaceE = Text -> (Text -> YiM ()) -> YiM ()
withMinibufferFree "Replace:" ((Text -> YiM ()) -> YiM ()) -> (Text -> YiM ()) -> YiM ()
forall a b. (a -> b) -> a -> b
$ \replaceWhat :: Text
replaceWhat ->
Text -> (Text -> YiM ()) -> YiM ()
withMinibufferFree "With:" ((Text -> YiM ()) -> YiM ()) -> (Text -> YiM ()) -> YiM ()
forall a b. (a -> b) -> a -> b
$ \replaceWith :: Text
replaceWith -> do
BufferRef
b <- (Editor -> BufferRef) -> YiM BufferRef
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets Editor -> BufferRef
currentBuffer
Window
win <- Getting Window Editor Window -> YiM Window
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Window Editor Window
Lens' Editor Window
currentWindowA
let repStr :: YiString
repStr = Text -> YiString
R.fromText Text
replaceWith
replaceKm :: I Event Action ()
replaceKm =
[I Event Action ()] -> I Event Action ()
forall (m :: * -> *) w e a.
(MonadInteract m w e, MonadFail m) =>
[m a] -> m a
choice [ Char -> Event
char 'n' Event -> EditorM () -> I Event Action ()
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! Window -> BufferRef -> SearchExp -> EditorM ()
qrNext Window
win BufferRef
b SearchExp
re
, Char -> Event
char '!' Event -> EditorM () -> I Event Action ()
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! Window -> BufferRef -> SearchExp -> YiString -> EditorM ()
qrReplaceAll Window
win BufferRef
b SearchExp
re YiString
repStr
, [Event] -> I Event Action Event
forall event (m :: * -> *) w.
(Ord event, MonadInteract m w event, MonadFail m) =>
[event] -> m event
oneOf [Char -> Event
char 'y', Char -> Event
char ' '] I Event Action Event -> EditorM () -> I Event Action ()
forall (m :: * -> *) a x b.
(MonadInteract m Action Event, YiAction a x, Show x) =>
m b -> a -> m ()
>>! Window -> BufferRef -> SearchExp -> YiString -> EditorM ()
qrReplaceOne Window
win BufferRef
b SearchExp
re YiString
repStr
, [Event] -> I Event Action Event
forall event (m :: * -> *) w.
(Ord event, MonadInteract m w event, MonadFail m) =>
[event] -> m event
oneOf [Char -> Event
char 'q', Event -> Event
ctrl (Char -> Event
char 'g')] I Event Action Event -> EditorM () -> I Event Action ()
forall (m :: * -> *) a x b.
(MonadInteract m Action Event, YiAction a x, Show x) =>
m b -> a -> m ()
>>! EditorM ()
qrFinish
]
Right re :: SearchExp
re = [SearchOption] -> String -> Either String SearchExp
makeSearchOptsM [] (Text -> String
T.unpack Text
replaceWhat)
question :: Text
question = [Text] -> Text
T.unwords [ "Replacing", Text
replaceWhat
, "with", Text
replaceWith, " (y,n,q,!):"
]
EditorM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (EditorM () -> YiM ()) -> EditorM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ do
SearchExp -> EditorM ()
setRegexE SearchExp
re
EditorM BufferRef -> EditorM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (EditorM BufferRef -> EditorM ())
-> EditorM BufferRef -> EditorM ()
forall a b. (a -> b) -> a -> b
$ Text -> KeymapEndo -> EditorM BufferRef
spawnMinibufferE Text
question (I Event Action () -> KeymapEndo
forall a b. a -> b -> a
const I Event Action ()
replaceKm)
Window -> BufferRef -> SearchExp -> EditorM ()
qrNext Window
win BufferRef
b SearchExp
re
executeExtendedCommandE :: YiM ()
executeExtendedCommandE :: YiM ()
executeExtendedCommandE = Text -> (Text -> YiM [Text]) -> (Text -> YiM ()) -> YiM ()
withMinibuffer "M-x" Text -> YiM [Text]
forall b. b -> YiM [Text]
scope Text -> YiM ()
act
where
act :: Text -> YiM ()
act = String -> YiM ()
execEditorAction (String -> YiM ()) -> (Text -> String) -> Text -> YiM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
scope :: b -> YiM [Text]
scope = YiM [Text] -> b -> YiM [Text]
forall a b. a -> b -> a
const (YiM [Text] -> b -> YiM [Text]) -> YiM [Text] -> b -> YiM [Text]
forall a b. (a -> b) -> a -> b
$ (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
T.pack ([String] -> [Text]) -> YiM [String] -> YiM [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> YiM [String]
getAllNamesInScope
evalRegionE :: YiM ()
evalRegionE :: YiM ()
evalRegionE = do
YiM YiString -> YiM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (YiM YiString -> YiM ()) -> YiM YiString -> YiM ()
forall a b. (a -> b) -> a -> b
$ BufferM YiString -> YiM YiString
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM Region
getSelectRegionB BufferM Region -> (Region -> BufferM YiString) -> BufferM YiString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Region -> BufferM YiString
readRegionB)
() -> YiM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
insertNextC :: UnivArgument -> KeymapM ()
insertNextC :: UnivArgument -> I Event Action ()
insertNextC a :: UnivArgument
a = do Event
c <- I Event Action Event
forall event (m :: * -> *) w.
(Ord event, MonadInteract m w event) =>
m event
anyEvent
BufferM () -> I Event Action ()
forall (m :: * -> *) ev a x.
(MonadInteract m Action ev, YiAction a x, Show x) =>
a -> m ()
write (BufferM () -> I Event Action ())
-> BufferM () -> I Event Action ()
forall a b. (a -> b) -> a -> b
$ Int -> BufferM () -> BufferM ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ (UnivArgument -> Int
argToInt UnivArgument
a) (BufferM () -> BufferM ()) -> BufferM () -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Char -> BufferM ()
insertB (Event -> Char
eventToChar Event
c)
argToInt :: UnivArgument -> Int
argToInt :: UnivArgument -> Int
argToInt = Int -> UnivArgument -> Int
forall a. a -> Maybe a -> a
fromMaybe 1
digit :: (Event -> Event) -> KeymapM Char
digit :: (Event -> Event) -> KeymapM Char
digit f :: Event -> Event
f = (Event -> Event) -> Char -> Char -> KeymapM Char
forall (m :: * -> *) w.
(MonadFail m, MonadInteract m w Event) =>
(Event -> Event) -> Char -> Char -> m Char
charOf Event -> Event
f '0' '9'
tt :: KeymapM Char
tt :: KeymapM Char
tt = do
Event (KASCII c :: Char
c) _ <- (I Event Action Event
-> I Event Action Event -> I Event Action Event)
-> [I Event Action Event] -> I Event Action Event
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 I Event Action Event
-> I Event Action Event -> I Event Action Event
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) ([I Event Action Event] -> I Event Action Event)
-> [I Event Action Event] -> I Event Action Event
forall a b. (a -> b) -> a -> b
$ (Char -> I Event Action Event) -> String -> [I Event Action Event]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Event -> I Event Action Event
forall event (m :: * -> *) w.
(Ord event, MonadInteract m w event) =>
event -> m event
event (Event -> I Event Action Event)
-> (Char -> Event) -> Char -> I Event Action Event
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Event
metaCh ) ['0'..'9']
Char -> KeymapM Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
c
readUniversalArg :: KeymapM (Maybe Int)
readUniversalArg :: KeymapM UnivArgument
readUniversalArg = I Event Action Int -> KeymapM UnivArgument
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ((Char -> Event
ctrlCh 'u' Event -> I Event Action Int -> I Event Action Int
forall (m :: * -> *) action a.
MonadInteract m action Event =>
Event -> m a -> m a
?>> (String -> Int
forall a. Read a => String -> a
read (String -> Int) -> I Event Action String -> I Event Action Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeymapM Char -> I Event Action String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some ((Event -> Event) -> KeymapM Char
digit Event -> Event
forall a. a -> a
id) I Event Action Int -> I Event Action Int -> I Event Action Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> I Event Action Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure 4)) I Event Action Int -> I Event Action Int -> I Event Action Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (String -> Int
forall a. Read a => String -> a
read (String -> Int) -> I Event Action String -> I Event Action Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeymapM Char -> I Event Action String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some KeymapM Char
tt))
findFileAndDo :: T.Text
-> BufferM a
-> YiM ()
findFileAndDo :: Text -> BufferM a -> YiM ()
findFileAndDo prompt :: Text
prompt act :: BufferM a
act = Text -> (Text -> YiM ()) -> YiM ()
promptFile Text
prompt ((Text -> YiM ()) -> YiM ()) -> (Text -> YiM ()) -> YiM ()
forall a b. (a -> b) -> a -> b
$ \filename :: Text
filename -> do
Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg (Text -> YiM ()) -> Text -> YiM ()
forall a b. (a -> b) -> a -> b
$ "loading " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
filename
String -> BufferM a -> YiM ()
forall a. String -> BufferM a -> YiM ()
openingNewFile (Text -> String
T.unpack Text
filename) BufferM a
act
findFile :: YiM ()
findFile :: YiM ()
findFile = Text -> BufferM () -> YiM ()
forall a. Text -> BufferM a -> YiM ()
findFileAndDo "find file:" (BufferM () -> YiM ()) -> BufferM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ () -> BufferM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
findFileReadOnly :: YiM ()
findFileReadOnly :: YiM ()
findFileReadOnly = Text -> BufferM () -> YiM ()
forall a. Text -> BufferM a -> YiM ()
findFileAndDo "find file (read only):" (BufferM () -> YiM ()) -> BufferM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ (Bool -> Identity Bool) -> FBuffer -> Identity FBuffer
forall c. HasAttributes c => Lens' c Bool
readOnlyA ((Bool -> Identity Bool) -> FBuffer -> Identity FBuffer)
-> Bool -> BufferM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True
findFileNewTab :: YiM ()
findFileNewTab :: YiM ()
findFileNewTab = Text -> (Text -> YiM ()) -> YiM ()
promptFile "find file (new tab): " ((Text -> YiM ()) -> YiM ()) -> (Text -> YiM ()) -> YiM ()
forall a b. (a -> b) -> a -> b
$ \filename :: Text
filename -> do
EditorM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor EditorM ()
newTabE
Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg (Text -> YiM ()) -> Text -> YiM ()
forall a b. (a -> b) -> a -> b
$ "loading " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
filename
YiM (Either Text BufferRef) -> YiM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (YiM (Either Text BufferRef) -> YiM ())
-> (String -> YiM (Either Text BufferRef)) -> String -> YiM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> YiM (Either Text BufferRef)
editFile (String -> YiM ()) -> String -> YiM ()
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
filename
scrollDownE :: UnivArgument -> BufferM ()
scrollDownE :: UnivArgument -> BufferM ()
scrollDownE a :: UnivArgument
a = case UnivArgument
a of
Nothing -> BufferM ()
downScreenB
Just n :: Int
n -> Int -> BufferM ()
scrollB Int
n
scrollUpE :: UnivArgument -> BufferM ()
scrollUpE :: UnivArgument -> BufferM ()
scrollUpE a :: UnivArgument
a = case UnivArgument
a of
Nothing -> BufferM ()
upScreenB
Just n :: Int
n -> Int -> BufferM ()
scrollB (Int -> Int
forall a. Num a => a -> a
negate Int
n)
switchBufferE :: YiM ()
switchBufferE :: YiM ()
switchBufferE = Text
-> (BufferRef -> YiM ())
-> ([BufferRef] -> [BufferRef] -> [BufferRef])
-> YiM ()
promptingForBuffer "switch to buffer:"
(EditorM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (EditorM () -> YiM ())
-> (BufferRef -> EditorM ()) -> BufferRef -> YiM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BufferRef -> EditorM ()
switchToBufferE) (\o :: [BufferRef]
o b :: [BufferRef]
b -> ([BufferRef]
b [BufferRef] -> [BufferRef] -> [BufferRef]
forall a. Eq a => [a] -> [a] -> [a]
\\ [BufferRef]
o) [BufferRef] -> [BufferRef] -> [BufferRef]
forall a. [a] -> [a] -> [a]
++ [BufferRef]
o)
killBufferE :: YiM ()
killBufferE :: YiM ()
killBufferE = Text
-> (BufferRef -> YiM ())
-> ([BufferRef] -> [BufferRef] -> [BufferRef])
-> YiM ()
promptingForBuffer "kill buffer:" BufferRef -> YiM ()
k (\o :: [BufferRef]
o b :: [BufferRef]
b -> [BufferRef]
o [BufferRef] -> [BufferRef] -> [BufferRef]
forall a. [a] -> [a] -> [a]
++ ([BufferRef]
b [BufferRef] -> [BufferRef] -> [BufferRef]
forall a. Eq a => [a] -> [a] -> [a]
\\ [BufferRef]
o))
where
k :: BufferRef -> YiM ()
k :: BufferRef -> YiM ()
k b :: BufferRef
b = do
FBuffer
buf <- EditorM FBuffer -> YiM FBuffer
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (EditorM FBuffer -> YiM FBuffer)
-> ((Editor -> FBuffer) -> EditorM FBuffer)
-> (Editor -> FBuffer)
-> YiM FBuffer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Editor -> FBuffer) -> EditorM FBuffer
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((Editor -> FBuffer) -> YiM FBuffer)
-> (Editor -> FBuffer) -> YiM FBuffer
forall a b. (a -> b) -> a -> b
$ BufferRef -> Editor -> FBuffer
findBufferWith BufferRef
b
Bool
ch <- FBuffer -> YiM Bool
deservesSave FBuffer
buf
let askKeymap :: I Event Action ()
askKeymap = [I Event Action ()] -> I Event Action ()
forall (m :: * -> *) w e a.
(MonadInteract m w e, MonadFail m) =>
[m a] -> m a
choice [ Char -> Event
char 'n' Event -> EditorM () -> I Event Action ()
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! EditorM ()
closeBufferAndWindowE
, Char -> Event
char 'y' Event -> EditorM () -> I Event Action ()
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! EditorM ()
delBuf EditorM () -> EditorM () -> EditorM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EditorM ()
closeBufferAndWindowE
, Char -> Event
ctrlCh 'g' Event -> EditorM () -> I Event Action ()
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! EditorM ()
closeBufferAndWindowE
]
delBuf :: EditorM ()
delBuf = BufferRef -> EditorM ()
forall (m :: * -> *). MonadEditor m => BufferRef -> m ()
deleteBuffer BufferRef
b
question :: Text
question = FBuffer -> Text
identString FBuffer
buf Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " changed, close anyway? (y/n)"
EditorM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (EditorM () -> YiM ()) -> EditorM () -> YiM ()
forall a b. (a -> b) -> a -> b
$
if Bool
ch
then EditorM BufferRef -> EditorM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (EditorM BufferRef -> EditorM ())
-> EditorM BufferRef -> EditorM ()
forall a b. (a -> b) -> a -> b
$ Text -> KeymapEndo -> EditorM BufferRef
spawnMinibufferE Text
question (I Event Action () -> KeymapEndo
forall a b. a -> b -> a
const I Event Action ()
askKeymap)
else EditorM ()
delBuf
justOneSep :: UnivArgument -> BufferM ()
justOneSep :: UnivArgument -> BufferM ()
justOneSep u :: UnivArgument
u = BufferM Char
readB BufferM Char -> (Char -> BufferM ()) -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \c :: Char
c ->
BufferM Point
pointB BufferM Point -> (Point -> BufferM ()) -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \point :: Point
point -> case Point
point of
Point 0 -> if Char -> Bool
isSep Char
c then BufferM ()
deleteSeparators else Char -> BufferM ()
insertMult Char
c
Point x :: Int
x ->
if Char -> Bool
isSep Char
c
then BufferM ()
deleteSeparators
else Point -> BufferM Char
readAtB (Int -> Point
Point (Int -> Point) -> Int -> Point
forall a b. (a -> b) -> a -> b
$ Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) BufferM Char -> (Char -> BufferM ()) -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \d :: Char
d ->
if Char -> Bool
isSep Char
d
then TextUnit -> Direction -> BufferM ()
moveB TextUnit
Character Direction
Backward BufferM () -> BufferM () -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BufferM ()
deleteSeparators
else Char -> BufferM ()
insertMult ' '
where
isSep :: Char -> Bool
isSep c :: Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '\n' Bool -> Bool -> Bool
&& Char -> Bool
isAnySep Char
c
insertMult :: Char -> BufferM ()
insertMult c :: Char
c = YiString -> BufferM ()
insertN (YiString -> BufferM ()) -> YiString -> BufferM ()
forall a b. (a -> b) -> a -> b
$ Int -> Char -> YiString
R.replicateChar (Int -> (Int -> Int) -> UnivArgument -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe 1 (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 1) UnivArgument
u) Char
c
deleteSeparators :: BufferM ()
deleteSeparators = do
TextUnit -> (Direction, BoundarySide) -> Direction -> BufferM ()
genMaybeMoveB TextUnit
unitSepThisLine (Direction
Backward, BoundarySide
InsideBound) Direction
Backward
TextUnit -> Direction -> BufferM ()
moveB TextUnit
Character Direction
Forward
(Char -> Bool) -> BufferM () -> BufferM ()
forall a. (Char -> Bool) -> BufferM a -> BufferM ()
doIfCharB Char -> Bool
isSep (BufferM () -> BufferM ()) -> BufferM () -> BufferM ()
forall a b. (a -> b) -> a -> b
$ TextUnit -> Direction -> BufferM ()
deleteB TextUnit
unitSepThisLine Direction
Forward
joinLinesE :: UnivArgument -> BufferM ()
joinLinesE :: UnivArgument -> BufferM ()
joinLinesE Nothing = () -> BufferM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
joinLinesE (Just _) = do
TextUnit -> Direction -> BufferM ()
moveB TextUnit
VLine Direction
Forward
BufferM ()
moveToSol BufferM () -> BufferM () -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (YiString -> YiString) -> TextUnit -> Direction -> BufferM ()
transformB (YiString -> YiString -> YiString
forall a b. a -> b -> a
const " ") TextUnit
Character Direction
Backward BufferM () -> BufferM () -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> UnivArgument -> BufferM ()
justOneSep UnivArgument
forall a. Maybe a
Nothing
maybeList :: [a] -> [a] -> [a]
maybeList :: [a] -> [a] -> [a]
maybeList def :: [a]
def [] = [a]
def
maybeList _ ls :: [a]
ls = [a]
ls
maybeTag :: Tag -> T.Text -> Tag
maybeTag :: Tag -> Text -> Tag
maybeTag def :: Tag
def t :: Text
t = if Text -> Bool
T.null Text
t then Tag
def else Text -> Tag
Tag Text
t
promptTag :: YiM ()
promptTag :: YiM ()
promptTag = do
Tag
defaultTag <- BufferM Tag -> YiM Tag
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM Tag -> YiM Tag) -> BufferM Tag -> YiM Tag
forall a b. (a -> b) -> a -> b
$ Text -> Tag
Tag (Text -> Tag) -> (YiString -> Text) -> YiString -> Tag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiString -> Text
R.toText (YiString -> Tag) -> BufferM YiString -> BufferM Tag
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TextUnit -> BufferM YiString
readUnitB TextUnit
unitWord
Maybe TagTable
tagTable <- EditorM (Maybe TagTable) -> YiM (Maybe TagTable)
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor EditorM (Maybe TagTable)
getTags
let hinter :: Text -> YiM [Text]
hinter = [Text] -> YiM [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> YiM [Text]) -> (Text -> [Text]) -> Text -> YiM [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take 10 ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> [Text])
-> (TagTable -> Text -> [Text]) -> Maybe TagTable -> Text -> [Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> [Text]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> [Text]) -> (Text -> String) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) TagTable -> Text -> [Text]
hintTags Maybe TagTable
tagTable
let completer :: Text -> YiM Text
completer = Text -> YiM Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> YiM Text) -> (Text -> Text) -> Text -> YiM Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text)
-> (TagTable -> Text -> Text) -> Maybe TagTable -> Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text -> Text
forall a. a -> a
id TagTable -> Text -> Text
completeTag Maybe TagTable
tagTable
p :: Text
p = "Find tag: (default " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Tag -> Text
_unTag Tag
defaultTag Text -> Char -> Text
`T.snoc` ')'
Text
-> (Text -> YiM [Text])
-> Text
-> (Text -> YiM Text)
-> (Text -> YiM ())
-> (Text -> YiM ())
-> YiM ()
withMinibufferGen "" Text -> YiM [Text]
hinter Text
p Text -> YiM Text
completer (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 ()) ((Text -> YiM ()) -> YiM ()) -> (Text -> YiM ()) -> YiM ()
forall a b. (a -> b) -> a -> b
$
Tag -> YiM ()
gotoTag (Tag -> YiM ()) -> (Text -> Tag) -> Text -> YiM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tag -> Text -> Tag
maybeTag Tag
defaultTag
gotoTag :: Tag -> YiM ()
gotoTag :: Tag -> YiM ()
gotoTag tag :: Tag
tag =
(TagTable -> YiM ()) -> YiM ()
visitTagTable ((TagTable -> YiM ()) -> YiM ()) -> (TagTable -> YiM ()) -> YiM ()
forall a b. (a -> b) -> a -> b
$ \tagTable :: TagTable
tagTable ->
case Tag -> TagTable -> [(String, Int)]
lookupTag Tag
tag TagTable
tagTable of
[] -> Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg (Text -> YiM ()) -> Text -> YiM ()
forall a b. (a -> b) -> a -> b
$ "No tags containing " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Tag -> Text
_unTag Tag
tag
(filename :: String
filename, line :: Int
line):_ -> String -> BufferM Int -> YiM ()
forall a. String -> BufferM a -> YiM ()
openingNewFile String
filename (BufferM Int -> YiM ()) -> BufferM Int -> YiM ()
forall a b. (a -> b) -> a -> b
$ Int -> BufferM Int
gotoLn Int
line
visitTagTable :: (TagTable -> YiM ()) -> YiM ()
visitTagTable :: (TagTable -> YiM ()) -> YiM ()
visitTagTable act :: TagTable -> YiM ()
act = do
Maybe TagTable
posTagTable <- EditorM (Maybe TagTable) -> YiM (Maybe TagTable)
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor EditorM (Maybe TagTable)
getTags
case Maybe TagTable
posTagTable of
Just tagTable :: TagTable
tagTable -> TagTable -> YiM ()
act TagTable
tagTable
Nothing -> Text -> (Text -> YiM ()) -> YiM ()
promptFile "Visit tags table: (default tags)" ((Text -> YiM ()) -> YiM ()) -> (Text -> YiM ()) -> YiM ()
forall a b. (a -> b) -> a -> b
$ \path :: Text
path -> do
let p :: String
p = Text -> String
T.unpack Text
path
filename :: String
filename = String -> String -> String
forall a. [a] -> [a] -> [a]
maybeList "tags" (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
takeFileName String
p
TagTable
tagTable <- IO TagTable -> YiM TagTable
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO TagTable -> YiM TagTable) -> IO TagTable -> YiM TagTable
forall a b. (a -> b) -> a -> b
$ String -> IO TagTable
importTagTable (String -> IO TagTable) -> String -> IO TagTable
forall a b. (a -> b) -> a -> b
$ String -> String
takeDirectory String
p String -> String -> String
</> String
filename
EditorM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (EditorM () -> YiM ()) -> EditorM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ TagTable -> EditorM ()
setTags TagTable
tagTable
TagTable -> YiM ()
act TagTable
tagTable
countWordsRegion :: YiM ()
countWordsRegion :: YiM ()
countWordsRegion = do
(l :: Int
l, w :: Int
w, c :: Int
c) <- EditorM (Int, Int, Int) -> YiM (Int, Int, Int)
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (EditorM (Int, Int, Int) -> YiM (Int, Int, Int))
-> EditorM (Int, Int, Int) -> YiM (Int, Int, Int)
forall a b. (a -> b) -> a -> b
$ do
YiString
t <- BufferM YiString -> EditorM YiString
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM YiString -> EditorM YiString)
-> BufferM YiString -> EditorM YiString
forall a b. (a -> b) -> a -> b
$ BufferM (Region, Int, Int)
getRectangle BufferM (Region, Int, Int)
-> ((Region, Int, Int) -> BufferM YiString) -> BufferM YiString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(reg :: Region
reg, _, _) -> Region -> BufferM YiString
readRegionB Region
reg
let nls :: Int
nls = YiString -> Int
R.countNewLines YiString
t
(Int, Int, Int) -> EditorM (Int, Int, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (if Int
nls Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 then 1 else Int
nls, [YiString] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([YiString] -> Int) -> [YiString] -> Int
forall a b. (a -> b) -> a -> b
$ YiString -> [YiString]
R.words YiString
t, YiString -> Int
R.length YiString
t)
Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg (Text -> YiM ()) -> Text -> YiM ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords [ "Region has", Int -> Text
forall a. Show a => a -> Text
showT Int
l, Int -> Text -> Text
forall a a. (Eq a, Num a, Semigroup a, IsString a) => a -> a -> a
p Int
l "line" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ","
, Int -> Text
forall a. Show a => a -> Text
showT Int
w, Int -> Text -> Text
forall a a. (Eq a, Num a, Semigroup a, IsString a) => a -> a -> a
p Int
w "word" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ", and"
, Int -> Text
forall a. Show a => a -> Text
showT Int
c, Int -> Text -> Text
forall a a. (Eq a, Num a, Semigroup a, IsString a) => a -> a -> a
p Int
w "character" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "."
]
where
p :: a -> a -> a
p x :: a
x w :: a
w = if a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== 1 then a
w else a
w a -> a -> a
forall a. Semigroup a => a -> a -> a
<> "s"