-- | This module provides a two-dimensional text zipper data structure.
-- This structure represents a body of text and an editing cursor
-- which can be moved throughout the text, along with a set of editing
-- transformations.
--
-- Text zippers are generalized over the set of data types that might be
-- used to store lists of characters (e.g., 'String', 'T.Text', etc.).
-- As a result, the most general way to create a text zipper is to use
-- 'mkZipper' and provide all of the functions required to manipulate
-- the underlying text data.
--
-- Implementations using 'T.Text' and 'String' are provided.
module Data.Text.Zipper
    ( TextZipper

    -- * Construction and extraction
    , mkZipper
    , textZipper
    , stringZipper
    , clearZipper
    , vectorZipper
    , getText
    , currentLine
    , cursorPosition
    , lineLengths
    , getLineLimit

    -- * Navigation functions
    , moveCursor
    , moveCursorClosest
    , moveRight
    , moveLeft
    , moveUp
    , moveDown
    , gotoEOL
    , gotoBOL
    , gotoEOF
    , gotoBOF

    -- * Inspection functions
    , currentChar
    , nextChar
    , previousChar

    -- * Editing functions
    , insertChar
    , insertMany
    , deletePrevChar
    , deleteChar
    , breakLine
    , killToEOL
    , killToBOL
    , killToEOF
    , killToBOF
    , transposeChars
    )
where

import Control.Applicative ((<$>))
import Control.DeepSeq
import Data.Char (isPrint)
import Data.List (foldl')
import Data.Monoid
import qualified Data.Text as T
import qualified Data.Vector as V
import qualified Data.Text.Zipper.Vector as V

data TextZipper a =
    TZ { forall a. TextZipper a -> a
toLeft :: a
       , forall a. TextZipper a -> a
toRight :: a
       , forall a. TextZipper a -> [a]
above :: [a]
       , forall a. TextZipper a -> [a]
below :: [a]
       , forall a. TextZipper a -> Char -> a
fromChar :: Char -> a
       , forall a. TextZipper a -> Int -> a -> a
drop_ :: Int -> a -> a
       , forall a. TextZipper a -> Int -> a -> a
take_ :: Int -> a -> a
       , forall a. TextZipper a -> a -> Int
length_ :: a -> Int
       , forall a. TextZipper a -> a -> Char
last_ :: a -> Char
       , forall a. TextZipper a -> a -> a
init_ :: a -> a
       , forall a. TextZipper a -> a -> Bool
null_ :: a -> Bool
       , forall a. TextZipper a -> a -> [a]
lines_ :: a -> [a]
       , forall a. TextZipper a -> a -> String
toList_ :: a -> [Char]
       , forall a. TextZipper a -> Maybe Int
lineLimit :: Maybe Int
       }

instance (NFData a) => NFData (TextZipper a) where
    rnf :: TextZipper a -> ()
rnf TextZipper a
z = (forall a. TextZipper a -> a
toLeft TextZipper a
z) forall a b. NFData a => a -> b -> b
`deepseq`
            (forall a. TextZipper a -> a
toRight TextZipper a
z) forall a b. NFData a => a -> b -> b
`deepseq`
            (forall a. TextZipper a -> [a]
above TextZipper a
z) forall a b. NFData a => a -> b -> b
`deepseq`
            (forall a. TextZipper a -> [a]
below TextZipper a
z) forall a b. NFData a => a -> b -> b
`deepseq`
            ()

-- | Get the line limit, if any, for a zipper.
getLineLimit :: TextZipper a -> Maybe Int
getLineLimit :: forall a. TextZipper a -> Maybe Int
getLineLimit = forall a. TextZipper a -> Maybe Int
lineLimit

instance (Eq a) => Eq (TextZipper a) where
    TextZipper a
a == :: TextZipper a -> TextZipper a -> Bool
== TextZipper a
b = forall (t :: * -> *). Foldable t => t Bool -> Bool
and [ forall a. TextZipper a -> a
toLeft TextZipper a
a forall a. Eq a => a -> a -> Bool
== forall a. TextZipper a -> a
toLeft TextZipper a
b
                 , forall a. TextZipper a -> a
toRight TextZipper a
a forall a. Eq a => a -> a -> Bool
== forall a. TextZipper a -> a
toRight TextZipper a
b
                 , forall a. TextZipper a -> [a]
above TextZipper a
a forall a. Eq a => a -> a -> Bool
== forall a. TextZipper a -> [a]
above TextZipper a
b
                 , forall a. TextZipper a -> [a]
below TextZipper a
a forall a. Eq a => a -> a -> Bool
== forall a. TextZipper a -> [a]
below TextZipper a
b
                 ]

instance (Show a) => Show (TextZipper a) where
    show :: TextZipper a -> String
show TextZipper a
tz = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"TextZipper { "
                     , String
"above = "
                     , forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall a. TextZipper a -> [a]
above TextZipper a
tz
                     , String
", below = "
                     , forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall a. TextZipper a -> [a]
below TextZipper a
tz
                     , String
", toLeft = "
                     , forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall a. TextZipper a -> a
toLeft TextZipper a
tz
                     , String
", toRight = "
                     , forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall a. TextZipper a -> a
toRight TextZipper a
tz
                     , String
" }"
                     ]

