{-# Language TemplateHaskell, BangPatterns #-}
{-|
Module      : Client.State.EditBox.Content
Description : Multiline text container with cursor
Copyright   : (c) Eric Mertens, 2016
License     : ISC
Maintainer  : emertens@gmail.com

This module manages simple text navigation and manipulation,
but leaves more complicated operations like yank/kill and
history management to "Client.State.EditBox"

-}
module Client.State.EditBox.Content
  (
  -- * Multiple lines
    Content
  , above
  , below
  , singleLine
  , noContent
  , shift
  , toStrings
  , fromStrings

  -- * Focused line
  , Line(..)
  , HasLine(..)
  , endLine

  -- * Movements
  , left
  , right

  , leftWord
  , rightWord

  , jumpLeft
  , jumpRight

  -- * Edits
  , delete
  , backspace
  , insertPastedString
  , insertString
  , insertChar
  , toggle
  , digraph
  ) where

import           Control.Applicative ((<|>))
import           Control.Lens hiding ((<|), below)
import           Control.Monad (guard)
import           Data.Char (isAlphaNum)
import           Data.List (find)
import           Data.List.NonEmpty (NonEmpty(..), (<|))
import           Data.Map (Map)
import qualified Data.Map as Map
import           Data.Text (Text)
import qualified Data.Text as Text
import           Digraphs (Digraph(..), lookupDigraph)

data Line = Line
  { Line -> Int
_pos  :: !Int
  , Line -> String
_text :: !String
  }
  deriving (ReadPrec [Line]
ReadPrec Line
Int -> ReadS Line
ReadS [Line]
(Int -> ReadS Line)
-> ReadS [Line] -> ReadPrec Line -> ReadPrec [Line] -> Read Line
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Line]
$creadListPrec :: ReadPrec [Line]
readPrec :: ReadPrec Line
$creadPrec :: ReadPrec Line
readList :: ReadS [Line]
$creadList :: ReadS [Line]
readsPrec :: Int -> ReadS Line
$creadsPrec :: Int -> ReadS Line
Read, Int -> Line -> ShowS
[Line] -> ShowS
Line -> String
(Int -> Line -> ShowS)
-> (Line -> String) -> ([Line] -> ShowS) -> Show Line
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Line] -> ShowS
$cshowList :: [Line] -> ShowS
show :: Line -> String
$cshow :: Line -> String
showsPrec :: Int -> Line -> ShowS
$cshowsPrec :: Int -> Line -> ShowS
Show)

makeClassy ''Line

emptyLine :: Line
emptyLine :: Line
emptyLine = Int -> String -> Line
Line Int
0 String
""

beginLine :: String -> Line
beginLine :: String -> Line
beginLine = Int -> String -> Line
Line Int
0

endLine :: String -> Line
endLine :: String -> Line
endLine String
s = Int -> String -> Line
Line (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) String
s

-- | Zipper-ish view of the multi-line content of an 'EditBox'.
-- Lines 'above' the 'currentLine' are stored in reverse order.
data Content = Content
  { Content -> [String]
_above       :: ![String]
  , Content -> Line
_currentLine :: !Line
  , Content -> [String]
_below       :: ![String]
  }
  deriving (ReadPrec [Content]
ReadPrec Content
Int -> ReadS Content
ReadS [Content]
(Int -> ReadS Content)
-> ReadS [Content]
-> ReadPrec Content
-> ReadPrec [Content]
-> Read Content
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Content]
$creadListPrec :: ReadPrec [Content]
readPrec :: ReadPrec Content
$creadPrec :: ReadPrec Content
readList :: ReadS [Content]
$creadList :: ReadS [Content]
readsPrec :: Int -> ReadS Content
$creadsPrec :: Int -> ReadS Content
Read, Int -> Content -> ShowS
[Content] -> ShowS
Content -> String
(Int -> Content -> ShowS)
-> (Content -> String) -> ([Content] -> ShowS) -> Show Content
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Content] -> ShowS
$cshowList :: [Content] -> ShowS
show :: Content -> String
$cshow :: Content -> String
showsPrec :: Int -> Content -> ShowS
$cshowsPrec :: Int -> Content -> ShowS
Show)

