{-# 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
-- License     :  GPL-2
-- Maintainer  :  yi-devel@googlegroups.com
-- Stability   :  experimental
-- Portability :  portable
--
-- This module is aimed at being a helper for the Emacs keybindings.
-- In particular this should be useful for anyone that has a custom
-- keymap derived from or based on the Emacs one.

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

----------------------------
-- | Quits the editor if there are no unmodified buffers
-- if there are unmodified buffers then we ask individually for
-- each modified buffer whether or not the user wishes to save
-- it or not. If we get to the end of this list and there are still
-- some modified buffers then we ask again if the user wishes to
-- quit, but this is then a simple yes or no.
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

--------------------------------------------------
-- Takes in a list of buffers which have been identified
-- as modified since their last save.

askIndividualSave :: Bool -> [FBuffer] -> YiM ()
askIndividualSave :: Bool -> [FBuffer] -> YiM ()
askIndividualSave Bool
True []  = YiM ()
modifiedQuitEditor
askIndividualSave Bool
False [] = () -> YiM ()
forall a. a -> YiM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
askIndividualSave Bool
hasQuit allBuffers :: [FBuffer]
allBuffers@(FBuffer
firstBuffer : [FBuffer]
others) =
  YiM BufferRef -> YiM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (EditorM BufferRef -> YiM BufferRef
forall a. EditorM a -> YiM a
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (Text -> KeymapEndo -> EditorM BufferRef
spawnMinibufferE Text
saveMessage (Keymap -> KeymapEndo
forall a b. a -> b -> a
const Keymap
askKeymap)))
  where
  saveMessage :: Text
saveMessage = [Text] -> Text
T.concat [ Text
"do you want to save the buffer: "
                         , Text
bufferName
                         , Text
"? (y/n/", if Bool
hasQuit then Text
"q/" else Text
"", Text
"c/!)"
                         ]
  bufferName :: Text
bufferName  = FBuffer -> Text
identString FBuffer
firstBuffer

  askKeymap :: Keymap
askKeymap = [Keymap] -> Keymap
forall (m :: * -> *) w e a.
(MonadInteract m w e, MonadFail m) =>
[m a] -> m a
choice ([ Char -> Event
char Char
'n' Event -> YiM () -> Keymap
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! YiM ()
noAction
                      , Char -> Event
char Char
'y' Event -> YiM () -> Keymap
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! YiM ()
yesAction
                      , Char -> Event
char Char
'!' Event -> YiM () -> Keymap
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 Char
'c', Event -> Event
ctrl (Event -> Event) -> Event -> Event
forall a b. (a -> b) -> a -> b
$ Char -> Event
char Char
'g']
                        I Event Action Event -> EditorM () -> Keymap
forall (m :: * -> *) a x b.
(MonadInteract m Action Event, YiAction a x, Show x) =>
m b -> a -> m ()
>>! EditorM ()
closeBufferAndWindowE
                        -- cancel
                      ] [Keymap] -> [Keymap] -> [Keymap]
forall a. [a] -> [a] -> [a]
++ [Char -> Event
char Char
'q' Event -> YiM () -> Keymap
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 a. EditorM a -> YiM a
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor EditorM ()
closeBufferAndWindowE
                 YiM ()
continue

  noAction :: YiM ()
noAction = do EditorM () -> YiM ()
forall a. EditorM a -> YiM a
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 a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FBuffer -> BufferRef
bkey [FBuffer]
allBuffers
                 EditorM () -> YiM ()
forall a. EditorM a -> YiM a
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

---------------------------

---------------------------
-- | Quits the editor if there are no unmodified buffers
-- if there are then simply confirms with the user that they
-- with to quit.
modifiedQuitEditor :: YiM ()
modifiedQuitEditor :: YiM ()
modifiedQuitEditor =
  do modifiedBuffers <- YiM [FBuffer]
getModifiedBuffers
     if null modifiedBuffers
        then quitEditor
        else withEditor $ void (spawnMinibufferE modifiedMessage (const askKeymap))
  where
  modifiedMessage :: Text
modifiedMessage = Text
"Modified buffers exist really quit? (y/n)"

  askKeymap :: Keymap
askKeymap = [Keymap] -> Keymap
forall (m :: * -> *) w e a.
(MonadInteract m w e, MonadFail m) =>
[m a] -> m a
choice [ Char -> Event
char Char
'n' Event -> EditorM () -> Keymap
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! EditorM ()
noAction
                     , Char -> Event
char Char
'y' Event -> YiM () -> Keymap
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! YiM ()
quitEditor
                     ]

  noAction :: EditorM ()
noAction        = EditorM ()
closeBufferAndWindowE

-----------------------------
-- isearch
selfSearchKeymap :: Keymap
selfSearchKeymap :: Keymap
selfSearchKeymap = do
  Event (KASCII c) [] <- I Event Action Event
forall event (m :: * -> *) w.
(Ord event, MonadInteract m w event) =>
m event
anyEvent
  write . isearchAddE $ T.singleton c

searchKeymap :: Keymap
searchKeymap :: Keymap
searchKeymap = Keymap
selfSearchKeymap Keymap -> KeymapEndo
forall a. I Event Action a -> I Event Action a -> I Event Action a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Keymap] -> Keymap
forall (m :: * -> *) w e a.
(MonadInteract m w e, MonadFail m) =>
[m a] -> m a
choice
               [ -- ("C-g", isearchDelE) -- Only if string is not empty.
                 Event -> Event
ctrl (Char -> Event
char Char
'r') Event -> EditorM () -> Keymap
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! EditorM ()
isearchPrevE
               , Event -> Event
ctrl (Char -> Event
char Char
's') Event -> EditorM () -> Keymap
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! EditorM ()
isearchNextE
               , Event -> Event
ctrl (Char -> Event
char Char
'w') Event -> EditorM () -> Keymap
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! EditorM ()
isearchWordE
               , Event -> Event
meta (Char -> Event
char Char
'p') Event -> EditorM () -> Keymap
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! Int -> EditorM ()
isearchHistory Int
1
               , Event -> Event
meta (Char -> Event
char Char
'n') Event -> EditorM () -> Keymap
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! Int -> EditorM ()
isearchHistory (-Int
1)
               , Key -> Event
spec Key
KBS        Event -> EditorM () -> Keymap
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! EditorM ()
isearchDelE
               ]

isearchKeymap :: Direction -> Keymap
isearchKeymap :: Direction -> Keymap
isearchKeymap Direction
dir =
  do EditorM () -> Keymap
forall (m :: * -> *) ev a x.
(MonadInteract m Action ev, YiAction a x, Show x) =>
a -> m ()
write (EditorM () -> Keymap) -> EditorM () -> Keymap
forall a b. (a -> b) -> a -> b
$ Direction -> EditorM ()
isearchInitE Direction
dir
     I Event Action [()] -> Keymap
forall (f :: * -> *) a. Functor f => f a -> f ()
void (I Event Action [()] -> Keymap) -> I Event Action [()] -> Keymap
forall a b. (a -> b) -> a -> b
$ Keymap -> I Event Action [()]
forall a. I Event Action a -> I Event Action [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Keymap
searchKeymap
     [Keymap] -> Keymap
forall (m :: * -> *) w e a.
(MonadInteract m w e, MonadFail m) =>
[m a] -> m a
choice [ Event -> Event
ctrl (Char -> Event
char Char
'g') Event -> EditorM () -> Keymap
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 Char
'm'), Key -> Event
spec Key
KEnter]
              I Event Action Event -> EditorM () -> Keymap
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
            ]
       Keymap -> KeymapEndo