-- | Create a zipper using a custom text storage type. Takes the initial
-- text as well as all of the functions necessary to manipulate the
-- underlying text values.
mkZipper :: (Monoid a) =>
            (Char -> a)
         -- ^A singleton constructor.
         -> (Int -> a -> a)
         -- ^'drop'.
         -> (Int -> a -> a)
         -- ^'take'.
         -> (a -> Int)
         -- ^'length'.
         -> (a -> Char)
         -- ^'last'.
         -> (a -> a)
         -- ^'init'.
         -> (a -> Bool)
         -- ^'null'.
         -> (a -> [a])
         -- ^'lines'.
         -> (a -> [Char])
         -- ^'toList'.
         -> [a]
         -- ^The initial lines of text.
         -> Maybe Int
         -- ^Limit to this many lines of text ('Nothing' means no limit).
         -> TextZipper a
mkZipper :: forall a.
Monoid a =>
(Char -> a)
-> (Int -> a -> a)
-> (Int -> a -> a)
-> (a -> Int)
-> (a -> Char)
-> (a -> a)
-> (a -> Bool)
-> (a -> [a])
-> (a -> String)
-> [a]
-> Maybe Int
-> TextZipper a
mkZipper Char -> a
fromCh Int -> a -> a
drp Int -> a -> a
tk a -> Int
lngth a -> Char
lst a -> a
int a -> Bool
nl a -> [a]
linesFunc a -> String
toListF [a]
ls Maybe Int
lmt =
    let limitedLs :: [a]
limitedLs = case Maybe Int
lmt of
          Maybe Int
Nothing -> [a]
ls
          Just Int
n -> forall a. Int -> [a] -> [a]
take Int
n [a]
ls
        (a
first, [a]
rest) = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
limitedLs
                        then (forall a. Monoid a => a
mempty, forall a. Monoid a => a
mempty)
                        else (forall a. [a] -> a
head [a]
limitedLs, forall a. [a] -> [a]
tail [a]
limitedLs)
        numLines :: Int
numLines = forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ls
        insertLine :: TextZipper a -> (Int, a) -> TextZipper a
insertLine TextZipper a
z (Int
i, a
l) = (if Int
i forall a. Ord a => a -> a -> Bool
< Int
numLines forall a. Num a => a -> a -> a
- Int
1 then forall a. Monoid a => TextZipper a -> TextZipper a
breakLine else forall a. a -> a
id) forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a -> TextZipper a -> TextZipper a
insertMany a
l TextZipper a
z
        loadInitial :: TextZipper a -> TextZipper a
loadInitial TextZipper a
z = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall {a}. Monoid a => TextZipper a -> (Int, a) -> TextZipper a
insertLine TextZipper a
z forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] (a
firstforall a. a -> [a] -> [a]
:[a]
rest)
    in TextZipper a -> TextZipper a
loadInitial forall a b. (a -> b) -> a -> b
$ forall a.
a
-> a
-> [a]
-> [a]
-> (Char -> a)
-> (Int -> a -> a)
-> (Int -> a -> a)
-> (a -> Int)
-> (a -> Char)
-> (a -> a)
-> (a -> Bool)
-> (a -> [a])
-> (a -> String)
-> Maybe Int
-> TextZipper a
TZ forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty Char -> a
fromCh Int -> a -> a
drp Int -> a -> a
tk a -> Int
lngth a -> Char
lst a -> a
int a -> Bool
nl a -> [a]
linesFunc a -> String
toListF Maybe Int
lmt

-- | Get the text contents of the zipper.
getText :: (Monoid a) => TextZipper a -> [a]
getText :: forall a. Monoid a => TextZipper a -> [a]
getText TextZipper a
tz = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ forall a. TextZipper a -> [a]
above TextZipper a
tz
                    , [forall a. Monoid a => TextZipper a -> a
currentLine TextZipper a
tz]
                    , forall a. TextZipper a -> [a]
below TextZipper a
tz
                    ]

-- | Return the lengths of the lines in the zipper.
lineLengths :: (Monoid a) => TextZipper a -> [Int]
lineLengths :: forall a. Monoid a => TextZipper a -> [Int]
lineLengths TextZipper a
tz = (forall a. TextZipper a -> a -> Int
length_ TextZipper a
tz) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ forall a. TextZipper a -> [a]
above TextZipper a
tz
                                         , [forall a. Monoid a => TextZipper a -> a
currentLine TextZipper a
tz]
                                         , forall a. TextZipper a -> [a]
below TextZipper a
tz
                                         ]

-- | Get the cursor position of the zipper; returns @(row, col)@.
-- @row@ ranges from @[0..num_rows-1]@ inclusive; @col@ ranges from
-- @[0..length of current line]@ inclusive. Column values equal to line
-- width indicate a cursor that is just past the end of a line of text.
cursorPosition :: TextZipper a -> (Int, Int)
cursorPosition :: forall a. TextZipper a -> (Int, Int)
cursorPosition TextZipper a
tz = (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. TextZipper a -> [a]
above TextZipper a
tz, forall a. TextZipper a -> a -> Int
length_ TextZipper a
tz forall a b. (a -> b) -> a -> b
$ forall a. TextZipper a -> a
toLeft TextZipper a
tz)

-- | Move the cursor to the specified row and column. Invalid cursor
-- positions will be ignored. Valid cursor positions range as described
-- for 'cursorPosition'.
moveCursor :: (Monoid a) => (Int, Int) -> TextZipper a -> TextZipper a
moveCursor :: forall a. Monoid a => (Int, Int) -> TextZipper a -> TextZipper a
moveCursor (Int
row, Int
col) TextZipper a
tz =
    let t :: [a]
t = forall a. Monoid a => TextZipper a -> [a]
getText TextZipper a
tz
    in if Int
row forall a. Ord a => a -> a -> Bool
< Int
0
           Bool -> Bool -> Bool
|| Int
row forall a. Ord a => a -> a -> Bool
>= forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
t
           Bool -> Bool -> Bool