makeLenses ''Content

instance HasLine Content where
  line :: (Line -> f Line) -> Content -> f Content
line = (Line -> f Line) -> Content -> f Content
Lens' Content Line
currentLine

-- | Default 'Content' value
noContent :: Content
noContent :: Content
noContent = [String] -> Line -> [String] -> Content
Content [] Line
emptyLine []

-- | Single line 'Content'.
singleLine :: Line -> Content
singleLine :: Line -> Content
singleLine Line
l = [String] -> Line -> [String] -> Content
Content [] Line
l []

-- | Shifts the first line off of the 'Content', yielding the
-- text of the line and the rest of the content.
shift :: Content -> (String, Content)
shift :: Content -> (String, Content)
shift (Content [] Line
l []) = (Getting String Line String -> Line -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting String Line String
forall c. HasLine c => Lens' c String
text Line
l, Content
noContent)
shift (Content a :: [String]
a@(String
_:[String]
_) Line
l [String]
b) = ([String] -> String
forall a. [a] -> a
last [String]
a, [String] -> Line -> [String] -> Content
Content ([String] -> [String]
forall a. [a] -> [a]
init [String]
a) Line
l [String]
b)
shift (Content [] Line
l (String
b:[String]
bs)) = (Getting String Line String -> Line -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting String Line String
forall c. HasLine c => Lens' c String
text Line
l, [String] -> Line -> [String] -> Content
Content [] (String -> Line
beginLine String
b) [String]
bs)

-- | When at beginning of line, jump to beginning of previous line.
-- Otherwise jump to beginning of current line.
jumpLeft :: Content -> Content
jumpLeft :: Content -> Content
jumpLeft Content
c
  | Getting Int Content Int -> Content -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int Content Int
forall c. HasLine c => Lens' c Int
pos Content
c Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Content -> (Content -> Content) -> Maybe Content -> Content
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Content
c Content -> Content
begin1 (Content -> Maybe Content
backwardLine Content
c)
  | Bool
otherwise       = Content -> Content
begin1 Content
c
  where
    begin1 :: Content -> Content
begin1 = ASetter Content Content Int Int -> Int -> Content -> Content
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Content Content Int Int
forall c. HasLine c => Lens' c Int
pos Int
0

-- | When at end of line, jump to end of next line.
-- Otherwise jump to end of current line.
jumpRight :: Content -> Content
jumpRight :: Content -> Content
jumpRight Content
c
  | Getting Int Content Int -> Content -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int Content Int
forall c. HasLine c => Lens' c Int
pos Content
c Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
len = Content -> (Content -> Content) -> Maybe Content -> Content
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Content
c Content -> Content
forall s. HasLine s => s -> s
end1 (Content -> Maybe Content
forwardLine Content
c)
  | Bool
otherwise         = ASetter Content Content Int Int -> Int -> Content -> Content
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Content Content Int Int
forall c. HasLine c => Lens' c Int
pos Int
len Content
c
  where
    len :: Int
len    = LensLike' (Const Int) Content String
-> (String -> Int) -> Content -> Int
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views LensLike' (Const Int) Content String
forall c. HasLine c => Lens' c String
text String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Content
c
    end1 :: s -> s
end1 s
l = ASetter s s Int Int -> Int -> s -> s
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter s s Int Int
forall c. HasLine c => Lens' c Int
pos (LensLike' (Const Int) s String -> (String -> Int) -> s -> Int
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views LensLike' (Const Int) s String
forall c. HasLine c => Lens' c String
text String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length s
l) s
l


-- | Move the cursor left, across lines if necessary.
left :: Content -> Content
left :: Content -> Content
left Content
c =
  case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Getting Int Content Int -> Content -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int Content Int
forall c. HasLine c => Lens' c Int
pos Content
c) Int
0 of
    Ordering
GT                             -> (ASetter Content Content Int Int
forall c. HasLine c => Lens' c Int
pos ASetter Content Content Int Int -> Int -> Content -> Content
forall a s t. Num a => ASetter s t a a -> a -> s -> t
-~ Int
1) Content
c
    Ordering
