{-# Language TemplateHaskell, BangPatterns #-}
module Client.State.EditBox.Content
(
Content
, above
, below
, singleLine
, noContent
, shift
, toStrings
, fromStrings
, Line(..)
, HasLine(..)
, endLine
, left
, right
, leftWord
, rightWord
, jumpLeft
, jumpRight
, 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
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
noContent :: Content
noContent :: Content
noContent = [String] -> Line -> [String] -> Content
Content [] Line
emptyLine []
singleLine :: Line -> Content
singleLine :: Line -> Content
singleLine Line
l = [String] -> Line -> [String] -> Content
Content [] Line
l []
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)
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
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
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
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
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
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
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 :: 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
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)
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
scrub :: Char -> ShowS
scrub Char
'\r' String
xs = String
xs
scrub Char
'\n' xs :: String
xs@(Char
'\n':String
_) = String
xs
scrub Char
'\n' String
"" | Bool
cursorAtEnd = String
""
scrub Char
x String
xs = Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: String
xs
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
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
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"
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)