|| Int
col forall a. Ord a => a -> a -> Bool
< Int
0
           Bool -> Bool -> Bool
|| Int
col forall a. Ord a => a -> a -> Bool
> forall a. TextZipper a -> a -> Int
length_ TextZipper a
tz ([a]
t forall a. [a] -> Int -> a
!! Int
row)
       then TextZipper a
tz
       else TextZipper a
tz { above :: [a]
above = forall a. Int -> [a] -> [a]
take Int
row [a]
t
               , below :: [a]
below = forall a. Int -> [a] -> [a]
drop (Int
row forall a. Num a => a -> a -> a
+ Int
1) [a]
t
               , toLeft :: a
toLeft = forall a. TextZipper a -> Int -> a -> a
take_ TextZipper a
tz Int
col ([a]
t forall a. [a] -> Int -> a
!! Int
row)
               , toRight :: a
toRight = forall a. TextZipper a -> Int -> a -> a
drop_ TextZipper a
tz Int
col ([a]
t forall a. [a] -> Int -> a
!! Int
row)
               }

-- | Move the cursor to the specified row and column. Invalid cursor
-- positions will be reinterpreted as the closest valid position. Valid
-- cursor positions range as described for 'cursorPosition'.
moveCursorClosest :: (Monoid a) => (Int, Int) -> TextZipper a -> TextZipper a
moveCursorClosest :: forall a. Monoid a => (Int, Int) -> TextZipper a -> TextZipper a
moveCursorClosest (Int
row, Int
col) TextZipper a
tz =
    let t :: [a]
t = forall a. Monoid a => TextZipper a -> [a]
getText TextZipper a
tz
        bestRow :: Int
bestRow = forall a. Ord a => a -> a -> a
min (forall a. Ord a => a -> a -> a
max Int
0 forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
t forall a. Num a => a -> a -> a
- Int
1) forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
max Int
0 Int
row
        bestCol :: Int
bestCol = if Int
bestRow forall a. Ord a => a -> a -> Bool
< forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
t
                  then forall a. Ord a => a -> a -> a
min (forall a. TextZipper a -> a -> Int
length_ TextZipper a
tz ([a]
t forall a. [a] -> Int -> a
!! Int
bestRow)) forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
max Int
0 Int
col
                  else Int
0
    in TextZipper a
tz { above :: [a]
above = forall a. Int -> [a] -> [a]
take Int
bestRow [a]
t
          , below :: [a]
below = forall a. Int -> [a] -> [a]
drop (Int
bestRow forall a. Num a => a -> a -> a
+ Int
1) [a]
t
          , toLeft :: a
toLeft = forall a. TextZipper a -> Int -> a -> a
take_ TextZipper a
tz Int
bestCol ([a]
t forall a. [a] -> Int -> a
!! Int
bestRow)
          , toRight :: a
toRight = forall a. TextZipper a -> Int -> a -> a
drop_ TextZipper a
tz Int
bestCol ([a]
t forall a. [a] -> Int -> a
!! Int
bestRow)
          }

isFirstLine :: TextZipper a -> Bool
isFirstLine :: forall a. TextZipper a -> Bool
isFirstLine = forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. TextZipper a -> [a]
above

isLastLine :: TextZipper a -> Bool
isLastLine :: forall a. TextZipper a -> Bool
isLastLine = (forall a. Eq a => a -> a -> Bool
== Int
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. TextZipper a -> [a]
below

nextLine :: TextZipper a -> a
nextLine :: forall a. TextZipper a -> a
nextLine = forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. TextZipper a -> [a]
below

-- | The line of text on which the zipper's cursor currently resides.
currentLine :: (Monoid a) => TextZipper a -> a
currentLine :: forall a. Monoid a => TextZipper a -> a
currentLine TextZipper a
tz = (forall a. TextZipper a -> a
toLeft TextZipper a
tz) forall a. Monoid a => a -> a -> a
`mappend` (forall a. TextZipper a -> a
toRight TextZipper a
tz)

-- | Insert a character at the current cursor position.
--
-- If the character is a newline, break the current line.
--
-- If the character is non-printable, ignore it.
--
-- Otherwise insert the character and move the cursor one position to
-- the right.
insertChar :: (Monoid a) => Char -> TextZipper a -> TextZipper a
insertChar :: forall a. Monoid a => Char -> TextZipper a -> TextZipper a
insertChar Char
ch TextZipper a
tz
    | Char
ch forall a. Eq a => a -> a -> Bool
== Char
'\n' = forall a. Monoid a => TextZipper a -> TextZipper a
breakLine TextZipper a
tz
    | Char -> Bool
isPrint Char
ch = TextZipper a
tz { toLeft :: a
toLeft = forall a. TextZipper a -> a
toLeft TextZipper a
tz forall a. Monoid a => a -> a -> a
`mappend` (forall a. TextZipper a -> Char -> a
fromChar TextZipper a
tz Char
ch) }
    | Bool
otherwise  = TextZipper a
tz

-- | Insert many characters at the current cursor position. Move the
-- cursor to the end of the inserted text.
insertMany :: (Monoid a) => a -> TextZipper a -> TextZipper a
insertMany :: forall a. Monoid a => a -> TextZipper a -> TextZipper a
insertMany a
str TextZipper a
tz = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Monoid a => Char -> TextZipper a -> TextZipper a
insertChar) TextZipper a
tz forall a b. (a -> b) -> a -> b
$ forall a. TextZipper a -> a -> String
toList_ TextZipper a
tz a
str