EQ | Just Content
c' <- Content -> Maybe Content
backwardLine Content
c -> Content
c'
    Ordering
_                              -> Content
c

-- | Move the cursor right, across lines if necessary.
right :: Content -> Content
right :: Content -> Content
right Content
c =
  let Line Int
n String
s = Getting Line Content Line -> Content -> Line
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Line Content Line
forall c. HasLine c => Lens' c Line
line Content
c in
  case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
n (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) of
    Ordering
LT                            -> (ASetter Content Content Int Int
forall c. HasLine c => Lens' c Int
pos ASetter Content Content Int Int -> Int -> Content -> Content
forall a s t. Num a => ASetter s t a a -> a -> s -> t
+~ Int
1) Content
c
    Ordering
EQ | Just Content
c' <- Content -> Maybe Content
forwardLine Content
c -> Content
c'
    Ordering
_                             -> Content
c

-- | Move the cursor left to the previous word boundary.
leftWord :: Content -> Content
leftWord :: Content -> Content
leftWord Content
c
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0    = Content -> (Content -> Content) -> Maybe Content -> Content
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Content
c Content -> Content
leftWord (Content -> Maybe Content
backwardLine Content
c)
  | Bool
otherwise = ASetter Content Content Int Int -> Int -> Content -> Content
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Content Content Int Int
forall c. HasLine c => Lens' c Int
pos Int
search Content
c
  where
    Line Int
n String
txt = Getting Line Content Line -> Content -> Line
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Line Content Line
forall c. HasLine c => Lens' c Line
line Content
c
    search :: Int
search = Int -> ((Int, Char) -> Int) -> Maybe (Int, Char) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int, Char) -> Int
forall a b. (a, b) -> a
fst
           (Maybe (Int, Char) -> Int) -> Maybe (Int, Char) -> Int
forall a b. (a -> b) -> a -> b
$ ((Int, Char) -> Bool) -> [(Int, Char)] -> Maybe (Int, Char)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find      (Bool -> Bool
not (Bool -> Bool) -> ((Int, Char) -> Bool) -> (Int, Char) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isAlphaNum (Char -> Bool) -> ((Int, Char) -> Char) -> (Int, Char) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Char) -> Char
forall a b. (a, b) -> b
snd)
           ([(Int, Char)] -> Maybe (Int, Char))
-> [(Int, Char)] -> Maybe (Int, Char)
forall a b. (a -> b) -> a -> b
$ ((Int, Char) -> Bool) -> [(Int, Char)] -> [(Int, Char)]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not (Bool -> Bool) -> ((Int, Char) -> Bool) -> (Int, Char) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isAlphaNum (Char -> Bool) -> ((Int, Char) -> Char) -> (Int, Char) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Char) -> Char
forall a b. (a, b) -> b
snd)
           ([(Int, Char)] -> [(Int, Char)]) -> [(Int, Char)] -> [(Int, Char)]
forall a b. (a -> b) -> a -> b
$ [(Int, Char)] -> [(Int, Char)]
forall a. [a] -> [a]
reverse
           ([(Int, Char)] -> [(Int, Char)]) -> [(Int, Char)] -> [(Int, Char)]
forall a b. (a -> b) -> a -> b
$ Int -> [(Int, Char)] -> [(Int, Char)]
forall a. Int -> [a] -> [a]
take Int
n
           ([(Int, Char)] -> [(Int, Char)]) -> [(Int, Char)] -> [(Int, Char)]
forall a b. (a -> b) -> a -> b
$ [Int] -> String -> [(Int, Char)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] String
txt

-- | Move the cursor right to the next word boundary.
rightWord :: Content -> Content
rightWord :: Content -> Content
rightWord Content
c
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
txtLen = Content -> (Content -> Content) -> Maybe Content -> Content
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Content
c Content -> Content
rightWord (Content -> Maybe Content
forwardLine Content
c)
  | Bool