forall (f :: * -> *) w e a.
MonadInteract f w e =>
f a -> f a -> f a
<|| EditorM () -> Keymap
forall (m :: * -> *) ev a x.
(MonadInteract m Action ev, YiAction a x, Show x) =>
a -> m ()
write EditorM ()
isearchFinishE

----------------------------
-- query-replace
queryReplaceE :: YiM ()
queryReplaceE :: YiM ()
queryReplaceE = Text -> (Text -> YiM ()) -> YiM ()
withMinibufferFree Text
"Replace:" ((Text -> YiM ()) -> YiM ()) -> (Text -> YiM ()) -> YiM ()
forall a b. (a -> b) -> a -> b
$ \Text
replaceWhat ->
  Text -> (Text -> YiM ()) -> YiM ()
withMinibufferFree Text
"With:" ((Text -> YiM ()) -> YiM ()) -> (Text -> YiM ()) -> YiM ()
forall a b. (a -> b) -> a -> b
$ \Text
replaceWith -> do
    b <- (Editor -> BufferRef) -> YiM BufferRef
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets Editor -> BufferRef
currentBuffer
    win <- use currentWindowA
    let repStr = Text -> YiString
R.fromText Text
replaceWith
        replaceKm =
          [Keymap] -> Keymap
forall (m :: * -> *) w e a.
(MonadInteract m w e, MonadFail m) =>
[m a] -> m a
choice [ Char -> Event
char Char
'n'                  Event -> EditorM () -> Keymap
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 Char
'!'                  Event -> EditorM () -> Keymap
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 Char
'y', Char -> Event
char Char
' '] I Event Action Event -> EditorM () -> Keymap
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 Char
'q', Event -> Event
ctrl (Char -> Event
char Char
'g')] I Event Action Event -> EditorM () -> Keymap
forall (m :: * -> *) a x b.
(MonadInteract m Action Event, YiAction a x, Show x) =>
m b -> a -> m ()
>>! EditorM ()
qrFinish
                 ]
        -- TODO: Yi.Regex to Text
        Right re = makeSearchOptsM [] (T.unpack replaceWhat)
        question = [Text] -> Text