-- | Insert a line break at the current cursor position.
breakLine :: (Monoid a) => TextZipper a -> TextZipper a
breakLine :: forall a. Monoid a => TextZipper a -> TextZipper a
breakLine TextZipper a
tz =
    -- Plus two because we count the current line and the line we are
    -- about to create; if that number of lines exceeds the limit,
    -- ignore this operation.
    let modified :: TextZipper a
modified = TextZipper a
tz { above :: [a]
above = forall a. TextZipper a -> [a]
above TextZipper a
tz forall a. [a] -> [a] -> [a]
++ [forall a. TextZipper a -> a
toLeft TextZipper a
tz]
                      , toLeft :: a
toLeft = forall a. Monoid a => a
mempty
                      }
    in case forall a. TextZipper a -> Maybe Int
lineLimit TextZipper a
tz of
          Just Int
lim -> if forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall a. TextZipper a -> [a]
above TextZipper a
tz) forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall a. TextZipper a -> [a]
below TextZipper a
tz) forall a. Num a => a -> a -> a
+ Int
2 forall a. Ord a => a -> a -> Bool
> Int
lim
                      then TextZipper a
tz
                      else TextZipper a
modified
          Maybe Int
Nothing -> TextZipper a
modified

-- | Move the cursor to the end of the current line.
gotoEOL :: (Monoid a) => TextZipper a -> TextZipper a
gotoEOL :: forall a. Monoid a => TextZipper a -> TextZipper a
gotoEOL TextZipper a
tz = TextZipper a
tz { toLeft :: a
toLeft = forall a. Monoid a => TextZipper a -> a
currentLine TextZipper a
tz
                , toRight :: a
toRight = forall a. Monoid a => a
mempty
                }

-- | Move the cursor to the end of a text zipper.
gotoEOF :: (Monoid a) => TextZipper a -> TextZipper a
gotoEOF :: forall a. Monoid a => TextZipper a -> TextZipper a
gotoEOF TextZipper a
tz =
    TextZipper a
tz { toLeft :: a
toLeft = a
end
       , toRight :: a
toRight = forall a. Monoid a => a
mempty
       , above :: [a]
above = [a]
top
       , below :: [a]
below = forall a. Monoid a => a
mempty
       }
   where
       tx :: [a]
tx = forall a. Monoid a => TextZipper a -> [a]
getText TextZipper a
tz
       ([a]
top, a
end) = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
tx
                    then (forall a. Monoid a => a
mempty, forall a. Monoid a => a
mempty)
                    else (forall a. [a] -> [a]
init [a]
tx, forall a. [a] -> a
last [a]
tx)

-- | Remove all text from the cursor position to the end of the current
-- line. If the cursor is at the beginning of a line and the line is
-- empty, the entire line will be removed.
killToEOL :: (Monoid a) => TextZipper a -> TextZipper a
killToEOL :: forall a. Monoid a => TextZipper a -> TextZipper a
killToEOL TextZipper a
tz
    | (forall a. TextZipper a -> a -> Bool
null_ TextZipper a
tz forall a b. (a -> b) -> a -> b
$ forall a. TextZipper a -> a
toLeft TextZipper a
tz) Bool -> Bool -> Bool
&& (forall a. TextZipper a -> a -> Bool
null_ TextZipper a
tz forall a b. (a -> b) -> a -> b
$ forall a. TextZipper a -> a
toRight TextZipper a
tz) Bool -> Bool -> Bool
&&
      (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ forall a. TextZipper a -> [a]
below TextZipper a
tz) =
          TextZipper a
tz { toRight :: a
toRight = forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ forall a. TextZipper a -> [a]
below TextZipper a
tz
             , below :: [a]
below = forall a. [a] -> [a]
tail forall a b. (a -> b) -> a -> b
$ forall a. TextZipper a -> [a]
below TextZipper a
tz
             }
    | Bool
otherwise = TextZipper a
tz { toRight :: a
toRight = forall a. Monoid a => a
mempty
                     }

-- | Remove all text from the cursor position to the beginning of the
-- current line.
killToBOL :: Monoid a => TextZipper a -> TextZipper a
killToBOL :: forall a. Monoid a => TextZipper a -> TextZipper a
killToBOL TextZipper a
tz = TextZipper a
tz { toLeft :: a
toLeft = forall a. Monoid a => a
mempty
                  }

-- | Remove all text from the cursor position to the end of the text
-- zipper. If the cursor is at the beginning of a line and the line is
-- empty, the entire line will be removed.
killToEOF :: (Monoid a) => TextZipper a -> TextZipper a
killToEOF :: forall a. Monoid a => TextZipper a -> TextZipper a
killToEOF TextZipper a
tz =
    TextZipper a
tz { toRight :: a
toRight = forall a. Monoid a => a
mempty
       , below :: [a]
below = forall a. Monoid a => a
mempty
       }

-- | Remove all text from the cursor position to the beginning of the
-- text zipper.
killToBOF :: Monoid a => TextZipper a -> TextZipper a
killToBOF :: forall a. Monoid a => TextZipper a -> TextZipper a
killToBOF TextZipper a
tz =
    TextZipper a
tz { toLeft :: a
toLeft = forall a. Monoid a => a
mempty
       , above :: [a]
above = forall a. Monoid a => a
mempty
       }

-- | Delete the character preceding the cursor position, and move the
-- cursor backwards by one character.
deletePrevChar :: (Eq a, Monoid a) => TextZipper a -> TextZipper a
deletePrevChar :: forall a. (Eq a, Monoid a) => TextZipper a -> TextZipper a
deletePrevChar TextZipper a
tz
    | forall a. Monoid a => TextZipper a -> TextZipper a