otherwise   = ASetter Content Content Int Int -> Int -> Content -> Content
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Content Content Int Int
forall c. HasLine c => Lens' c Int
pos Int
search Content
c
  where
    Line Int
n String
txt = Getting Line Content Line -> Content -> Line
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Line Content Line
forall c. HasLine c => Lens' c Line
line Content
c
    txtLen :: Int
txtLen = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
txt
    search :: Int
search = Int -> ((Int, Char) -> Int) -> Maybe (Int, Char) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
txtLen (Int, Char) -> Int
forall a b. (a, b) -> a
fst
           (Maybe (Int, Char) -> Int) -> Maybe (Int, Char) -> Int
forall a b. (a -> b) -> a -> b
$ ((Int, Char) -> Bool) -> [(Int, Char)] -> Maybe (Int, Char)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find      (Bool -> Bool
not (Bool -> Bool) -> ((Int, Char) -> Bool) -> (Int, Char) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isAlphaNum (Char -> Bool) -> ((Int, Char) -> Char) -> (Int, Char) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Char) -> Char
forall a b. (a, b) -> b
snd)
           ([(Int, Char)] -> Maybe (Int, Char))
-> [(Int, Char)] -> Maybe (Int, Char)
forall a b. (a -> b) -> a -> b
$ ((Int, Char) -> Bool) -> [(Int, Char)] -> [(Int, Char)]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not (Bool -> Bool) -> ((Int, Char) -> Bool) -> (Int, Char) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isAlphaNum (Char -> Bool) -> ((Int, Char) -> Char) -> (Int, Char) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Char) -> Char
forall a b. (a, b) -> b
snd)
           ([(Int, Char)] -> [(Int, Char)]) -> [(Int, Char)] -> [(Int, Char)]
forall a b. (a -> b) -> a -> b
$ Int -> [(Int, Char)] -> [(Int, Char)]
forall a. Int -> [a] -> [a]
drop Int
n
           ([(Int, Char)] -> [(Int, Char)]) -> [(Int, Char)] -> [(Int, Char)]
forall a b. (a -> b) -> a -> b
$ [Int] -> String -> [(Int, Char)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] String
txt

-- | Delete the character before the cursor.
backspace :: Content -> Content
backspace :: Content -> Content
backspace Content
c
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
  = case Getting [String] Content [String] -> Content -> [String]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [String] Content [String]
Lens' Content [String]
above Content
c of
      []   -> Content
c
      String
a:[String]
as -> ASetter Content Content [String] [String]
-> [String] -> Content -> Content
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Content Content [String] [String]
Lens' Content [String]
above [String]
as
            (Content -> Content) -> (Content -> Content) -> Content -> Content
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter Content Content Line Line -> Line -> Content -> Content
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Content Content Line Line
forall c. HasLine c => Lens' c Line
line (Int -> String -> Line
Line (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
a) (String
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s))
            (Content -> Content) -> Content -> Content