T.unwords [ Text
"Replacing", Text
replaceWhat
                             , Text
"with", Text
replaceWith, Text
" (y,n,q,!):"
                             ]
    withEditor $ do
      setRegexE re
      void $ spawnMinibufferE question (const replaceKm)
      qrNext win b re


executeExtendedCommandE :: YiM ()
executeExtendedCommandE :: YiM ()
executeExtendedCommandE = Text -> (Text -> YiM [Text]) -> (Text -> YiM ()) -> YiM ()
withMinibuffer Text
"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
  -- FIXME: do something sensible.
  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 a b. BufferM a -> (a -> BufferM b) -> BufferM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Region -> BufferM YiString
readRegionB)
  () -> YiM ()
forall a. a -> YiM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- * Code for various commands
-- This ideally should be put in their own module,
-- without a prefix, so M-x ... would be easily implemented
-- by looking up that module's contents

-- | Insert next character, "raw"
insertNextC :: UnivArgument -> KeymapM ()
insertNextC :: UnivArgument -> Keymap
insertNextC UnivArgument
a = do c <- I Event Action Event
forall event (m :: * -> *) w.
(Ord event, MonadInteract m w event) =>
m event
anyEvent
                   write $ replicateM_ (argToInt a) $ insertB (eventToChar c)

-- | Convert the universal argument to a number of repetitions
argToInt :: UnivArgument -> Int
argToInt :: UnivArgument -> Int
argToInt = Int -> UnivArgument -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
1


digit :: (Event -> Event) -> KeymapM Char
digit :: (Event -> Event) -> KeymapM Char
digit 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 Char
'0' Char
'9'

-- TODO: replace tt by digit meta
tt :: KeymapM Char
tt :: KeymapM Char
tt = do
  Event (KASCII c) _ <- (I Event Action Event
 -> I Event Action Event -> I Event Action Event)
-> [I Event Action Event] -> I Event Action Event
forall a. (a -> a -> a) -> [a] -> a
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 a. I Event Action a -> I Event Action a -> I Event Action a
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 a b. (a -> b) -> [a] -> [b]
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 ) [Char
'0'..Char
'9']
  return c


-- doing the argument precisely is kind of tedious.
-- read: http://www.gnu.org/software/emacs/manual/html_node/Arguments.html
-- and: http://www.gnu.org/software/emacs/elisp-manual/html_node/elisp_318.html
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 Char
'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 a. I Event Action a -> I Event Action [a]
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 a. I Event Action a -> I Event Action a -> I Event Action a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> I Event Action Int
forall a. a -> I Event Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
4)) I Event Action Int -> I Event Action Int -> I Event Action Int
forall a. I Event Action a -> I Event Action a -> I Event Action a
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 a. I Event Action a -> I Event Action [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some KeymapM Char
tt))