moveLeft TextZipper a
tz forall a. Eq a => a -> a -> Bool
== TextZipper a
tz = TextZipper a
tz
    | Bool
otherwise = forall a. Monoid a => TextZipper a -> TextZipper a
deleteChar forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => TextZipper a -> TextZipper a
moveLeft TextZipper a
tz

-- | Delete the character at the cursor position. Leaves the cursor
-- position unchanged. If the cursor is at the end of a line of text,
-- this combines the line with the line below.
deleteChar :: (Monoid a) => TextZipper a -> TextZipper a
deleteChar :: forall a. Monoid a => TextZipper a -> TextZipper a
deleteChar TextZipper a
tz
    -- Can we just remove a char from the current line?
    | (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall a. TextZipper a -> a -> Bool
null_ TextZipper a
tz (forall a. TextZipper a -> a
toRight TextZipper a
tz)) =
        TextZipper a
tz { toRight :: a
toRight = forall a. TextZipper a -> Int -> a -> a
drop_ TextZipper a
tz Int
1 forall a b. (a -> b) -> a -> b
$ forall a. TextZipper a -> a
toRight TextZipper a
tz
           }
    -- Do we need to collapse the previous line onto the current one?
    | forall a. TextZipper a -> a -> Bool
null_ TextZipper a
tz (forall a. TextZipper a -> a
toRight TextZipper a
tz) Bool -> Bool -> Bool
&& (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ forall a. TextZipper a -> [a]
below TextZipper a
tz) =
        TextZipper a
tz { toRight :: a
toRight = forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ forall a. TextZipper a -> [a]
below TextZipper a
tz
           , below :: [a]
below = forall a. [a] -> [a]
tail forall a b. (a -> b) -> a -> b
$ forall a. TextZipper a -> [a]
below TextZipper a
tz
           }
    | Bool
otherwise = TextZipper a
tz

-- | Get the Char on which the cursor currently resides. If the cursor
-- is at the end of the text or the text is empty return @Nothing@.
currentChar :: TextZipper a -> Maybe Char
currentChar :: forall a. TextZipper a -> Maybe Char
currentChar TextZipper a
tz
  | Bool -> Bool
not (forall a. TextZipper a -> a -> Bool
null_ TextZipper a
tz (forall a. TextZipper a -> a
toRight TextZipper a
tz)) =
    forall a. a -> Maybe a
Just (forall a. TextZipper a -> a -> Char
last_ TextZipper a
tz (forall a. TextZipper a -> Int -> a -> a
take_ TextZipper a
tz Int
1 (forall a. TextZipper a -> a
toRight TextZipper a
tz)))
  | Bool
otherwise = forall a. Maybe a
Nothing

-- | Get the Char after the cursor position. If the cursor is at the end
-- of a line return the first character of the next line, or if that one
-- is empty as well, return @Nothing@.
nextChar :: (Monoid a) => TextZipper a -> Maybe Char
nextChar :: forall a. Monoid a => TextZipper a -> Maybe Char
nextChar TextZipper a
tz = forall a. TextZipper a -> Maybe Char
currentChar (forall a. Monoid a => TextZipper a -> TextZipper a
moveRight TextZipper a
tz)

-- | Get the Char before the cursor position. If the cursor is at the
-- beginning of the text, return @Nothing@
previousChar :: (Monoid a) => TextZipper a -> Maybe Char
previousChar :: forall a. Monoid a => TextZipper a -> Maybe Char
previousChar TextZipper a
tz
  -- Only return Nothing if we are at the beginning of a line and only empty
  -- lines are above
  | forall a b. (a, b) -> b
snd (forall a. TextZipper a -> (Int, Int)
cursorPosition TextZipper a
tz) forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. TextZipper a -> a -> Bool
null_ TextZipper a
tz) (forall a. TextZipper a -> [a]
above TextZipper a
tz) =
    forall a. Maybe a
Nothing
  | Bool
otherwise =
    forall a. TextZipper a -> Maybe Char
currentChar (forall a. Monoid a => TextZipper a -> TextZipper a
moveLeft TextZipper a
tz)

-- | Move the cursor to the beginning of the current line.
gotoBOL :: (Monoid a) => TextZipper a -> TextZipper a
gotoBOL :: forall a. Monoid a => TextZipper a -> TextZipper a
gotoBOL TextZipper a
tz = TextZipper a
tz { toLeft :: a
toLeft = forall a. Monoid a => a
mempty
                , toRight :: a
toRight = forall a. Monoid a => TextZipper a -> a
currentLine TextZipper a
tz
                }

-- | Move the cursor to the beginning of a text zipper.
gotoBOF :: (Monoid a) => TextZipper a -> TextZipper a
gotoBOF :: forall a. Monoid a => TextZipper a -> TextZipper a
gotoBOF TextZipper a
tz =
    TextZipper a
tz { toLeft :: a
toLeft = forall a. Monoid a => a
mempty
       , toRight :: a
toRight = a
first
       , above :: [a]
above = forall a. Monoid a => a
mempty
       , below :: [a]
below = [a]
rest
       }
    where
        tx :: [a]
tx = forall a. Monoid a => TextZipper a -> [a]
getText TextZipper a
tz
        (a
first, [a]
rest) = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
tx
                        then (forall a. Monoid a => a
mempty, forall a. Monoid a => a
mempty)
                        else (forall a. [a] -> a
head [a]
tx, forall a. [a] -> [a]
tail [a]
tx)

-- | Move the cursor right by one position. If the cursor is at the end
-- of a line, the cursor is moved to the first position of the following
-- line (if any).
moveRight :: (Monoid a) => TextZipper a -> TextZipper a
moveRight :: forall a. Monoid a => TextZipper a -> TextZipper a
moveRight TextZipper a
tz
    -- Are we able to keep moving right on the current line?
    | Bool -> Bool