forall a b. (a -> b) -> a -> b
$ Content
c

  | (String
preS, String
postS) <- Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) String
s
  = ASetter Content Content Line Line -> Line -> Content -> Content
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Content Content Line Line
forall c. HasLine c => Lens' c Line
line (Int -> String -> Line
Line (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (String
preS String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 String
postS)) Content
c
  where
    Line Int
n String
s = Getting Line Content Line -> Content -> Line
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Line Content Line
forall c. HasLine c => Lens' c Line
line Content
c

-- | Delete the character after/under the cursor.
delete :: Content -> Content
delete :: Content -> Content
delete Content
c =
  let Line Int
n String
s = Getting Line Content Line -> Content -> Line
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Line Content Line
forall c. HasLine c => Lens' c Line
line Content
c in
  case Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n String
s of
    (String
preS, Char
_:String
postS) -> ASetter Content Content String String
-> String -> Content -> Content
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Content Content String String
forall c. HasLine c => Lens' c String
text (String
preS String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
postS) Content
c
    (String, String)
_               -> case Getting [String] Content [String] -> Content -> [String]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [String] Content [String]
Lens' Content [String]
below Content
c of
                         []   -> Content
c
                         String
b:[String]
bs -> ASetter Content Content [String] [String]
-> [String] -> Content -> Content
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Content Content [String] [String]
Lens' Content [String]
below [String]
bs
                               (Content -> Content) -> (Content -> Content) -> Content -> Content
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter Content Content String String
-> String -> Content -> Content
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Content Content String String
forall c. HasLine c => Lens' c String
text (String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
b)
                               (Content -> Content) -> Content -> Content
forall a b. (a -> b) -> a -> b
$ Content
c

-- | Insert character at cursor, cursor is advanced.
insertChar :: Char -> Content -> Content
insertChar :: Char -> Content -> Content
insertChar Char
'\n' Content
c =
  let Line Int
n String
txt = Getting Line Content Line -> Content -> Line
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Line Content Line
forall c. HasLine c => Lens' c Line
line Content
c in
  case Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n String
txt of
    (String
preS, String
postS) -> ASetter Content Content [String] [String]
-> ([String] -> [String]) -> Content -> Content
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Content Content [String] [String]
Lens' Content [String]
above (String
preS String -> [String] -> [String]
forall a. a -> [a] -> [a]
:)
                   (Content -> Content) -> Content -> Content
forall a b. (a -> b) -> a -> b
$ ASetter Content Content Line Line -> Line -> Content -> Content
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Content Content Line Line
forall c. HasLine c => Lens' c Line
line (String -> Line
beginLine String
postS) Content
c

insertChar Char
ins Content
c = ASetter Content Content Line Line
-> (Line -> Line) -> Content -> Content
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Content Content Line Line
forall c. HasLine c => Lens' c Line
line Line -> Line
aux Content
c
  where
    aux :: Line -> Line
aux (Line Int
n String
txt) =
      case Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n String
txt of
        (String
preS, String
postS) -> Int -> String -> Line
Line (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (String
preS String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
ins Char -> ShowS
forall a. a -> [a] -> [a]
: String
postS)

-- | Smarter version of 'insertString' that removes spurious newlines.
insertPastedString :: String -> Content -> Content
insertPastedString :: String -> Content -> Content
insertPastedString String
paste Content
c = String -> Content -> Content
insertString ((Char -> ShowS) -> String -> ShowS
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Char -> ShowS
scrub String
"" String
paste) Content
c
  where
    cursorAtEnd :: Bool
cursorAtEnd = [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Getting [String] Content [String] -> Content -> [String]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [String] Content [String]
Lens' Content [String]
below Content
c)
               Bool -> Bool -> Bool
&& String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Getting String Content String -> Content -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting String Content String
forall c. HasLine c => Lens' c String
text Content
c) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Getting Int Content Int -> Content -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int Content Int
forall c. HasLine c => Lens' c Int
pos Content
c

    -- ignore formfeeds
    scrub :: Char -> ShowS
scrub Char
'\r' String
xs = String
xs

    -- avoid adding empty lines
    scrub Char
'\n' xs :: String
xs@(Char
'\n':String
_) = String
xs

    -- avoid adding trailing newline at end of textbox
    scrub Char
'\n' String
"" | Bool
cursorAtEnd = String
""

    -- pass-through everything else
    scrub Char
x String
xs = Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: String
xs

-- | Insert string at cursor, cursor is advanced to the
-- end of the inserted string.
insertString :: String -> Content -> Content
insertString :: String -> Content -> Content
insertString String
ins Content
c =
  case [String] -> String -> [String] -> ([String], Line)
push (Getting [String] Content [String] -> Content -> [String]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [String] Content [String]
Lens' Content [String]
above Content
c) (String
preS String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
l) [String]
ls of
    ([String]
newAbove, Line
newLine) -> ASetter Content Content [String] [String]
-> [String] -> Content -> Content
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Content Content [String] [String]
Lens' Content [String]
above [String]
newAbove
                         (Content -> Content) -> Content -> Content
forall a b. (a -> b) -> a -> b
$ ASetter Content Content Line Line -> Line -> Content -> Content
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Content Content Line Line
forall c. HasLine c => Lens' c Line
line Line
newLine Content
c
  where
    String
l:[String]
ls          = String -> [String]
lines (String
ins String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n")
    Line Int
n String
txt    = Getting Line Content Line -> Content -> Line
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Line Content Line
forall c. HasLine c => Lens' c Line
line Content
c
    (String
preS, String
postS) = Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n String
txt

    push :: [String] -> String -> [String] -> ([String], Line)
push [String]
stk String
x []     = ([String]
stk, Int -> String -> Line
Line (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
x) (String
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
postS))
    push [String]
stk String
x (String
y:[String]
ys) = [String] -> String -> [String] -> ([String], Line)
push (String
xString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
stk) String
y [String]
ys

-- | Advance to the beginning of the next line
forwardLine :: Content -> Maybe Content
forwardLine :: Content -> Maybe Content
forwardLine Content
c =
  case Getting [String] Content [String] -> Content -> [String]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [String] Content [String]
Lens' Content [String]
below Content
c of
    []   -> Maybe Content
forall a. Maybe a
Nothing
    String
b:[String]
bs -> Content -> Maybe Content
forall a. a -> Maybe a
Just
         (Content -> Maybe Content) -> Content -> Maybe Content
forall a b. (a -> b) -> a -> b
$! ASetter Content Content [String] [String]
-> ([String] -> [String]) -> Content -> Content
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Content Content [String] [String]
Lens' Content [String]
above (Getting String Content String -> Content -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting String Content String
forall c. HasLine c => Lens' c String
text Content
c String -> [String] -> [String]
forall a. a -> [a] -> [a]
:)
          (Content -> Content) -> Content -> Content
forall a b. (a -> b) -> a -> b
$ ASetter Content Content [String] [String]
-> [String] -> Content -> Content
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Content Content [String] [String]
Lens' Content [String]
below [String]
bs
          (Content -> Content) -> Content -> Content
forall a b. (a -> b) -> a -> b
$ ASetter Content Content Line Line -> Line -> Content -> Content
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Content Content Line Line
forall c. HasLine c => Lens' c Line
line (String -> Line
beginLine String
b) Content
c

-- | Retreat to the end of the previous line
backwardLine :: Content -> Maybe Content
backwardLine :: Content -> Maybe Content
backwardLine Content
c =
  case Getting [String] Content [String] -> Content -> [String]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [String] Content [String]
Lens' Content [String]
above Content
c of
    []   -> Maybe Content
forall a. Maybe a
Nothing
    String
a:[String]
as -> Content -> Maybe Content
forall a. a -> Maybe a
Just
         (Content -> Maybe Content) -> Content -> Maybe Content
forall a b. (a -> b) -> a -> b
$! ASetter Content Content [String] [String]
-> ([String] -> [String]) -> Content -> Content
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Content Content [String] [String]
Lens' Content [String]
below (Getting String Content String -> Content -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting String Content String
forall c. HasLine c => Lens' c String
text Content
c String -> [String] -> [String]
forall a. a -> [a] -> [a]
:)
          (Content -> Content) -> Content -> Content
forall a b. (a -> b) -> a -> b
$ ASetter Content Content [String] [String]
-> [String] -> Content -> Content
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Content Content [String] [String]
Lens' Content [String]
above [String]
as
          (Content -> Content) -> Content -> Content
forall a b. (a -> b) -> a -> b
$ ASetter Content Content Line Line -> Line -> Content -> Content
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Content Content Line Line
forall c. HasLine c => Lens' c Line
line (String -> Line
endLine String
a) Content
c

toggle :: Content -> Content
toggle :: Content -> Content
toggle !Content
c
  | Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1     = Content
c
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2     = Content
c
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
p    = ASetter Content Content String String
-> ShowS -> Content -> Content
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Content Content String String
forall c. HasLine c => Lens' c String
text (Int -> ShowS
forall t a. (Eq t, Num t) => t -> [a] -> [a]
swapAt (Int
pInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2)) Content
c
  | Bool
otherwise = ASetter Content Content Int Int -> Int -> Content -> Content
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Content Content Int Int
forall c. HasLine c => Lens' c Int
pos (Int
pInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
              (Content -> Content) -> Content -> Content
forall a b. (a -> b) -> a -> b
$ ASetter Content Content String String
-> ShowS -> Content -> Content
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Content Content String String
forall c. HasLine c => Lens' c String
text (Int -> ShowS
forall t a. (Eq t, Num t) => t -> [a] -> [a]
swapAt (Int
pInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) Content
c
  where
    p :: Int
p = Getting Int Content Int -> Content -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int Content Int
forall c. HasLine c => Lens' c Int
pos Content
c
    n :: Int
n = LensLike' (Const Int) Content String
-> (String -> Int) -> Content -> Int
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views LensLike' (Const Int) Content String
forall c. HasLine c => Lens' c String
text String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Content
c

    swapAt :: t -> [a] -> [a]
swapAt t
0 (a
x:a
y:[a]
z) = a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
z
    swapAt t
i (a
x:[a]
xs)  = a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:t -> [a] -> [a]
swapAt (t
it -> t -> t
forall a. Num a => a -> a -> a
-t
1) [a]
xs
    swapAt t
_ [a]
_       = String -> [a]
forall a. HasCallStack => String -> a
error String
"toggle: PANIC! Invalid argument"


-- | Use the two characters preceeding the cursor as a digraph and replace
-- them with the corresponding character.
digraph :: Map Digraph Text -> Content -> Maybe Content
digraph :: Map Digraph Text -> Content -> Maybe Content
digraph Map Digraph Text
extras !Content
c =
  do let Line Int
n String
txt = Getting Line Content Line -> Content -> Line
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Line Content Line
forall c. HasLine c => Lens' c Line
line Content
c
     Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n)
     let (String
pfx,Char
x:Char
y:String
sfx) = Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) String
txt
     let key :: Digraph
key = Char -> Char -> Digraph
Digraph Char
x Char
y
     String
d <-  Text -> String
Text.unpack (Text -> String) -> Maybe Text -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Digraph -> Map Digraph Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Digraph
key Map Digraph Text
extras
       Maybe String -> Maybe String -> Maybe String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> String
forall (f :: * -> *) a. Applicative f => a -> f a
pure        (Char -> String) -> Maybe Char -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Digraph -> Maybe Char
lookupDigraph Digraph
key
     let line' :: Line
line' = Int -> String -> Line
Line (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (String
pfxString -> ShowS
forall a. [a] -> [a] -> [a]
++String
dString -> ShowS
forall a. [a] -> [a] -> [a]
++String
sfx)
     Content -> Maybe Content
forall a. a -> Maybe a
Just (Content -> Maybe Content) -> Content -> Maybe Content
forall a b. (a -> b) -> a -> b
$! ASetter Content Content Line Line -> Line -> Content -> Content
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Content Content Line Line
forall c. HasLine c => Lens' c Line
line Line
line' Content
c

fromStrings :: NonEmpty String -> Content
fromStrings :: NonEmpty String -> Content
fromStrings (String
x :| [String]
xs) = [String] -> Line -> [String] -> Content
Content [String]
xs (String -> Line
endLine String
x) []

toStrings :: Content -> NonEmpty String
toStrings :: Content -> NonEmpty String
toStrings Content
c = (NonEmpty String -> String -> NonEmpty String)
-> NonEmpty String -> [String] -> NonEmpty String
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ((String -> NonEmpty String -> NonEmpty String)
-> NonEmpty String -> String -> NonEmpty String
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> NonEmpty String -> NonEmpty String
forall a. a -> NonEmpty a -> NonEmpty a
(<|)) (Getting String Content String -> Content -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting String Content String
forall c. HasLine c => Lens' c String
text Content
c String -> [String] -> NonEmpty String
forall a. a -> [a] -> NonEmpty a
:| Getting [String] Content [String] -> Content -> [String]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [String] Content [String]
Lens' Content [String]
above Content
c) (Getting [String] Content [String] -> Content -> [String]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [String] Content [String]
Lens' Content [String]
below Content
c)