-- | Finds file and runs specified action on the resulting buffer
findFileAndDo :: T.Text -- ^ Prompt
              -> BufferM a -- ^ Action to run on the resulting buffer
              -> YiM ()
findFileAndDo :: forall a. Text -> BufferM a -> YiM ()
findFileAndDo Text
prompt BufferM a
act = Text -> (Text -> YiM ()) -> YiM ()
promptFile Text
prompt ((Text -> YiM ()) -> YiM ()) -> (Text -> YiM ()) -> YiM ()
forall a b. (a -> b) -> a -> b
$ \Text
filename -> do
  Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg (Text -> YiM ()) -> Text -> YiM ()
forall a b. (a -> b) -> a -> b
$ Text
"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

-- | Open a file using the minibuffer. We have to set up some stuff to
-- allow hints and auto-completion.
findFile :: YiM ()
findFile :: YiM ()
findFile = Text -> BufferM () -> YiM ()
forall a. Text -> BufferM a -> YiM ()
findFileAndDo Text
"find file:" (BufferM () -> YiM ()) -> BufferM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ () -> BufferM ()
forall a. a -> BufferM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Like 'findFile' but sets the resulting buffer to read-only.
findFileReadOnly :: YiM ()
findFileReadOnly :: YiM ()
findFileReadOnly = Text -> BufferM () -> YiM ()
forall a. Text -> BufferM a -> YiM ()
findFileAndDo Text
"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
Lens' FBuffer 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

-- | Open a file in a new tab using the minibuffer.
findFileNewTab :: YiM ()
findFileNewTab :: YiM ()
findFileNewTab = Text -> (Text -> YiM ()) -> YiM ()
promptFile Text
"find file (new tab): " ((Text -> YiM ()) -> YiM ()) -> (Text -> YiM ()) -> YiM ()
forall a b. (a -> b) -> a -> b
$ \Text
filename -> do
  EditorM () -> YiM ()
forall a. EditorM a -> YiM a
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
$ Text
"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 UnivArgument
a = case UnivArgument
a of
                 UnivArgument
Nothing -> BufferM ()
downScreenB
                 Just Int
n -> Int -> BufferM ()
scrollB Int
n

scrollUpE :: UnivArgument -> BufferM ()
scrollUpE :: UnivArgument -> BufferM ()
scrollUpE UnivArgument
a = case UnivArgument
a of
                 UnivArgument
Nothing -> BufferM ()
upScreenB
                 Just Int
n -> Int -> BufferM ()
scrollB (Int -> Int
forall a. Num a => a -> a
negate Int
n)