not (forall a. TextZipper a -> a -> Bool
null_ TextZipper a
tz (forall a. TextZipper a -> a
toRight TextZipper a
tz)) =
        TextZipper a
tz { toLeft :: a
toLeft = forall a. TextZipper a -> a
toLeft TextZipper a
tz
                      forall a. Monoid a => a -> a -> a
`mappend` (forall a. TextZipper a -> Int -> a -> a
take_ TextZipper a
tz Int
1 forall a b. (a -> b) -> a -> b
$ forall a. TextZipper a -> a
toRight TextZipper a
tz)
           , toRight :: a
toRight = forall a. TextZipper a -> Int -> a -> a
drop_ TextZipper a
tz Int
1 (forall a. TextZipper a -> a
toRight TextZipper a
tz)
           }
    -- If we are going to go beyond the end of the current line, can
    -- we move to the next one?
    | Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall a. TextZipper a -> [a]
below TextZipper a
tz) =
        TextZipper a
tz { above :: [a]
above = forall a. TextZipper a -> [a]
above TextZipper a
tz forall a. [a] -> [a] -> [a]
++ [forall a. TextZipper a -> a
toLeft TextZipper a
tz]
           , below :: [a]
below = forall a. [a] -> [a]
tail forall a b. (a -> b) -> a -> b
$ forall a. TextZipper a -> [a]
below TextZipper a
tz
           , toLeft :: a
toLeft = forall a. Monoid a => a
mempty
           , toRight :: a
toRight = forall a. TextZipper a -> a
nextLine TextZipper a
tz
           }
    | Bool
otherwise = TextZipper a
tz

-- | Move the cursor left by one position. If the cursor is at the
-- beginning of a line, the cursor is moved to the last position of the
-- preceding line (if any).
moveLeft :: (Monoid a) => TextZipper a -> TextZipper a
moveLeft :: forall a. Monoid a => TextZipper a -> TextZipper a
moveLeft TextZipper a
tz
    -- Are we able to keep moving left on the current line?
    | Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall a. TextZipper a -> a -> Bool
null_ TextZipper a
tz (forall a. TextZipper a -> a
toLeft TextZipper a
tz) =
        TextZipper a
tz { toLeft :: a
toLeft = forall a. TextZipper a -> a -> a
init_ TextZipper a
tz forall a b. (a -> b) -> a -> b
$ forall a. TextZipper a -> a
toLeft TextZipper a
tz
           , toRight :: a
toRight = forall a. TextZipper a -> Char -> a
fromChar TextZipper a
tz (forall a. TextZipper a -> a -> Char
last_ TextZipper a
tz (forall a. TextZipper a -> a
toLeft TextZipper a
tz))
                       forall a. Monoid a => a -> a -> a
`mappend` forall a. TextZipper a -> a
toRight TextZipper a
tz
           }
    -- If we are going to go beyond the beginning of the current line,
    -- can we move to the end of the previous one?
    | Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall a. TextZipper a -> [a]
above TextZipper a
tz) =
        TextZipper a
tz { above :: [a]
above = forall a. [a] -> [a]
init forall a b. (a -> b) -> a -> b
$ forall a. TextZipper a -> [a]
above TextZipper a
tz
           , below :: [a]
below = forall a. Monoid a => TextZipper a -> a
currentLine TextZipper a
tz forall a. a -> [a] -> [a]
: forall a. TextZipper a -> [a]
below TextZipper a
tz
           , toLeft :: a
toLeft = forall a. [a] -> a
last forall a b. (a -> b) -> a -> b
$ forall a. TextZipper a -> [a]
above TextZipper a
tz
           , toRight :: a
toRight = forall a. Monoid a => a
mempty
           }
    | Bool
otherwise = TextZipper a
tz

-- | Move the cursor up by one row. If there no are rows above the
-- current one, move to the first position of the current row. If the
-- row above is shorter, move to the end of that row.
moveUp :: (Monoid a) => TextZipper a -> TextZipper a
moveUp :: forall a. Monoid a => TextZipper a -> TextZipper a
moveUp TextZipper a
tz
    -- Is there a line above at least as long as the current one?
    | (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall a. TextZipper a -> Bool
isFirstLine TextZipper a
tz) Bool -> Bool -> Bool
&&
      (forall a. TextZipper a -> a -> Int
length_ TextZipper a
tz forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
last forall a b. (a -> b) -> a -> b
$ forall a. TextZipper a -> [a]
above TextZipper a
tz) forall a. Ord a => a -> a -> Bool
>= forall a. TextZipper a -> a -> Int
length_ TextZipper a
tz (forall a. TextZipper a -> a
toLeft TextZipper a
tz) =
        TextZipper a
tz { below :: [a]
below = forall a. Monoid a => TextZipper a -> a
currentLine TextZipper a
tz forall a. a -> [a] -> [a]
: forall a. TextZipper a -> [a]
below TextZipper a
tz
           , above :: [a]
above = forall a. [a] -> [a]
init forall a b. (a -> b) -> a -> b
$ forall a. TextZipper a -> [a]
above TextZipper a
tz
           , toLeft :: a
toLeft = forall a. TextZipper a -> Int -> a -> a
take_ TextZipper a
tz (forall a. TextZipper a -> a -> Int
length_ TextZipper a
tz forall a b. (a -> b) -> a -> b
$ forall a. TextZipper a -> a
toLeft TextZipper a
tz) (forall a. [a] -> a
last forall a b. (a -> b) -> a -> b
$ forall a. TextZipper a -> [a]
above TextZipper a
tz)
           , toRight :: a
toRight = forall a. TextZipper a -> Int -> a -> a
drop_ TextZipper a
tz (forall a. TextZipper a -> a -> Int
length_ TextZipper a
tz forall a b. (a -> b) -> a -> b
$ forall a. TextZipper a -> a
toLeft TextZipper a
tz) (forall a. [a] -> a
last forall a b. (a -> b) -> a -> b
$ forall a. TextZipper a -> [a]
above TextZipper a
tz)
           }
    -- Or if there is a line above, just go to the end of it
    | (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall a. TextZipper a -> Bool
isFirstLine TextZipper a
tz) =
        TextZipper a
tz { above :: [a]
above = forall a. [a] -> [a]
init forall a b. (a -> b) -> a -> b
$ forall a. TextZipper a -> [a]
above TextZipper a
tz
           , below :: [a]
below = forall a. Monoid a => TextZipper a -> a
currentLine TextZipper a
tz forall a. a -> [a] -> [a]
: forall a. TextZipper a -> [a]
below TextZipper a
tz
           , toLeft :: a
toLeft = forall a. [a] -> a
last forall a b. (a -> b) -> a -> b
$ forall a. TextZipper a -> [a]
above TextZipper a
tz
           , toRight :: a
toRight = forall a. Monoid a => a
mempty
           }
    -- If nothing else, go to the beginning of the current line
    | Bool
otherwise = forall a. Monoid a => TextZipper a -> TextZipper a
gotoBOL TextZipper a
tz

-- | Move the cursor down by one row. If there are no rows below the
-- current one, move to the last position of the current row. If the row
-- below is shorter, move to the end of that row.
moveDown :: (Monoid a) => TextZipper a -> TextZipper a
moveDown :: forall a. Monoid a => TextZipper a -> TextZipper a
moveDown TextZipper a
tz
    -- Is there a line below at least as long as the current one?
    | (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall a. TextZipper a -> Bool
isLastLine TextZipper a
tz) Bool -> Bool -> Bool
&&
      (forall a. TextZipper a -> a -> Int
length_ TextZipper a
tz forall a b. (a -> b) -> a -> b
$ forall a. TextZipper a -> a
nextLine TextZipper a
tz) forall a. Ord a => a -> a -> Bool
>= forall a. TextZipper a -> a -> Int
length_ TextZipper a
tz (forall a. TextZipper a -> a
toLeft TextZipper a
tz) =
        TextZipper a
tz { below :: [a]
below = forall a. [a] -> [a]
tail forall a b. (a -> b) -> a -> b
$ forall a. TextZipper a -> [a]
below TextZipper a
tz
           , above :: [a]
above = forall a. TextZipper a -> [a]
above TextZipper a
tz forall a. [a] -> [a] -> [a]
++ [forall a. Monoid a => TextZipper a -> a
currentLine TextZipper a
tz]
           , toLeft :: a
toLeft = forall a. TextZipper a -> Int -> a -> a
take_ TextZipper a
tz (forall a. TextZipper a -> a -> Int
length_ TextZipper a
tz forall a b. (a -> b) -> a -> b
$ forall a. TextZipper a -> a
toLeft TextZipper a
tz) (forall a. TextZipper a -> a
nextLine TextZipper a
tz)
           , toRight :: a
toRight = forall a. TextZipper a -> Int -> a -> a
drop_ TextZipper a
tz (forall a. TextZipper a -> a -> Int
length_ TextZipper a
tz forall a b. (a -> b) -> a -> b
$ forall a. TextZipper a -> a
toLeft TextZipper a
tz) (forall a. TextZipper a -> a
nextLine TextZipper a
tz)
           }
    -- Or if there is a line below, just go to the end of it
    | (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall a. TextZipper a -> Bool
isLastLine TextZipper a
tz) =
        TextZipper a
tz { above :: [a]
above = forall a. TextZipper a -> [a]
above TextZipper a
tz forall a. [a] -> [a] -> [a]
++ [forall a. Monoid a => TextZipper a -> a
currentLine TextZipper a
tz]
           , below :: [a]
below = forall a. [a] -> [a]
tail forall a b. (a -> b) -> a -> b
$ forall a. TextZipper a -> [a]
below TextZipper a
tz
           , toLeft :: a
toLeft = forall a. TextZipper a -> a
nextLine TextZipper a
tz
           , toRight :: a
toRight = forall a. Monoid a => a
mempty
           }
    -- If nothing else, go to the end of the current line
    | Bool
otherwise = forall a. Monoid a => TextZipper a -> TextZipper a
gotoEOL TextZipper a
tz

-- | Transpose the character before the cursor with the one at the
-- cursor position and move the cursor one position to the right. If
-- the cursor is at the end of the current line, transpose the current
-- line's last two characters.
transposeChars :: (Monoid a) => TextZipper a -> TextZipper a
transposeChars :: forall a. Monoid a => TextZipper a -> TextZipper a
transposeChars TextZipper a
tz
    | forall a. TextZipper a -> a -> Bool
null_ TextZipper a
tz (forall a. TextZipper a -> a
toLeft TextZipper a
tz) = TextZipper a
tz
    | forall a. TextZipper a -> a -> Bool
null_ TextZipper a
tz (forall a. TextZipper a -> a
toRight TextZipper a
tz) =
        if forall a. TextZipper a -> a -> Int
length_ TextZipper a
tz (forall a. TextZipper a -> a
toLeft TextZipper a
tz) forall a. Ord a => a -> a -> Bool
< Int
2
        then TextZipper a