-- | Prompts the user for a buffer name and switches to the chosen buffer.
switchBufferE :: YiM ()
switchBufferE :: YiM ()
switchBufferE = Text
-> (BufferRef -> YiM ())
-> ([BufferRef] -> [BufferRef] -> [BufferRef])
-> YiM ()
promptingForBuffer Text
"switch to buffer:"
                  (EditorM () -> YiM ()
forall a. EditorM a -> YiM a
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) (\[BufferRef]
o [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)


-- | Prompts the user for a buffer name and kills the chosen buffer.
-- Prompts about really closing if the buffer is marked as changed
-- since last save.
killBufferE :: YiM ()
killBufferE :: YiM ()
killBufferE = Text
-> (BufferRef -> YiM ())
-> ([BufferRef] -> [BufferRef] -> [BufferRef])
-> YiM ()
promptingForBuffer Text
"kill buffer:" BufferRef -> YiM ()
k (\[BufferRef]
o [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 BufferRef
b = do
      buf <- EditorM FBuffer -> YiM FBuffer
forall a. EditorM a -> YiM a
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
      ch <- deservesSave buf
      let askKeymap = [Keymap] -> Keymap
forall (m :: * -> *) w e a.
(MonadInteract m w e, MonadFail m) =>
[m a] -> m a
choice [ Char -> Event
char Char
'n' Event -> EditorM () -> Keymap
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! EditorM ()
closeBufferAndWindowE
                             , Char -> Event
char Char
'y' Event -> EditorM () -> Keymap
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! EditorM ()
delBuf EditorM () -> EditorM () -> EditorM ()
forall a b. EditorM a -> EditorM b -> EditorM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EditorM ()
closeBufferAndWindowE
                             , Char -> Event
ctrlCh Char
'g' Event -> EditorM () -> Keymap
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! EditorM ()
closeBufferAndWindowE
                             ]
          delBuf = BufferRef -> EditorM ()
forall (m :: * -> *). MonadEditor m => BufferRef -> m ()
deleteBuffer BufferRef
b
          question = FBuffer -> Text
identString FBuffer
buf Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" changed, close anyway? (y/n)"
      withEditor $
         if ch
         then void $ spawnMinibufferE question (const askKeymap)
         else delBuf


-- | If on separators (space, tab, unicode seps), reduce multiple
-- separators to just a single separator (or however many given
-- through 'UnivArgument').
--
-- If we aren't looking at a separator, insert a single space. This is
-- like emacs ‘just-one-space’ but doesn't deal with negative argument
-- case but works with other separators than just space. What counts
-- as a separator is decided by 'isAnySep' modulo @\n@ character.
--
-- Further, it will only reduce a single type of separator at once: if
-- we have hard tabs followed by spaces, we are able to reduce one and
-- not the other.
justOneSep :: UnivArgument -> BufferM ()
justOneSep :: UnivArgument -> BufferM ()
justOneSep UnivArgument
u = BufferM Char
readB BufferM Char -> (Char -> BufferM ()) -> BufferM ()
forall a b. BufferM a -> (a -> BufferM b) -> BufferM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Char
c ->
  BufferM Point
pointB BufferM Point -> (Point -> BufferM ()) -> BufferM ()
forall a b. BufferM a -> (a -> BufferM b) -> BufferM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Point
point -> case Point
point of
    Point Int
0 -> if Char -> Bool
isSep Char
c then BufferM ()
deleteSeparators else Char -> BufferM ()
insertMult Char
c
    Point 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
- Int
1) BufferM Char -> (Char -> BufferM ()) -> BufferM ()
forall a b. BufferM a -> (a -> BufferM b) -> BufferM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Char
d ->
        -- We weren't looking at separator but there might be one behind us
        if Char -> Bool
isSep Char
d
          then TextUnit -> Direction -> BufferM ()
moveB TextUnit
Character Direction
Backward BufferM () -> BufferM () -> BufferM ()
forall a b. BufferM a -> BufferM b -> BufferM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BufferM ()
deleteSeparators
          else Char -> BufferM ()
insertMult Char
' ' -- no separators, insert a space just
                              -- like emacs does
  where
    isSep :: Char -> Bool
isSep Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n' Bool -> Bool -> Bool
&& Char -> Bool
isAnySep Char
c
    insertMult :: Char -> BufferM ()
insertMult 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 Int
1 (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
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



-- | Join this line to previous (or next N if universal)
joinLinesE :: UnivArgument -> BufferM ()
joinLinesE :: UnivArgument -> BufferM ()
joinLinesE UnivArgument
Nothing = () -> BufferM ()
forall a. a -> BufferM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
joinLinesE (Just Int
_) = do
  TextUnit -> Direction -> BufferM ()
moveB TextUnit
VLine Direction
Forward
  BufferM ()
moveToSol BufferM () -> BufferM () -> BufferM ()
forall a b. BufferM a -> BufferM b -> BufferM b
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 YiString
" ") TextUnit
Character Direction
Backward BufferM () -> BufferM () -> BufferM ()
forall a b. BufferM a -> BufferM b -> BufferM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> UnivArgument -> BufferM ()
justOneSep UnivArgument
forall a. Maybe a
Nothing

-- | Shortcut to use a default list when a blank list is given.
-- Used for default values to emacs queries
maybeList :: [a] -> [a] -> [a]
maybeList :: forall a. [a] -> [a] -> [a]
maybeList [a]
def [] = [a]
def
maybeList [a]
_   [a]
ls = [a]
ls

maybeTag :: Tag -> T.Text -> Tag
maybeTag :: Tag -> Text -> Tag
maybeTag Tag
def Text
t = if Text -> Bool
T.null Text
t then Tag
def else Text -> Tag
Tag Text
t

--------------------------------------------------
-- TAGS - See Yi.Tag for more info

-- | Prompt the user to give a tag and then jump to that tag
promptTag :: YiM ()
promptTag :: YiM ()
promptTag = do
  -- default tag is where the buffer is on
  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
  -- if we have tags use them to generate hints
  tagTable <- withEditor getTags
  -- Hints are expensive - only lazily generate 10
  let hinter =  [Text] -> YiM [Text]
forall a. a -> YiM a
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 Int
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 a. String -> [a]
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
  -- Completions are super-cheap. Go wild
  let completer =  Text -> YiM Text
forall a. a -> YiM a
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
"Find tag: (default " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Tag -> Text
_unTag Tag
defaultTag Text -> Char -> Text
`T.snoc` Char
')'
  withMinibufferGen "" hinter p completer (const $ return ()) $
    -- if the string is "" use the defaultTag
    gotoTag . maybeTag defaultTag

-- | Opens the file that contains @tag@. Uses the global tag table and prompts
-- the user to open one if it does not exist
gotoTag :: Tag -> YiM ()
gotoTag :: Tag -> YiM ()
gotoTag Tag
tag =
    (TagTable -> YiM ()) -> YiM ()
visitTagTable ((TagTable -> YiM ()) -> YiM ()) -> (TagTable -> YiM ()) -> YiM ()
forall a b. (a -> b) -> a -> b
$ \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
$ Text
"No tags containing " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Tag -> Text
_unTag Tag
tag
          (String
filename, Int
line):[(String, Int)]
_ -> 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

-- | Call continuation @act@ with the TagTable. Uses the global table
-- and prompts the user if it doesn't exist
visitTagTable :: (TagTable -> YiM ()) -> YiM ()
visitTagTable :: (TagTable -> YiM ()) -> YiM ()
visitTagTable TagTable -> YiM ()
act = do
  posTagTable <- EditorM (Maybe TagTable) -> YiM (Maybe TagTable)
forall a. EditorM a -> YiM a
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor EditorM (Maybe TagTable)
getTags
  -- does the tagtable exist?
  case posTagTable of
    Just TagTable
tagTable -> TagTable -> YiM ()
act TagTable
tagTable
    Maybe TagTable
Nothing -> Text -> (Text -> YiM ()) -> YiM ()
promptFile Text
"Visit tags table: (default tags)" ((Text -> YiM ()) -> YiM ()) -> (Text -> YiM ()) -> YiM ()
forall a b. (a -> b) -> a -> b
$ \Text
path -> do
      -- default emacs behavior, append tags
        let p :: String
p = Text -> String
T.unpack Text
path
            filename :: String
filename = String -> String -> String
forall a. [a] -> [a] -> [a]
maybeList String
"tags" (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
takeFileName String
p
        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
        withEditor $ setTags tagTable
        act tagTable

-- TODO: use TextUnit to count things inside region for better experience
-- | Counts the number of lines, words and characters inside selected
-- region. Coresponds to emacs' @count-words-region@.
countWordsRegion :: YiM ()
countWordsRegion :: YiM ()
countWordsRegion = do
  (l, w, c) <- EditorM (Int, Int, Int) -> YiM (Int, Int, Int)
forall a. EditorM a -> YiM a
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
    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 a b. BufferM a -> (a -> BufferM b) -> BufferM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Region
reg, Int
_, Int
_) -> Region -> BufferM YiString
readRegionB Region
reg
    let nls = YiString -> Int
R.countNewLines YiString
t
    return (if nls == 0 then 1 else nls, length $ R.words t, R.length t)
  printMsg $ T.unwords [ "Region has", showT l, p l "line" <> ","
                        , showT w, p w "word" <> ", and"
                        , showT c, p w "character" <> "."
                        ]
  where
    p :: a -> p -> p
p a
x p
w = if a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
1 then p
w else p
w p -> p -> p
forall a. Semigroup a => a -> a -> a
<> p
"s"