tz
        else let prefixLen :: Int
prefixLen = forall a. TextZipper a -> a -> Int
length_ TextZipper a
tz (forall a. TextZipper a -> a
toLeft TextZipper a
tz) forall a. Num a => a -> a -> a
- Int
2
                 prefix :: a
prefix = forall a. TextZipper a -> Int -> a -> a
take_ TextZipper a
tz Int
prefixLen (forall a. TextZipper a -> a
toLeft TextZipper a
tz)
                 lastTwo :: a
lastTwo = forall a. TextZipper a -> Int -> a -> a
drop_ TextZipper a
tz Int
prefixLen (forall a. TextZipper a -> a
toLeft TextZipper a
tz)
                 a :: a
a = forall a. TextZipper a -> Int -> a -> a
take_ TextZipper a
tz Int
1 a
lastTwo
                 b :: a
b = forall a. TextZipper a -> Int -> a -> a
drop_ TextZipper a
tz Int
1 a
lastTwo
             in TextZipper a
tz { toLeft :: a
toLeft = a
prefix forall a. Semigroup a => a -> a -> a
<> a
b forall a. Semigroup a => a -> a -> a
<> a
a
                   }
    | Bool
otherwise = TextZipper a
tz { toLeft :: a
toLeft = (forall a. TextZipper a -> a -> a
init_ TextZipper a
tz forall a b. (a -> b) -> a -> b
$ forall a. TextZipper a -> a
toLeft TextZipper a
tz) forall a. Semigroup a => a -> a -> a
<>
                                (forall a. TextZipper a -> Int -> a -> a
take_ TextZipper a
tz Int
1 forall a b. (a -> b) -> a -> b
$ forall a. TextZipper a -> a
toRight TextZipper a
tz) forall a. Semigroup a => a -> a -> a
<>
                                (forall a. TextZipper a -> Char -> a
fromChar TextZipper a
tz forall a b. (a -> b) -> a -> b
$ forall a. TextZipper a -> a -> Char
last_ TextZipper a
tz forall a b. (a -> b) -> a -> b
$ forall a. TextZipper a -> a
toLeft TextZipper a
tz)
                     , toRight :: a
toRight = (forall a. TextZipper a -> Int -> a -> a
drop_ TextZipper a
tz Int
1 forall a b. (a -> b) -> a -> b
$ forall a. TextZipper a -> a
toRight TextZipper a
tz)
                     }

-- | Construct a zipper from list values.
stringZipper :: [String] -> Maybe Int -> TextZipper String
stringZipper :: [String] -> Maybe Int -> TextZipper String
stringZipper =
    forall a.
Monoid a =>
(Char -> a)
-> (Int -> a -> a)
-> (Int -> a -> a)
-> (a -> Int)
-> (a -> Char)
-> (a -> a)
-> (a -> Bool)
-> (a -> [a])
-> (a -> String)
-> [a]
-> Maybe Int
-> TextZipper a
mkZipper (forall a. a -> [a] -> [a]
:[]) forall a. Int -> [a] -> [a]
drop forall a. Int -> [a] -> [a]
take forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a. [a] -> a
last forall a. [a] -> [a]
init forall (t :: * -> *) a. Foldable t => t a -> Bool
null String -> [String]
lines forall a. a -> a
id

-- | Construct a zipper from vectors of characters.
vectorZipper :: [V.Vector Char] -> Maybe Int -> TextZipper (V.Vector Char)
vectorZipper :: [Vector Char] -> Maybe Int -> TextZipper (Vector Char)
vectorZipper =
    forall a.
Monoid a =>
(Char -> a)
-> (Int -> a -> a)
-> (Int -> a -> a)
-> (a -> Int)
-> (a -> Char)
-> (a -> a)
-> (a -> Bool)
-> (a -> [a])
-> (a -> String)
-> [a]
-> Maybe Int
-> TextZipper a
mkZipper forall a. a -> Vector a
V.singleton forall a. Int -> Vector a -> Vector a
V.drop forall a. Int -> Vector a -> Vector a
V.take forall a. Vector a -> Int
V.length forall a. Vector a -> a
V.last forall a. Vector a -> Vector a
V.init forall a. Vector a -> Bool
V.null Vector Char -> [Vector Char]
V.vecLines forall a. Vector a -> [a]
V.toList

-- | Empty a zipper.
clearZipper :: (Monoid a) => TextZipper a -> TextZipper a
clearZipper :: forall a. Monoid a => TextZipper a -> TextZipper a
clearZipper TextZipper a
tz =
    TextZipper a
tz { toLeft :: a
toLeft = forall a. Monoid a => a
mempty
       , toRight :: a
toRight = forall a. Monoid a => a
mempty
       , above :: [a]
above = []
       , below :: [a]
below = []
       }

-- | Construct a zipper from 'T.Text' values.
textZipper :: [T.Text] -> Maybe Int -> TextZipper T.Text
textZipper :: [Text] -> Maybe Int -> TextZipper Text
textZipper =
    forall a.
Monoid a =>
(Char -> a)
-> (Int -> a -> a)
-> (Int -> a -> a)
-> (a -> Int)
-> (a -> Char)
-> (a -> a)
-> (a -> Bool)
-> (a -> [a])
-> (a -> String)
-> [a]
-> Maybe Int
-> TextZipper a
mkZipper Char -> Text
T.singleton Int -> Text -> Text
T.drop Int -> Text -> Text
T.take Text -> Int
T.length Text -> Char
T.last Text -> Text
T.init Text -> Bool
T.null Text -> [Text]
T.lines Text -> String
T.unpack