{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Jet (run) where

import Control.Category ((>>>))
import Control.Comonad (extract)
import qualified Control.Comonad as Comonad
import Control.Comonad.Cofree
import qualified Control.Comonad.Trans.Cofree as CofreeF
import Control.Lens hiding ((:<))
import qualified Control.Lens.Cons as Cons
import Control.Monad.State
import Control.Monad.Trans.Maybe (MaybeT (MaybeT, runMaybeT))
import Data.Aeson (Value)
import qualified Data.Aeson as Aeson
import Data.Aeson.Encode.Pretty (encodePretty)
import Data.Aeson.Extra
import qualified Data.ByteString.Lazy.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as LBS
import Data.Functor.Classes (Eq1 (..), Ord1 (liftCompare))
import qualified Data.Functor.Foldable as FF
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HM
import qualified Data.HashMap.Strict as HashMap
import Data.Hashable (Hashable)
import qualified Data.List as List
import Data.Maybe
import Data.Sequence (Seq)
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Text.Zipper as TZ
import Data.Vector (Vector)
import qualified Data.Vector as Vector
import qualified Graphics.Vty as Vty
import Graphics.Vty.Input.Events
import qualified Jet.Render as Render
import Prettyprinter as P
import System.Environment (getArgs)
import System.Exit (exitFailure)
import System.Hclip
import System.IO (IOMode (ReadWriteMode), openFile)
import qualified System.IO as IO
import qualified System.Posix as Posix
import Text.Read (readMaybe)
import qualified Zipper.Recursive as Z

tabSize :: Int
tabSize :: Int
tabSize = Int
2

maxUndoStates :: Int
maxUndoStates :: Int
maxUndoStates = Int
100

hoistMaybe :: Maybe a -> MaybeT Editor a
hoistMaybe :: Maybe a -> MaybeT Editor a
hoistMaybe = Editor (Maybe a) -> MaybeT Editor a
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Editor (Maybe a) -> MaybeT Editor a)
-> (Maybe a -> Editor (Maybe a)) -> Maybe a -> MaybeT Editor a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe a -> Editor (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure

data EditorState = EditorState
  { EditorState -> UndoZipper (Zipper JIndex ValueF FocusState)
_undo :: UndoZipper (Z.Zipper JIndex ValueF FocusState),
    EditorState -> Mode
_mode :: Mode,
    EditorState -> ValueF (Cofree ValueF FocusState)
_register :: ValueF (Cofree ValueF FocusState),
    EditorState -> Vty
_vty :: Vty.Vty,
    EditorState -> Text
_flash :: Text,
    EditorState -> Zipper JIndex ValueF FocusState -> Editor ()
_save :: Z.Zipper JIndex ValueF FocusState -> Editor ()
  }

newtype Editor a = Editor {Editor a -> StateT EditorState IO a
runEditor :: StateT EditorState IO a}
  deriving newtype (a -> Editor b -> Editor a
(a -> b) -> Editor a -> Editor b
(forall a b. (a -> b) -> Editor a -> Editor b)
-> (forall a b. a -> Editor b -> Editor a) -> Functor Editor
forall a b. a -> Editor b -> Editor a
forall a b. (a -> b) -> Editor a -> Editor b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Editor b -> Editor a
$c<$ :: forall a b. a -> Editor b -> Editor a
fmap :: (a -> b) -> Editor a -> Editor b
$cfmap :: forall a b. (a -> b) -> Editor a -> Editor b
Functor, Functor Editor
a -> Editor a
Functor Editor
-> (forall a. a -> Editor a)
-> (forall a b. Editor (a -> b) -> Editor a -> Editor b)
-> (forall a b c.
    (a -> b -> c) -> Editor a -> Editor b -> Editor c)
-> (forall a b. Editor a -> Editor b -> Editor b)
-> (forall a b. Editor a -> Editor b -> Editor a)
-> Applicative Editor
Editor a -> Editor b -> Editor b
Editor a -> Editor b -> Editor a
Editor (a -> b) -> Editor a -> Editor b
(a -> b -> c) -> Editor a -> Editor b -> Editor c
forall a. a -> Editor a
forall a b. Editor a -> Editor b -> Editor a
forall a b. Editor a -> Editor b -> Editor b
forall a b. Editor (a -> b) -> Editor a -> Editor b
forall a b c. (a -> b -> c) -> Editor a -> Editor b -> Editor c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Editor a -> Editor b -> Editor a
$c<* :: forall a b. Editor a -> Editor b -> Editor a
*> :: Editor a -> Editor b -> Editor b
$c*> :: forall a b. Editor a -> Editor b -> Editor b
liftA2 :: (a -> b -> c) -> Editor a -> Editor b -> Editor c
$cliftA2 :: forall a b c. (a -> b -> c) -> Editor a -> Editor b -> Editor c
<*> :: Editor (a -> b) -> Editor a -> Editor b
$c<*> :: forall a b. Editor (a -> b) -> Editor a -> Editor b
pure :: a -> Editor a
$cpure :: forall a. a -> Editor a
$cp1Applicative :: Functor Editor
Applicative, Applicative Editor
a -> Editor a
Applicative Editor
-> (forall a b. Editor a -> (a -> Editor b) -> Editor b)
-> (forall a b. Editor a -> Editor b -> Editor b)
-> (forall a. a -> Editor a)
-> Monad Editor
Editor a -> (a -> Editor b) -> Editor b
Editor a -> Editor b -> Editor b
forall a. a -> Editor a
forall a b. Editor a -> Editor b -> Editor b
forall a b. Editor a -> (a -> Editor b) -> Editor b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Editor a
$creturn :: forall a. a -> Editor a
>> :: Editor a -> Editor b -> Editor b
$c>> :: forall a b. Editor a -> Editor b -> Editor b
>>= :: Editor a -> (a -> Editor b) -> Editor b
$c>>= :: forall a b. Editor a -> (a -> Editor b) -> Editor b
$cp1Monad :: Applicative Editor
Monad, MonadState EditorState, Monad Editor
Monad Editor -> (forall a. IO a -> Editor a) -> MonadIO Editor
IO a -> Editor a
forall a. IO a -> Editor a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> Editor a
$cliftIO :: forall a. IO a -> Editor a
$cp1MonadIO :: Monad Editor
MonadIO)

mode_ :: Lens' EditorState Mode
mode_ :: (Mode -> f Mode) -> EditorState -> f EditorState
mode_ = (EditorState -> Mode)
-> (EditorState -> Mode -> EditorState)
-> Lens EditorState EditorState Mode Mode
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens EditorState -> Mode
_mode (\EditorState
s Mode
m -> EditorState
s {_mode :: Mode
_mode = Mode
m})

register_ :: Lens' EditorState (ValueF (Cofree ValueF FocusState))
register_ :: (ValueF (Cofree ValueF FocusState)
 -> f (ValueF (Cofree ValueF FocusState)))
-> EditorState -> f EditorState
register_ = (EditorState -> ValueF (Cofree ValueF FocusState))
-> (EditorState
    -> ValueF (Cofree ValueF FocusState) -> EditorState)
-> Lens
     EditorState
     EditorState
     (ValueF (Cofree ValueF FocusState))
     (ValueF (Cofree ValueF FocusState))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens EditorState -> ValueF (Cofree ValueF FocusState)
_register (\EditorState
s ValueF (Cofree ValueF FocusState)
m -> EditorState
s {_register :: ValueF (Cofree ValueF FocusState)
_register = ValueF (Cofree ValueF FocusState)
m})

undo_ :: Lens' EditorState (UndoZipper (Z.Zipper JIndex ValueF FocusState))
undo_ :: (UndoZipper (Zipper JIndex ValueF FocusState)
 -> f (UndoZipper (Zipper JIndex ValueF FocusState)))
-> EditorState -> f EditorState
undo_ = (EditorState -> UndoZipper (Zipper JIndex ValueF FocusState))
-> (EditorState
    -> UndoZipper (Zipper JIndex ValueF FocusState) -> EditorState)
-> Lens
     EditorState
     EditorState
     (UndoZipper (Zipper JIndex ValueF FocusState))
     (UndoZipper (Zipper JIndex ValueF FocusState))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens EditorState -> UndoZipper (Zipper JIndex ValueF FocusState)
_undo (\EditorState
s UndoZipper (Zipper JIndex ValueF FocusState)
m -> EditorState
s {_undo :: UndoZipper (Zipper JIndex ValueF FocusState)
_undo = UndoZipper (Zipper JIndex ValueF FocusState)
m})

vty_ :: Lens' EditorState Vty.Vty
vty_ :: (Vty -> f Vty) -> EditorState -> f EditorState
vty_ = (EditorState -> Vty)
-> (EditorState -> Vty -> EditorState)
-> Lens EditorState EditorState Vty Vty
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens EditorState -> Vty
_vty (\EditorState
s Vty
m -> EditorState
s {_vty :: Vty
_vty = Vty
m})

flash_ :: Lens' EditorState Text
flash_ :: (Text -> f Text) -> EditorState -> f EditorState
flash_ = (EditorState -> Text)
-> (EditorState -> Text -> EditorState)
-> Lens EditorState EditorState Text Text
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens EditorState -> Text
_flash (\EditorState
s Text
m -> EditorState
s {_flash :: Text
_flash = Text
m})

save_ :: Lens' EditorState (Z.Zipper JIndex ValueF FocusState -> Editor ())
save_ :: ((Zipper JIndex ValueF FocusState -> Editor ())
 -> f (Zipper JIndex ValueF FocusState -> Editor ()))
-> EditorState -> f EditorState
save_ = (EditorState -> Zipper JIndex ValueF FocusState -> Editor ())
-> (EditorState
    -> (Zipper JIndex ValueF FocusState -> Editor ()) -> EditorState)
-> Lens
     EditorState
     EditorState
     (Zipper JIndex ValueF FocusState -> Editor ())
     (Zipper JIndex ValueF FocusState -> Editor ())
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens EditorState -> Zipper JIndex ValueF FocusState -> Editor ()
_save (\EditorState
s Zipper JIndex ValueF FocusState -> Editor ()
m -> EditorState
s {_save :: Zipper JIndex ValueF FocusState -> Editor ()
_save = Zipper JIndex ValueF FocusState -> Editor ()
m})

recover :: a -> MaybeT Editor a -> Editor a
recover :: a -> MaybeT Editor a -> Editor a
recover a
def MaybeT Editor a
m = do
  let e :: Editor (Maybe a)
e = MaybeT Editor a -> Editor (Maybe a)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT MaybeT Editor a
m
  EditorState
s <- Editor EditorState
forall s (m :: * -> *). MonadState s m => m s
get
  (Maybe a, EditorState)
r <- IO (Maybe a, EditorState) -> Editor (Maybe a, EditorState)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe a, EditorState) -> Editor (Maybe a, EditorState))
-> IO (Maybe a, EditorState) -> Editor (Maybe a, EditorState)
forall a b. (a -> b) -> a -> b
$ (StateT EditorState IO (Maybe a)
 -> EditorState -> IO (Maybe a, EditorState))
-> EditorState
-> StateT EditorState IO (Maybe a)
-> IO (Maybe a, EditorState)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT EditorState IO (Maybe a)
-> EditorState -> IO (Maybe a, EditorState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT EditorState
s (StateT EditorState IO (Maybe a) -> IO (Maybe a, EditorState))
-> (Editor (Maybe a) -> StateT EditorState IO (Maybe a))
-> Editor (Maybe a)
-> IO (Maybe a, EditorState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Editor (Maybe a) -> StateT EditorState IO (Maybe a)
forall a. Editor a -> StateT EditorState IO a
runEditor (Editor (Maybe a) -> IO (Maybe a, EditorState))
-> Editor (Maybe a) -> IO (Maybe a, EditorState)
forall a b. (a -> b) -> a -> b
$ Editor (Maybe a)
e
  case (Maybe a, EditorState)
r of
    (Just a
a, EditorState
newS) -> EditorState -> Editor ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put EditorState
newS Editor () -> Editor a -> Editor a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> a -> Editor a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
    (Maybe a
Nothing, EditorState
_) -> a -> Editor a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
def

data Focused = Focused | NotFocused
  deriving (Focused -> Focused -> Bool
(Focused -> Focused -> Bool)
-> (Focused -> Focused -> Bool) -> Eq Focused
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Focused -> Focused -> Bool
$c/= :: Focused -> Focused -> Bool
== :: Focused -> Focused -> Bool
$c== :: Focused -> Focused -> Bool
Eq)

data Folded = Folded | NotFolded
  deriving (Folded -> Folded -> Bool
(Folded -> Folded -> Bool)
-> (Folded -> Folded -> Bool) -> Eq Folded
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Folded -> Folded -> Bool
$c/= :: Folded -> Folded -> Bool
== :: Folded -> Folded -> Bool
$c== :: Folded -> Folded -> Bool
Eq)

type PrettyJSON = Doc (Either Render.Cursor Vty.Attr)

type Buffer = TZ.TextZipper Text

-- | Nodes are annotated with one of these.
-- This includes information about the node itself, but also
-- a cached render of the node, which allows us to re-render
-- the whole tree much faster.
data FocusState = FocusState
  { FocusState -> Focused
isFocused :: Focused,
    FocusState -> Folded
isFolded :: Folded,
    FocusState -> PrettyJSON
rendered :: PrettyJSON
  }

instance Eq FocusState where
  FocusState
a == :: FocusState -> FocusState -> Bool
== FocusState
b =
    FocusState -> Focused
isFocused FocusState
a Focused -> Focused -> Bool
forall a. Eq a => a -> a -> Bool
== FocusState -> Focused
isFocused FocusState
b
      Bool -> Bool -> Bool
&& FocusState -> Folded
isFolded FocusState
a Folded -> Folded -> Bool
forall a. Eq a => a -> a -> Bool
== FocusState -> Folded
isFolded FocusState
b

focused_ :: Lens' FocusState Focused
focused_ :: (Focused -> f Focused) -> FocusState -> f FocusState
focused_ = (FocusState -> Focused)
-> (FocusState -> Focused -> FocusState)
-> Lens FocusState FocusState Focused Focused
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens FocusState -> Focused
isFocused (\FocusState
fs Focused
new -> FocusState
fs {isFocused :: Focused
isFocused = Focused
new})

folded_ :: Lens' FocusState Folded
folded_ :: (Folded -> f Folded) -> FocusState -> f FocusState
folded_ = (FocusState -> Folded)
-> (FocusState -> Folded -> FocusState)
-> Lens FocusState FocusState Folded Folded
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens FocusState -> Folded
isFolded (\FocusState
fs Folded
new -> FocusState
fs {isFolded :: Folded
isFolded = Folded
new})

toggleFold :: Folded -> Folded
toggleFold :: Folded -> Folded
toggleFold Folded
Folded = Folded
NotFolded
toggleFold Folded
NotFolded = Folded
Folded

run :: IO ()
run :: IO ()
run = do
  (Value
json, Maybe String
srcFile) <-
    IO [String]
getArgs IO [String]
-> ([String] -> IO (Value, Maybe String))
-> IO (Value, Maybe String)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      [] -> do
        Value
json <-
          (ByteString -> Either String Value
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecode (ByteString -> Either String Value)
-> (String -> ByteString) -> String -> Either String Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS.pack (String -> Either String Value)
-> IO String -> IO (Either String Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO String
getContents) IO (Either String Value)
-> (Either String Value -> IO Value) -> IO Value
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Left String
err -> do
              Handle -> String -> IO ()
IO.hPutStrLn Handle
IO.stderr String
err
              IO Value
forall a. IO a
exitFailure
            Right Value
json -> Value -> IO Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
json
        pure (Value
json, Maybe String
forall a. Maybe a
Nothing)
      [String
f] -> do
        Value
json <-
          String -> IO (Either String Value)
forall a. FromJSON a => String -> IO (Either String a)
Aeson.eitherDecodeFileStrict String
f IO (Either String Value)
-> (Either String Value -> IO Value) -> IO Value
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Left String
err -> do
              Handle -> String -> IO ()
IO.hPutStrLn Handle
IO.stderr String
err
              IO Value
forall a. IO a
exitFailure
            Right Value
json -> Value -> IO Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
json
        pure (Value
json, String -> Maybe String
forall a. a -> Maybe a
Just String
f)
      [String]
_ -> Handle -> String -> IO ()
IO.hPutStrLn Handle
IO.stderr String
"usage: structural-json FILE.json" IO () -> IO (Value, Maybe String) -> IO (Value, Maybe String)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> IO (Value, Maybe String)
forall a. IO a
exitFailure
  Value
result <- Maybe String -> Value -> IO Value
edit Maybe String
srcFile (Value -> IO Value) -> Value -> IO Value
forall a b. (a -> b) -> a -> b
$ Value
json
  ByteString -> IO ()
BS.putStrLn (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Value -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty Value
result

edit :: Maybe FilePath -> Value -> IO Value
edit :: Maybe String -> Value -> IO Value
edit Maybe String
srcFile Value
value = do
  -- Use tty so we don't interfere with stdin/stdout
  Fd
tty <- String -> IOMode -> IO Handle
openFile String
"/dev/tty" IOMode
ReadWriteMode IO Handle -> (Handle -> IO Fd) -> IO Fd
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Handle -> IO Fd
Posix.handleToFd
  Config
config <- IO Config -> IO Config
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Config -> IO Config) -> IO Config -> IO Config
forall a b. (a -> b) -> a -> b
$ IO Config
Vty.standardIOConfig
  Vty
vty <- (IO Vty -> IO Vty
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Vty -> IO Vty) -> IO Vty -> IO Vty
forall a b. (a -> b) -> a -> b
$ Config -> IO Vty
Vty.mkVty Config
config {inputFd :: Maybe Fd
Vty.inputFd = Fd -> Maybe Fd
forall a. a -> Maybe a
Just Fd
tty, outputFd :: Maybe Fd
Vty.outputFd = Fd -> Maybe Fd
forall a. a -> Maybe a
Just Fd
tty})
  -- load the value into a zipper.
  let z :: Zipper JIndex ValueF FocusState
z = Cofree ValueF FocusState -> Zipper JIndex ValueF FocusState
forall (f :: * -> *) a i. Cofree f a -> Zipper i f a
Z.zipper (Cofree ValueF FocusState -> Zipper JIndex ValueF FocusState)
-> (Value -> Cofree ValueF FocusState)
-> Value
-> Zipper JIndex ValueF FocusState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Cofree ValueF FocusState
toCofree (Value -> Zipper JIndex ValueF FocusState)
-> Value -> Zipper JIndex ValueF FocusState
forall a b. (a -> b) -> a -> b
$ Value
value
  Zipper JIndex ValueF FocusState
v <- (StateT EditorState IO (Zipper JIndex ValueF FocusState)
 -> EditorState -> IO (Zipper JIndex ValueF FocusState))
-> EditorState
-> StateT EditorState IO (Zipper JIndex ValueF FocusState)
-> IO (Zipper JIndex ValueF FocusState)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT EditorState IO (Zipper JIndex ValueF FocusState)
-> EditorState -> IO (Zipper JIndex ValueF FocusState)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (Maybe String -> Vty -> EditorState
editorState Maybe String
srcFile Vty
vty) (StateT EditorState IO (Zipper JIndex ValueF FocusState)
 -> IO (Zipper JIndex ValueF FocusState))
-> (Editor (Zipper JIndex ValueF FocusState)
    -> StateT EditorState IO (Zipper JIndex ValueF FocusState))
-> Editor (Zipper JIndex ValueF FocusState)
-> IO (Zipper JIndex ValueF FocusState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Editor (Zipper JIndex ValueF FocusState)
-> StateT EditorState IO (Zipper JIndex ValueF FocusState)
forall a. Editor a -> StateT EditorState IO a
runEditor (Editor (Zipper JIndex ValueF FocusState)
 -> IO (Zipper JIndex ValueF FocusState))
-> Editor (Zipper JIndex ValueF FocusState)
-> IO (Zipper JIndex ValueF FocusState)
forall a b. (a -> b) -> a -> b
$ Zipper JIndex ValueF FocusState
-> Editor (Zipper JIndex ValueF FocusState)
loop Zipper JIndex ValueF FocusState
z
  Vty -> IO ()
Vty.shutdown Vty
vty
  pure (Zipper JIndex (Base Value) FocusState -> Value
forall f i a.
(Corecursive f, Idx i (Base f) a) =>
Zipper i (Base f) a -> f
Z.flatten Zipper JIndex ValueF FocusState
Zipper JIndex (Base Value) FocusState
v)

loop ::
  Z.Zipper JIndex ValueF FocusState ->
  Editor (Z.Zipper JIndex ValueF FocusState)
loop :: Zipper JIndex ValueF FocusState
-> Editor (Zipper JIndex ValueF FocusState)
loop Zipper JIndex ValueF FocusState
z = do
  Vty
vty <- Getting Vty EditorState Vty -> Editor Vty
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Vty EditorState Vty
Lens EditorState EditorState Vty Vty
vty_
  Zipper JIndex ValueF FocusState -> Editor ()
renderScreen Zipper JIndex ValueF FocusState
z
  (Text -> Identity Text) -> EditorState -> Identity EditorState
Lens EditorState EditorState Text Text
flash_ ((Text -> Identity Text) -> EditorState -> Identity EditorState)
-> Text -> Editor ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Text
""
  Event
e <- IO Event -> Editor Event
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Event -> Editor Event) -> IO Event -> Editor Event
forall a b. (a -> b) -> a -> b
$ Vty -> IO Event
Vty.nextEvent Vty
vty
  Zipper JIndex ValueF FocusState
nextZ <- Event
-> Zipper JIndex ValueF FocusState
-> Editor (Zipper JIndex ValueF FocusState)
handleEvent Event
e Zipper JIndex ValueF FocusState
z
  if (Event -> Bool
shouldExit Event
e)
    then Zipper JIndex ValueF FocusState
-> Editor (Zipper JIndex ValueF FocusState)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Zipper JIndex ValueF FocusState
nextZ
    else (Zipper JIndex ValueF FocusState
-> Editor (Zipper JIndex ValueF FocusState)
loop Zipper JIndex ValueF FocusState
nextZ)

renderScreen :: Z.Zipper JIndex ValueF FocusState -> Editor ()
renderScreen :: Zipper JIndex ValueF FocusState -> Editor ()
renderScreen Zipper JIndex ValueF FocusState
z = do
  Vty
vty <- Getting Vty EditorState Vty -> Editor Vty
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Vty EditorState Vty
Lens EditorState EditorState Vty Vty
vty_
  (Int
winWidth, Int
winHeight) <- Editor (Int, Int)
bounds
  PrettyJSON
rendered <- LensLike' (Const PrettyJSON) EditorState Mode
-> (Mode -> PrettyJSON) -> Editor PrettyJSON
forall s (m :: * -> *) r a.
MonadState s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
uses LensLike' (Const PrettyJSON) EditorState Mode
Lens EditorState EditorState Mode Mode
mode_ (\Mode
m -> Mode -> Zipper JIndex ValueF FocusState -> PrettyJSON
fullRender Mode
m Zipper JIndex ValueF FocusState
z)
  Image
footer <- Editor Image
footerImg
  let screen :: Image
screen = [Image] -> Image
Vty.vertCat ([Image] -> Image)
-> (PrettyJSON -> [Image]) -> PrettyJSON -> Image
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> SimpleDocStream (Either Cursor Attr) -> [Image]
Render.renderScreen (Int
winHeight Int -> Int -> Int
forall a. Num a => a -> a -> a
- Image -> Int
Vty.imageHeight Image
footer) (SimpleDocStream (Either Cursor Attr) -> [Image])
-> (PrettyJSON -> SimpleDocStream (Either Cursor Attr))
-> PrettyJSON
-> [Image]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutOptions -> PrettyJSON -> SimpleDocStream (Either Cursor Attr)
forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutPretty LayoutOptions
defaultLayoutOptions (PrettyJSON -> Image) -> PrettyJSON -> Image
forall a b. (a -> b) -> a -> b
$ PrettyJSON
rendered
  let spacerHeight :: Int
spacerHeight = Int
winHeight Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Image -> Int
Vty.imageHeight Image
screen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Image -> Int
Vty.imageHeight Image
footer)
  let spacers :: Image
spacers = Attr -> Char -> Int -> Int -> Image
forall d. Integral d => Attr -> Char -> d -> d -> Image
Vty.charFill Attr
Vty.defAttr Char
' ' Int
winWidth Int
spacerHeight
  IO () -> Editor ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Editor ()) -> IO () -> Editor ()
forall a b. (a -> b) -> a -> b
$ Vty -> Picture -> IO ()
Vty.update Vty
vty (Image -> Picture
Vty.picForImage (Image
screen Image -> Image -> Image
Vty.<-> Image
spacers Image -> Image -> Image
Vty.<-> Image
footer))

-- | Get the current bounds of the current terminal screen.
bounds :: Editor (Int, Int)
bounds :: Editor (Int, Int)
bounds = Getting Vty EditorState Vty -> Editor Vty
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Vty EditorState Vty
Lens EditorState EditorState Vty Vty
vty_ Editor Vty -> (Vty -> Editor (Int, Int)) -> Editor (Int, Int)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO (Int, Int) -> Editor (Int, Int)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Int, Int) -> Editor (Int, Int))
-> (Vty -> IO (Int, Int)) -> Vty -> Editor (Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Output -> IO (Int, Int)
Vty.displayBounds (Output -> IO (Int, Int))
-> (Vty -> Output) -> Vty -> IO (Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vty -> Output
Vty.outputIface

-- | Render the footer bar to an image
footerImg :: Editor Vty.Image
footerImg :: Editor Image
footerImg = do
  (Int
w, Int
_) <- Editor (Int, Int)
bounds
  Text
flash <- (EditorState -> Text) -> Editor Text
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EditorState -> Text
_flash
  let attr :: Attr
attr = (Attr
Vty.defAttr Attr -> Color -> Attr
`Vty.withForeColor` Color
Vty.green Attr -> Style -> Attr
`Vty.withStyle` Style
Vty.reverseVideo)
      helpMsg :: Image
helpMsg = Attr -> Text -> Image
Vty.text' Attr
attr Text
"| Press '?' for help"
      flashMsg :: Image
flashMsg = Attr -> Text -> Image
Vty.text' (Attr
attr Attr -> Style -> Attr
`Vty.withStyle` Style
Vty.bold) (Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
flash)
  Image -> Editor Image
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Image -> Editor Image) -> Image -> Editor Image
forall a b. (a -> b) -> a -> b
$
    [Image] -> Image
Vty.horizCat
      [ Image
flashMsg,
        Attr -> Char -> Int -> Int -> Image
forall d. Integral d => Attr -> Char -> d -> d -> Image
Vty.charFill Attr
attr Char
' ' (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Image -> Int
Vty.imageWidth Image
helpMsg Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Image -> Int
Vty.imageWidth Image
flashMsg)) Int
1,
        Image
helpMsg
      ]

-- | Push the given zipper onto history iff it's distinct from the most recent undo state.
pushUndo :: Z.Zipper JIndex ValueF FocusState -> Editor ()
pushUndo :: Zipper JIndex ValueF FocusState -> Editor ()
pushUndo Zipper JIndex ValueF FocusState
z =
  (UndoZipper (Zipper JIndex ValueF FocusState)
 -> Identity (UndoZipper (Zipper JIndex ValueF FocusState)))
-> EditorState -> Identity EditorState
Lens
  EditorState
  EditorState
  (UndoZipper (Zipper JIndex ValueF FocusState))
  (UndoZipper (Zipper JIndex ValueF FocusState))
undo_ ((UndoZipper (Zipper JIndex ValueF FocusState)
  -> Identity (UndoZipper (Zipper JIndex ValueF FocusState)))
 -> EditorState -> Identity EditorState)
-> (UndoZipper (Zipper JIndex ValueF FocusState)
    -> UndoZipper (Zipper JIndex ValueF FocusState))
-> Editor ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= \case
    (UndoZipper (Seq (Zipper JIndex ValueF FocusState)
ls Cons.:> Zipper JIndex ValueF FocusState
_) Seq (Zipper JIndex ValueF FocusState)
_) | Seq (Zipper JIndex ValueF FocusState) -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq (Zipper JIndex ValueF FocusState)
ls Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
maxUndoStates -> Seq (Zipper JIndex ValueF FocusState)
-> Seq (Zipper JIndex ValueF FocusState)
-> UndoZipper (Zipper JIndex ValueF FocusState)
forall a. Seq a -> Seq a -> UndoZipper a
UndoZipper (Zipper JIndex ValueF FocusState
z Zipper JIndex ValueF FocusState
-> Seq (Zipper JIndex ValueF FocusState)
-> Seq (Zipper JIndex ValueF FocusState)
forall s a. Cons s s a a => a -> s -> s
<| Seq (Zipper JIndex ValueF FocusState)
ls) Seq (Zipper JIndex ValueF FocusState)
forall s. AsEmpty s => s
Empty
    (UndoZipper Seq (Zipper JIndex ValueF FocusState)
ls Seq (Zipper JIndex ValueF FocusState)
_) -> Seq (Zipper JIndex ValueF FocusState)
-> Seq (Zipper JIndex ValueF FocusState)
-> UndoZipper (Zipper JIndex ValueF FocusState)
forall a. Seq a -> Seq a -> UndoZipper a
UndoZipper (Zipper JIndex ValueF FocusState
z Zipper JIndex ValueF FocusState
-> Seq (Zipper JIndex ValueF FocusState)
-> Seq (Zipper JIndex ValueF FocusState)
forall s a. Cons s s a a => a -> s -> s
<| Seq (Zipper JIndex ValueF FocusState)
ls) Seq (Zipper JIndex ValueF FocusState)
forall s. AsEmpty s => s
Empty

editorState :: Maybe FilePath -> Vty.Vty -> EditorState
editorState :: Maybe String -> Vty -> EditorState
editorState Maybe String
srcFile Vty
vty =
  EditorState :: UndoZipper (Zipper JIndex ValueF FocusState)
-> Mode
-> ValueF (Cofree ValueF FocusState)
-> Vty
-> Text
-> (Zipper JIndex ValueF FocusState -> Editor ())
-> EditorState
EditorState
    { _undo :: UndoZipper (Zipper JIndex ValueF FocusState)
_undo = Seq (Zipper JIndex ValueF FocusState)
-> Seq (Zipper JIndex ValueF FocusState)
-> UndoZipper (Zipper JIndex ValueF FocusState)
forall a. Seq a -> Seq a -> UndoZipper a
UndoZipper Seq (Zipper JIndex ValueF FocusState)
forall s. AsEmpty s => s
Empty Seq (Zipper JIndex ValueF FocusState)
forall s. AsEmpty s => s
Empty,
      _mode :: Mode
_mode = Mode
Move,
      _register :: ValueF (Cofree ValueF FocusState)
_register = ValueF (Cofree ValueF FocusState)
forall a. ValueF a
NullF,
      _vty :: Vty
_vty = Vty
vty,
      _flash :: Text
_flash = Text
"Hello World",
      _save :: Zipper JIndex ValueF FocusState -> Editor ()
_save = Zipper JIndex ValueF FocusState -> Editor ()
saveFile
    }
  where
    saveFile :: Zipper JIndex ValueF FocusState -> Editor ()
saveFile = case Maybe String
srcFile of
      Maybe String
Nothing -> Editor () -> Zipper JIndex ValueF FocusState -> Editor ()
forall a b. a -> b -> a
const (() -> Editor ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
      Just String
fp -> \Zipper JIndex ValueF FocusState
z -> do
        IO () -> Editor ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Editor ()) -> IO () -> Editor ()
forall a b. (a -> b) -> a -> b
$ String -> ByteString -> IO ()
BS.writeFile String
fp (Zipper JIndex ValueF FocusState
z Zipper JIndex ValueF FocusState
-> (Zipper JIndex ValueF FocusState -> Value) -> Value
forall a b. a -> (a -> b) -> b
& Zipper JIndex ValueF FocusState -> Value
forall f i a.
(Corecursive f, Idx i (Base f) a) =>
Zipper i (Base f) a -> f
Z.flatten Value -> (Value -> ByteString) -> ByteString
forall a b. a -> (a -> b) -> b
& ToJSON Value => Value -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty @Value)
        (Text -> Identity Text) -> EditorState -> Identity EditorState
Lens EditorState EditorState Text Text
flash_ ((Text -> Identity Text) -> EditorState -> Identity EditorState)
-> Text -> Editor ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Text
"Saved to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack String
fp

shouldExit :: Vty.Event -> Bool
shouldExit :: Event -> Bool
shouldExit = \case
  EvKey (KChar Char
'c') [Modifier
Vty.MCtrl] -> Bool
True
  EvKey (KChar Char
'q') [] -> Bool
True
  Event
_ -> Bool
False

bufferText :: Buffer -> Text
bufferText :: Buffer -> Text
bufferText = [Text] -> Text
Text.concat ([Text] -> Text) -> (Buffer -> [Text]) -> Buffer -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Buffer -> [Text]
forall a. Monoid a => TextZipper a -> [a]
TZ.getText

-- | Apply the state that's in the current mode's buffer to the selected node if possible.
applyBuf :: Z.Zipper JIndex ValueF FocusState -> Editor (Z.Zipper JIndex ValueF FocusState)
applyBuf :: Zipper JIndex ValueF FocusState
-> Editor (Zipper JIndex ValueF FocusState)
applyBuf Zipper JIndex ValueF FocusState
z = do
  Getting Mode EditorState Mode -> Editor Mode
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Mode EditorState Mode
Lens EditorState EditorState Mode Mode
mode_ Editor Mode
-> (Mode -> Editor (Zipper JIndex ValueF FocusState))
-> Editor (Zipper JIndex ValueF FocusState)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Edit Buffer
buf -> do
      let txt :: Text
txt = Buffer
buf Buffer -> Getting Text Buffer Text -> Text
forall s a. s -> Getting a s a -> a
^. (Buffer -> Text) -> Getting Text Buffer Text
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Buffer -> Text
bufferText
      (Mode -> Identity Mode) -> EditorState -> Identity EditorState
Lens EditorState EditorState Mode Mode
mode_ ((Mode -> Identity Mode) -> EditorState -> Identity EditorState)
-> Mode -> Editor ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Mode
Move
      pure
        ( Zipper JIndex ValueF FocusState
z Zipper JIndex ValueF FocusState
-> (Zipper JIndex ValueF FocusState
    -> Zipper JIndex ValueF FocusState)
-> Zipper JIndex ValueF FocusState
forall a b. a -> (a -> b) -> b
& (Cofree ValueF FocusState -> Identity (Cofree ValueF FocusState))
-> Zipper JIndex ValueF FocusState
-> Identity (Zipper JIndex ValueF FocusState)
forall i (f :: * -> *) a. Lens' (Zipper i f a) (Cofree f a)
Z.unwrapped_ ((Cofree ValueF FocusState -> Identity (Cofree ValueF FocusState))
 -> Zipper JIndex ValueF FocusState
 -> Identity (Zipper JIndex ValueF FocusState))
-> ((ValueF (Cofree ValueF FocusState)
     -> Identity (ValueF (Cofree ValueF FocusState)))
    -> Cofree ValueF FocusState -> Identity (Cofree ValueF FocusState))
-> (ValueF (Cofree ValueF FocusState)
    -> Identity (ValueF (Cofree ValueF FocusState)))
-> Zipper JIndex ValueF FocusState
-> Identity (Zipper JIndex ValueF FocusState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ValueF (Cofree ValueF FocusState)
 -> Identity (ValueF (Cofree ValueF FocusState)))
-> Cofree ValueF FocusState -> Identity (Cofree ValueF FocusState)
forall (f :: * -> *) (g :: * -> *) a.
Functor f =>
(g (Cofree g a) -> f (g (Cofree g a)))
-> Cofree g a -> f (Cofree g a)
_unwrap
            ((ValueF (Cofree ValueF FocusState)
  -> Identity (ValueF (Cofree ValueF FocusState)))
 -> Zipper JIndex ValueF FocusState
 -> Identity (Zipper JIndex ValueF FocusState))
-> (ValueF (Cofree ValueF FocusState)
    -> ValueF (Cofree ValueF FocusState))
-> Zipper JIndex ValueF FocusState
-> Zipper JIndex ValueF FocusState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ( \case
                   StringF Text
_ -> Text -> ValueF (Cofree ValueF FocusState)
forall a. Text -> ValueF a
StringF Text
txt
                   (NumberF Scientific
n) -> Scientific -> ValueF (Cofree ValueF FocusState)
forall a. Scientific -> ValueF a
NumberF (Scientific -> ValueF (Cofree ValueF FocusState))
-> (String -> Scientific)
-> String
-> ValueF (Cofree ValueF FocusState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> Maybe Scientific -> Scientific
forall a. a -> Maybe a -> a
fromMaybe Scientific
n (Maybe Scientific -> Scientific)
-> (String -> Maybe Scientific) -> String -> Scientific
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Scientific
forall a. Read a => String -> Maybe a
readMaybe (String -> ValueF (Cofree ValueF FocusState))
-> String -> ValueF (Cofree ValueF FocusState)
forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack Text
txt
                   ValueF (Cofree ValueF FocusState)
x -> ValueF (Cofree ValueF FocusState)
x
               )
        )
    KeyEdit Text
key Buffer
buf -> do
      let txt :: Text
txt = Buffer
buf Buffer -> Getting Text Buffer Text -> Text
forall s a. s -> Getting a s a -> a
^. (Buffer -> Text) -> Getting Text Buffer Text
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Buffer -> Text
bufferText
      (Mode -> Identity Mode) -> EditorState -> Identity EditorState
Lens EditorState EditorState Mode Mode
mode_ ((Mode -> Identity Mode) -> EditorState -> Identity EditorState)
-> Mode -> Editor ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= (Text -> Mode
KeyMove Text
txt)
      pure
        ( Zipper JIndex ValueF FocusState
z Zipper JIndex ValueF FocusState
-> (Zipper JIndex ValueF FocusState
    -> Zipper JIndex ValueF FocusState)
-> Zipper JIndex ValueF FocusState
forall a b. a -> (a -> b) -> b
& (Cofree ValueF FocusState -> Identity (Cofree ValueF FocusState))
-> Zipper JIndex ValueF FocusState
-> Identity (Zipper JIndex ValueF FocusState)
forall i (f :: * -> *) a. Lens' (Zipper i f a) (Cofree f a)
Z.unwrapped_ ((Cofree ValueF FocusState -> Identity (Cofree ValueF FocusState))
 -> Zipper JIndex ValueF FocusState
 -> Identity (Zipper JIndex ValueF FocusState))
-> ((ValueF (Cofree ValueF FocusState)
     -> Identity (ValueF (Cofree ValueF FocusState)))
    -> Cofree ValueF FocusState -> Identity (Cofree ValueF FocusState))
-> (ValueF (Cofree ValueF FocusState)
    -> Identity (ValueF (Cofree ValueF FocusState)))
-> Zipper JIndex ValueF FocusState
-> Identity (Zipper JIndex ValueF FocusState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ValueF (Cofree ValueF FocusState)
 -> Identity (ValueF (Cofree ValueF FocusState)))
-> Cofree ValueF FocusState -> Identity (Cofree ValueF FocusState)
forall (f :: * -> *) (g :: * -> *) a.
Functor f =>
(g (Cofree g a) -> f (g (Cofree g a)))
-> Cofree g a -> f (Cofree g a)
_unwrap
            ((ValueF (Cofree ValueF FocusState)
  -> Identity (ValueF (Cofree ValueF FocusState)))
 -> Zipper JIndex ValueF FocusState
 -> Identity (Zipper JIndex ValueF FocusState))
-> (ValueF (Cofree ValueF FocusState)
    -> ValueF (Cofree ValueF FocusState))
-> Zipper JIndex ValueF FocusState
-> Zipper JIndex ValueF FocusState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ( \case
                   (ObjectF ObjectF (Cofree ValueF FocusState)
hm) -> ObjectF (Cofree ValueF FocusState)
-> ValueF (Cofree ValueF FocusState)
forall a. ObjectF a -> ValueF a
ObjectF (ObjectF (Cofree ValueF FocusState)
 -> ValueF (Cofree ValueF FocusState))
-> ObjectF (Cofree ValueF FocusState)
-> ValueF (Cofree ValueF FocusState)
forall a b. (a -> b) -> a -> b
$ Text
-> Text
-> ObjectF (Cofree ValueF FocusState)
-> ObjectF (Cofree ValueF FocusState)
forall k v.
(Hashable k, Eq k) =>
k -> k -> HashMap k v -> HashMap k v
renameKey Text
key Text
txt ObjectF (Cofree ValueF FocusState)
hm
                   ValueF (Cofree ValueF FocusState)
x -> ValueF (Cofree ValueF FocusState)
x
               )
        )
    Mode
_ -> Zipper JIndex ValueF FocusState
-> Editor (Zipper JIndex ValueF FocusState)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Zipper JIndex ValueF FocusState
z

renameKey :: (Hashable k, Eq k) => k -> k -> HashMap k v -> HashMap k v
renameKey :: k -> k -> HashMap k v -> HashMap k v
renameKey k
srcKey k
destKey HashMap k v
hm =
  HashMap k v
hm
    HashMap k v -> State (HashMap k v) () -> HashMap k v
forall s a. s -> State s a -> s
&~ do
      Maybe v
v <- Getting (Maybe v) (HashMap k v) (Maybe v)
-> StateT (HashMap k v) Identity (Maybe v)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Index (HashMap k v)
-> Lens' (HashMap k v) (Maybe (IxValue (HashMap k v)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at k
Index (HashMap k v)
srcKey)
      Index (HashMap k v)
-> Lens' (HashMap k v) (Maybe (IxValue (HashMap k v)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at k
Index (HashMap k v)
srcKey ((Maybe v -> Identity (Maybe v))
 -> HashMap k v -> Identity (HashMap k v))
-> Maybe v -> State (HashMap k v) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe v
forall a. Maybe a
Nothing
      Index (HashMap k v)
-> Lens' (HashMap k v) (Maybe (IxValue (HashMap k v)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at k
Index (HashMap k v)
destKey ((Maybe v -> Identity (Maybe v))
 -> HashMap k v -> Identity (HashMap k v))
-> Maybe v -> State (HashMap k v) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe v
v

-- | Create a buffer using the text from the current value.
bufferForValueF :: ValueF x -> Maybe Buffer
bufferForValueF :: ValueF x -> Maybe Buffer
bufferForValueF = \case
  (ObjectF ObjectF x
_hm) -> Maybe Buffer
forall a. Maybe a
Nothing
  (ArrayF ArrayF x
_vec) -> Maybe Buffer
forall a. Maybe a
Nothing
  StringF Text
txt -> Buffer -> Maybe Buffer
forall a. a -> Maybe a
Just (Buffer -> Maybe Buffer) -> Buffer -> Maybe Buffer
forall a b. (a -> b) -> a -> b
$ Text -> Buffer
newBuffer Text
txt
  (NumberF Scientific
sci) ->
    Buffer -> Maybe Buffer
forall a. a -> Maybe a
Just (Buffer -> Maybe Buffer) -> Buffer -> Maybe Buffer
forall a b. (a -> b) -> a -> b
$ Text -> Buffer
newBuffer (String -> Text
Text.pack (String -> Text) -> (Scientific -> String) -> Scientific -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> String
forall a. Show a => a -> String
show (Scientific -> Text) -> Scientific -> Text
forall a b. (a -> b) -> a -> b
$ Scientific
sci)
  (BoolF Bool
True) -> Buffer -> Maybe Buffer
forall a. a -> Maybe a
Just (Buffer -> Maybe Buffer) -> Buffer -> Maybe Buffer
forall a b. (a -> b) -> a -> b
$ Text -> Buffer
newBuffer Text
"true"
  (BoolF Bool
False) -> Buffer -> Maybe Buffer
forall a. a -> Maybe a
Just (Buffer -> Maybe Buffer) -> Buffer -> Maybe Buffer
forall a b. (a -> b) -> a -> b
$ Text -> Buffer
newBuffer Text
"true"
  ValueF x
NullF -> Buffer -> Maybe Buffer
forall a. a -> Maybe a
Just (Buffer -> Maybe Buffer) -> Buffer -> Maybe Buffer
forall a b. (a -> b) -> a -> b
$ Text -> Buffer
newBuffer Text
"null"

boolText_ :: Prism' Text Bool
boolText_ :: p Bool (f Bool) -> p Text (f Text)
boolText_ = (Bool -> Text) -> (Text -> Maybe Bool) -> Prism Text Text Bool Bool
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' Bool -> Text
forall p. IsString p => Bool -> p
toText Text -> Maybe Bool
forall a. (Eq a, IsString a) => a -> Maybe Bool
toBool
  where
    toText :: Bool -> p
toText Bool
True = p
"true"
    toText Bool
False = p
"false"
    toBool :: a -> Maybe Bool
toBool a
"true" = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
    toBool a
"false" = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
    toBool a
_ = Maybe Bool
forall a. Maybe a
Nothing

data Mode
  = Edit {Mode -> Buffer
_buf :: Buffer}
  | Move
  | KeyMove {Mode -> Text
_selectedKey :: Text}
  | KeyEdit {_selectedKey :: Text, _buf :: Buffer}
  deriving (Int -> Mode -> ShowS
[Mode] -> ShowS
Mode -> String
(Int -> Mode -> ShowS)
-> (Mode -> String) -> ([Mode] -> ShowS) -> Show Mode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Mode] -> ShowS
$cshowList :: [Mode] -> ShowS
show :: Mode -> String
$cshow :: Mode -> String
showsPrec :: Int -> Mode -> ShowS
$cshowsPrec :: Int -> Mode -> ShowS
Show)

buf_ :: Traversal' Mode Buffer
buf_ :: (Buffer -> f Buffer) -> Mode -> f Mode
buf_ Buffer -> f Buffer
f = \case
  Edit Buffer
b -> Buffer -> Mode
Edit (Buffer -> Mode) -> f Buffer -> f Mode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Buffer -> f Buffer
f Buffer
b
  Mode
Move -> Mode -> f Mode
forall (f :: * -> *) a. Applicative f => a -> f a
pure Mode
Move
  KeyMove Text
txt -> Mode -> f Mode
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Mode
KeyMove Text
txt)
  KeyEdit Text
txt Buffer
b -> Text -> Buffer -> Mode
KeyEdit Text
txt (Buffer -> Mode) -> f Buffer -> f Mode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Buffer -> f Buffer
f Buffer
b

-- | Main event handler
handleEvent :: Vty.Event -> Z.Zipper JIndex ValueF FocusState -> Editor (Z.Zipper JIndex ValueF FocusState)
handleEvent :: Event
-> Zipper JIndex ValueF FocusState
-> Editor (Zipper JIndex ValueF FocusState)
handleEvent Event
evt Zipper JIndex ValueF FocusState
zipper = do
  Getting Mode EditorState Mode -> Editor Mode
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Mode EditorState Mode
Lens EditorState EditorState Mode Mode
mode_ Editor Mode
-> (Mode -> Editor (Zipper JIndex ValueF FocusState))
-> Editor (Zipper JIndex ValueF FocusState)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    KeyMove {} -> Zipper JIndex ValueF FocusState
-> Editor (Zipper JIndex ValueF FocusState)
handleMove Zipper JIndex ValueF FocusState
zipper
    Move {} -> Zipper JIndex ValueF FocusState
-> Editor (Zipper JIndex ValueF FocusState)
handleMove Zipper JIndex ValueF FocusState
zipper
    KeyEdit {} -> Zipper JIndex ValueF FocusState
-> Editor (Zipper JIndex ValueF FocusState)
handleEdit Zipper JIndex ValueF FocusState
zipper
    Edit {} -> Zipper JIndex ValueF FocusState
-> Editor (Zipper JIndex ValueF FocusState)
handleEdit Zipper JIndex ValueF FocusState
zipper
  where
    handleEdit ::
      ( Z.Zipper JIndex ValueF FocusState ->
        Editor (Z.Zipper JIndex ValueF FocusState)
      )
    handleEdit :: Zipper JIndex ValueF FocusState
-> Editor (Zipper JIndex ValueF FocusState)
handleEdit Zipper JIndex ValueF FocusState
z =
      case Event
evt of
        EvKey Key
key [] ->
          -- Perform buffer updates:
          case Key
key of
            KChar Char
c -> do
              (Mode -> Identity Mode) -> EditorState -> Identity EditorState
Lens EditorState EditorState Mode Mode
mode_ ((Mode -> Identity Mode) -> EditorState -> Identity EditorState)
-> ((Buffer -> Identity Buffer) -> Mode -> Identity Mode)
-> (Buffer -> Identity Buffer)
-> EditorState
-> Identity EditorState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Buffer -> Identity Buffer) -> Mode -> Identity Mode
Traversal' Mode Buffer
buf_ ((Buffer -> Identity Buffer)
 -> EditorState -> Identity EditorState)
-> (Buffer -> Buffer) -> Editor ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Char -> Buffer -> Buffer
forall a. Monoid a => Char -> TextZipper a -> TextZipper a
TZ.insertChar Char
c
              pure Zipper JIndex ValueF FocusState
z
            Key
KLeft -> do
              (Mode -> Identity Mode) -> EditorState -> Identity EditorState
Lens EditorState EditorState Mode Mode
mode_ ((Mode -> Identity Mode) -> EditorState -> Identity EditorState)
-> ((Buffer -> Identity Buffer) -> Mode -> Identity Mode)
-> (Buffer -> Identity Buffer)
-> EditorState
-> Identity EditorState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Buffer -> Identity Buffer) -> Mode -> Identity Mode
Traversal' Mode Buffer
buf_ ((Buffer -> Identity Buffer)
 -> EditorState -> Identity EditorState)
-> (Buffer -> Buffer) -> Editor ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Buffer -> Buffer
forall a. Monoid a => TextZipper a -> TextZipper a
TZ.moveLeft
              pure Zipper JIndex ValueF FocusState
z
            Key
KRight -> do
              (Mode -> Identity Mode) -> EditorState -> Identity EditorState
Lens EditorState EditorState Mode Mode
mode_ ((Mode -> Identity Mode) -> EditorState -> Identity EditorState)
-> ((Buffer -> Identity Buffer) -> Mode -> Identity Mode)
-> (Buffer -> Identity Buffer)
-> EditorState
-> Identity EditorState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Buffer -> Identity Buffer) -> Mode -> Identity Mode
Traversal' Mode Buffer
buf_ ((Buffer -> Identity Buffer)
 -> EditorState -> Identity EditorState)
-> (Buffer -> Buffer) -> Editor ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Buffer -> Buffer
forall a. Monoid a => TextZipper a -> TextZipper a
TZ.moveRight
              pure Zipper JIndex ValueF FocusState
z
            Key
KBS -> do
              (Mode -> Identity Mode) -> EditorState -> Identity EditorState
Lens EditorState EditorState Mode Mode
mode_ ((Mode -> Identity Mode) -> EditorState -> Identity EditorState)
-> ((Buffer -> Identity Buffer) -> Mode -> Identity Mode)
-> (Buffer -> Identity Buffer)
-> EditorState
-> Identity EditorState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Buffer -> Identity Buffer) -> Mode -> Identity Mode
Traversal' Mode Buffer
buf_ ((Buffer -> Identity Buffer)
 -> EditorState -> Identity EditorState)
-> (Buffer -> Buffer) -> Editor ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Buffer -> Buffer
forall a. (Eq a, Monoid a) => TextZipper a -> TextZipper a
TZ.deletePrevChar
              pure Zipper JIndex ValueF FocusState
z
            Key
KEsc -> do
              Zipper JIndex ValueF FocusState
newZ <- Zipper JIndex ValueF FocusState
-> Editor (Zipper JIndex ValueF FocusState)
applyBuf Zipper JIndex ValueF FocusState
z
              pure $ Zipper JIndex ValueF FocusState
newZ
            Key
_ -> Zipper JIndex ValueF FocusState
-> Editor (Zipper JIndex ValueF FocusState)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Zipper JIndex ValueF FocusState
z
        Event
_ -> Zipper JIndex ValueF FocusState
-> Editor (Zipper JIndex ValueF FocusState)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Zipper JIndex ValueF FocusState
z
    handleMove ::
      ( Z.Zipper JIndex ValueF FocusState ->
        Editor (Z.Zipper JIndex ValueF FocusState)
      )
    handleMove :: Zipper JIndex ValueF FocusState
-> Editor (Zipper JIndex ValueF FocusState)
handleMove Zipper JIndex ValueF FocusState
z =
      case Event
evt of
        EvKey Key
key [Modifier]
mods -> case Key
key of
          -- move up
          KChar Char
'h' -> Zipper JIndex ValueF FocusState
z Zipper JIndex ValueF FocusState
-> (Zipper JIndex ValueF FocusState
    -> Editor (Zipper JIndex ValueF FocusState))
-> Editor (Zipper JIndex ValueF FocusState)
forall a b. a -> (a -> b) -> b
& Zipper JIndex ValueF FocusState
-> Editor (Zipper JIndex ValueF FocusState)
outOf
          -- move down
          KChar Char
'l' -> do
            Zipper JIndex ValueF FocusState
z Zipper JIndex ValueF FocusState
-> (Zipper JIndex ValueF FocusState
    -> Zipper JIndex ValueF FocusState)
-> Zipper JIndex ValueF FocusState
forall a b. a -> (a -> b) -> b
& (FocusState -> Identity FocusState)
-> Zipper JIndex ValueF FocusState
-> Identity (Zipper JIndex ValueF FocusState)
forall i (f :: * -> *) a. Lens' (Zipper i f a) a
Z.focus_ ((FocusState -> Identity FocusState)
 -> Zipper JIndex ValueF FocusState
 -> Identity (Zipper JIndex ValueF FocusState))
-> ((Folded -> Identity Folded)
    -> FocusState -> Identity FocusState)
-> (Folded -> Identity Folded)
-> Zipper JIndex ValueF FocusState
-> Identity (Zipper JIndex ValueF FocusState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Folded -> Identity Folded) -> FocusState -> Identity FocusState
Lens FocusState FocusState Folded Folded
folded_ ((Folded -> Identity Folded)
 -> Zipper JIndex ValueF FocusState
 -> Identity (Zipper JIndex ValueF FocusState))
-> Folded
-> Zipper JIndex ValueF FocusState
-> Zipper JIndex ValueF FocusState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Folded
NotFolded
              Zipper JIndex ValueF FocusState
-> (Zipper JIndex ValueF FocusState
    -> Editor (Zipper JIndex ValueF FocusState))
-> Editor (Zipper JIndex ValueF FocusState)
forall a b. a -> (a -> b) -> b
& Zipper JIndex ValueF FocusState
-> Editor (Zipper JIndex ValueF FocusState)
into
          -- next sibling
          KChar Char
'j' -> Zipper JIndex ValueF FocusState
z Zipper JIndex ValueF FocusState
-> (Zipper JIndex ValueF FocusState
    -> Editor (Zipper JIndex ValueF FocusState))
-> Editor (Zipper JIndex ValueF FocusState)
forall a b. a -> (a -> b) -> b
& Dir
-> Zipper JIndex ValueF FocusState
-> Editor (Zipper JIndex ValueF FocusState)
sibling Dir
Forward
          -- move down
          KChar Char
'J' -> do
            Zipper JIndex ValueF FocusState -> Editor ()
pushUndo Zipper JIndex ValueF FocusState
z
            pure (Zipper JIndex ValueF FocusState
z Zipper JIndex ValueF FocusState
-> (Zipper JIndex ValueF FocusState
    -> Zipper JIndex ValueF FocusState)
-> Zipper JIndex ValueF FocusState
forall a b. a -> (a -> b) -> b
& Dir
-> Zipper JIndex ValueF FocusState
-> Zipper JIndex ValueF FocusState
moveElement Dir
Forward)
          -- prev sibling
          KChar Char
'k' -> Zipper JIndex ValueF FocusState
z Zipper JIndex ValueF FocusState
-> (Zipper JIndex ValueF FocusState
    -> Editor (Zipper JIndex ValueF FocusState))
-> Editor (Zipper JIndex ValueF FocusState)
forall a b. a -> (a -> b) -> b
& Dir
-> Zipper JIndex ValueF FocusState
-> Editor (Zipper JIndex ValueF FocusState)
sibling Dir
Backward
          -- move up
          KChar Char
'K' -> do
            Zipper JIndex ValueF FocusState -> Editor ()
pushUndo Zipper JIndex ValueF FocusState
z
            pure (Zipper JIndex ValueF FocusState
z Zipper JIndex ValueF FocusState
-> (Zipper JIndex ValueF FocusState
    -> Zipper JIndex ValueF FocusState)
-> Zipper JIndex ValueF FocusState
forall a b. a -> (a -> b) -> b
& Dir
-> Zipper JIndex ValueF FocusState
-> Zipper JIndex ValueF FocusState
moveElement Dir
Backward)
          -- add new node
          KChar Char
'i' -> do
            Zipper JIndex ValueF FocusState -> Editor ()
pushUndo Zipper JIndex ValueF FocusState
z
            Zipper JIndex ValueF FocusState
-> Editor (Zipper JIndex ValueF FocusState)
forall (m :: * -> *) i.
MonadState EditorState m =>
Zipper i ValueF FocusState -> m (Zipper i ValueF FocusState)
insert Zipper JIndex ValueF FocusState
z
          -- replace with boolean
          KChar Char
'b' -> do
            Zipper JIndex ValueF FocusState -> Editor ()
pushUndo Zipper JIndex ValueF FocusState
z
            pure (Zipper JIndex ValueF FocusState
z Zipper JIndex ValueF FocusState
-> (Zipper JIndex ValueF FocusState
    -> Zipper JIndex ValueF FocusState)
-> Zipper JIndex ValueF FocusState
forall a b. a -> (a -> b) -> b
& ValueF (Cofree ValueF FocusState)
-> Zipper JIndex ValueF FocusState
-> Zipper JIndex ValueF FocusState
setFocus (Bool -> ValueF (Cofree ValueF FocusState)
forall a. Bool -> ValueF a
BoolF Bool
True))
          -- replace with object
          KChar Char
'o' -> do
            Zipper JIndex ValueF FocusState -> Editor ()
pushUndo Zipper JIndex ValueF FocusState
z
            pure (Zipper JIndex ValueF FocusState
z Zipper JIndex ValueF FocusState
-> (Zipper JIndex ValueF FocusState
    -> Zipper JIndex ValueF FocusState)
-> Zipper JIndex ValueF FocusState
forall a b. a -> (a -> b) -> b
& ValueF (Cofree ValueF FocusState)
-> Zipper JIndex ValueF FocusState
-> Zipper JIndex ValueF FocusState
setFocus (ObjectF (Cofree ValueF FocusState)
-> ValueF (Cofree ValueF FocusState)
forall a. ObjectF a -> ValueF a
ObjectF ObjectF (Cofree ValueF FocusState)
forall a. Monoid a => a
mempty))
          -- replace with array
          KChar Char
'a' -> do
            Zipper JIndex ValueF FocusState -> Editor ()
pushUndo Zipper JIndex ValueF FocusState
z
            pure (Zipper JIndex ValueF FocusState
z Zipper JIndex ValueF FocusState
-> (Zipper JIndex ValueF FocusState
    -> Zipper JIndex ValueF FocusState)
-> Zipper JIndex ValueF FocusState
forall a b. a -> (a -> b) -> b
& ValueF (Cofree ValueF FocusState)
-> Zipper JIndex ValueF FocusState
-> Zipper JIndex ValueF FocusState
setFocus (ArrayF (Cofree ValueF FocusState)
-> ValueF (Cofree ValueF FocusState)
forall a. ArrayF a -> ValueF a
ArrayF ArrayF (Cofree ValueF FocusState)
forall a. Monoid a => a
mempty))
          -- replace with number
          KChar Char
'n' -> do
            Zipper JIndex ValueF FocusState -> Editor ()
pushUndo Zipper JIndex ValueF FocusState
z
            pure (Zipper JIndex ValueF FocusState
z Zipper JIndex ValueF FocusState
-> (Zipper JIndex ValueF FocusState
    -> Zipper JIndex ValueF FocusState)
-> Zipper JIndex ValueF FocusState
forall a b. a -> (a -> b) -> b
& ValueF (Cofree ValueF FocusState)
-> Zipper JIndex ValueF FocusState
-> Zipper JIndex ValueF FocusState
setFocus (Scientific -> ValueF (Cofree ValueF FocusState)
forall a. Scientific -> ValueF a
NumberF Scientific
0))
          -- replace with Null
          KChar Char
'N' -> do
            Zipper JIndex ValueF FocusState -> Editor ()
pushUndo Zipper JIndex ValueF FocusState
z
            pure (Zipper JIndex ValueF FocusState
z Zipper JIndex ValueF FocusState
-> (Zipper JIndex ValueF FocusState
    -> Zipper JIndex ValueF FocusState)
-> Zipper JIndex ValueF FocusState
forall a b. a -> (a -> b) -> b
& ValueF (Cofree ValueF FocusState)
-> Zipper JIndex ValueF FocusState
-> Zipper JIndex ValueF FocusState
setFocus ValueF (Cofree ValueF FocusState)
forall a. ValueF a
NullF)
          -- Save file
          KChar Char
's'
            | [Modifier
Vty.MCtrl] <- [Modifier]
mods -> do
              Zipper JIndex ValueF FocusState -> Editor ()
saver <- Getting
  (Zipper JIndex ValueF FocusState -> Editor ())
  EditorState
  (Zipper JIndex ValueF FocusState -> Editor ())
-> Editor (Zipper JIndex ValueF FocusState -> Editor ())
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting
  (Zipper JIndex ValueF FocusState -> Editor ())
  EditorState
  (Zipper JIndex ValueF FocusState -> Editor ())
Lens
  EditorState
  EditorState
  (Zipper JIndex ValueF FocusState -> Editor ())
  (Zipper JIndex ValueF FocusState -> Editor ())
save_
              Zipper JIndex ValueF FocusState -> Editor ()
saver Zipper JIndex ValueF FocusState
z
              pure Zipper JIndex ValueF FocusState
z
          -- replace with string
          KChar Char
's' -> do
            Zipper JIndex ValueF FocusState -> Editor ()
pushUndo Zipper JIndex ValueF FocusState
z
            pure (Zipper JIndex ValueF FocusState
z Zipper JIndex ValueF FocusState
-> (Zipper JIndex ValueF FocusState
    -> Zipper JIndex ValueF FocusState)
-> Zipper JIndex ValueF FocusState
forall a b. a -> (a -> b) -> b
& ValueF (Cofree ValueF FocusState)
-> Zipper JIndex ValueF FocusState
-> Zipper JIndex ValueF FocusState
setFocus (Text -> ValueF (Cofree ValueF FocusState)
forall a. Text -> ValueF a
StringF Text
""))
          -- undo
          KChar Char
'u' -> do
            (Text -> Identity Text) -> EditorState -> Identity EditorState
Lens EditorState EditorState Text Text
flash_ ((Text -> Identity Text) -> EditorState -> Identity EditorState)
-> Text -> Editor ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Text
"Undo"
            (UndoZipper (Zipper JIndex ValueF FocusState)
 -> (Zipper JIndex ValueF FocusState,
     UndoZipper (Zipper JIndex ValueF FocusState)))
-> EditorState -> (Zipper JIndex ValueF FocusState, EditorState)
Lens
  EditorState
  EditorState
  (UndoZipper (Zipper JIndex ValueF FocusState))
  (UndoZipper (Zipper JIndex ValueF FocusState))
undo_ ((UndoZipper (Zipper JIndex ValueF FocusState)
  -> (Zipper JIndex ValueF FocusState,
      UndoZipper (Zipper JIndex ValueF FocusState)))
 -> EditorState -> (Zipper JIndex ValueF FocusState, EditorState))
-> (UndoZipper (Zipper JIndex ValueF FocusState)
    -> (Zipper JIndex ValueF FocusState,
        UndoZipper (Zipper JIndex ValueF FocusState)))
-> Editor (Zipper JIndex ValueF FocusState)
forall k s (m :: * -> *) (p :: k -> * -> *) r (a :: k) b.
MonadState s m =>
Over p ((,) r) s s a b -> p a (r, b) -> m r
%%= \case
              (UndoZipper (Zipper JIndex ValueF FocusState
l Cons.:< Seq (Zipper JIndex ValueF FocusState)
ls) Seq (Zipper JIndex ValueF FocusState)
rs) ->
                (Zipper JIndex ValueF FocusState
l, Seq (Zipper JIndex ValueF FocusState)
-> Seq (Zipper JIndex ValueF FocusState)
-> UndoZipper (Zipper JIndex ValueF FocusState)
forall a. Seq a -> Seq a -> UndoZipper a
UndoZipper Seq (Zipper JIndex ValueF FocusState)
ls (Zipper JIndex ValueF FocusState
z Zipper JIndex ValueF FocusState
-> Seq (Zipper JIndex ValueF FocusState)
-> Seq (Zipper JIndex ValueF FocusState)
forall s a. Cons s s a a => a -> s -> s
Cons.:< Seq (Zipper JIndex ValueF FocusState)
rs))
              UndoZipper (Zipper JIndex ValueF FocusState)
lz -> (Zipper JIndex ValueF FocusState
z, UndoZipper (Zipper JIndex ValueF FocusState)
lz)
          -- redo
          KChar Char
'r' | [Modifier
Vty.MCtrl] <- [Modifier]
mods -> do
            (Text -> Identity Text) -> EditorState -> Identity EditorState
Lens EditorState EditorState Text Text
flash_ ((Text -> Identity Text) -> EditorState -> Identity EditorState)
-> Text -> Editor ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Text
"Redo"
            (UndoZipper (Zipper JIndex ValueF FocusState)
 -> (Zipper JIndex ValueF FocusState,
     UndoZipper (Zipper JIndex ValueF FocusState)))
-> EditorState -> (Zipper JIndex ValueF FocusState, EditorState)
Lens
  EditorState
  EditorState
  (UndoZipper (Zipper JIndex ValueF FocusState))
  (UndoZipper (Zipper JIndex ValueF FocusState))
undo_ ((UndoZipper (Zipper JIndex ValueF FocusState)
  -> (Zipper JIndex ValueF FocusState,
      UndoZipper (Zipper JIndex ValueF FocusState)))
 -> EditorState -> (Zipper JIndex ValueF FocusState, EditorState))
-> (UndoZipper (Zipper JIndex ValueF FocusState)
    -> (Zipper JIndex ValueF FocusState,
        UndoZipper (Zipper JIndex ValueF FocusState)))
-> Editor (Zipper JIndex ValueF FocusState)
forall k s (m :: * -> *) (p :: k -> * -> *) r (a :: k) b.
MonadState s m =>
Over p ((,) r) s s a b -> p a (r, b) -> m r
%%= \case
              (UndoZipper Seq (Zipper JIndex ValueF FocusState)
ls (Zipper JIndex ValueF FocusState
r Cons.:< Seq (Zipper JIndex ValueF FocusState)
rs)) -> (Zipper JIndex ValueF FocusState
r, Seq (Zipper JIndex ValueF FocusState)
-> Seq (Zipper JIndex ValueF FocusState)
-> UndoZipper (Zipper JIndex ValueF FocusState)
forall a. Seq a -> Seq a -> UndoZipper a
UndoZipper (Zipper JIndex ValueF FocusState
z Zipper JIndex ValueF FocusState
-> Seq (Zipper JIndex ValueF FocusState)
-> Seq (Zipper JIndex ValueF FocusState)
forall s a. Cons s s a a => a -> s -> s
Cons.:< Seq (Zipper JIndex ValueF FocusState)
ls) Seq (Zipper JIndex ValueF FocusState)
rs)
              UndoZipper (Zipper JIndex ValueF FocusState)
lz -> (Zipper JIndex ValueF FocusState
z, UndoZipper (Zipper JIndex ValueF FocusState)
lz)
          -- toggle bool
          KChar Char
' ' -> do
            Zipper JIndex ValueF FocusState -> Editor ()
pushUndo Zipper JIndex ValueF FocusState
z
            pure (Zipper JIndex ValueF FocusState
z Zipper JIndex ValueF FocusState
-> (Zipper JIndex ValueF FocusState
    -> Zipper JIndex ValueF FocusState)
-> Zipper JIndex ValueF FocusState
forall a b. a -> (a -> b) -> b
& Zipper JIndex ValueF FocusState -> Zipper JIndex ValueF FocusState
tryToggleBool)
          -- copy
          KChar Char
'y' -> do
            (Text -> Identity Text) -> EditorState -> Identity EditorState
Lens EditorState EditorState Text Text
flash_ ((Text -> Identity Text) -> EditorState -> Identity EditorState)
-> Text -> Editor ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Text
"Copied"
            Zipper JIndex ValueF FocusState
-> Editor (Zipper JIndex ValueF FocusState)
forall (f :: * -> *) i.
(MonadState EditorState f, MonadIO f) =>
Zipper i ValueF FocusState -> f (Zipper i ValueF FocusState)
copy Zipper JIndex ValueF FocusState
z
          -- paste
          KChar Char
'p' -> do
            (Text -> Identity Text) -> EditorState -> Identity EditorState
Lens EditorState EditorState Text Text
flash_ ((Text -> Identity Text) -> EditorState -> Identity EditorState)
-> Text -> Editor ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Text
"Paste"
            Zipper JIndex ValueF FocusState -> Editor ()
pushUndo Zipper JIndex ValueF FocusState
z
            Zipper JIndex ValueF FocusState
-> Editor (Zipper JIndex ValueF FocusState)
forall (f :: * -> *).
MonadState EditorState f =>
Zipper JIndex ValueF FocusState
-> f (Zipper JIndex ValueF FocusState)
paste Zipper JIndex ValueF FocusState
z
          -- cut
          KChar Char
'x' -> do
            (Text -> Identity Text) -> EditorState -> Identity EditorState
Lens EditorState EditorState Text Text
flash_ ((Text -> Identity Text) -> EditorState -> Identity EditorState)
-> Text -> Editor ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Text
"Cut"
            Zipper JIndex ValueF FocusState -> Editor ()
pushUndo Zipper JIndex ValueF FocusState
z
            Zipper JIndex ValueF FocusState
-> Editor (Zipper JIndex ValueF FocusState)
forall (f :: * -> *) i.
(MonadState EditorState f, MonadIO f) =>
Zipper i ValueF FocusState -> f (Zipper i ValueF FocusState)
copy Zipper JIndex ValueF FocusState
z Editor (Zipper JIndex ValueF FocusState)
-> (Zipper JIndex ValueF FocusState
    -> Editor (Zipper JIndex ValueF FocusState))
-> Editor (Zipper JIndex ValueF FocusState)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Zipper JIndex ValueF FocusState
-> Editor (Zipper JIndex ValueF FocusState)
delete
          -- help
          KChar Char
'?' -> do
            Vty
vty <- Getting Vty EditorState Vty -> Editor Vty
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Vty EditorState Vty
Lens EditorState EditorState Vty Vty
vty_
            IO () -> Editor ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Editor ()) -> IO () -> Editor ()
forall a b. (a -> b) -> a -> b
$ Vty -> Picture -> IO ()
Vty.update Vty
vty (Image -> Picture
Vty.picForImage Image
helpImg)
            Editor Event -> Editor ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Editor Event -> Editor ()) -> Editor Event -> Editor ()
forall a b. (a -> b) -> a -> b
$ IO Event -> Editor Event
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Event -> Editor Event) -> IO Event -> Editor Event
forall a b. (a -> b) -> a -> b
$ Vty -> IO Event
Vty.nextEvent Vty
vty
            pure Zipper JIndex ValueF FocusState
z
          -- add child
          Key
KEnter -> do
            Zipper JIndex ValueF FocusState -> Editor ()
pushUndo Zipper JIndex ValueF FocusState
z
            Zipper JIndex ValueF FocusState
-> Editor (Zipper JIndex ValueF FocusState)
tryAddChild Zipper JIndex ValueF FocusState
z
          -- toggle fold
          KChar Char
'\t' -> do
            -- Exit KeyMove mode if we're in it.
            (Mode -> Identity Mode) -> EditorState -> Identity EditorState
Lens EditorState EditorState Mode Mode
mode_ ((Mode -> Identity Mode) -> EditorState -> Identity EditorState)
-> Mode -> Editor ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Mode
Move
            pure $ (Zipper JIndex ValueF FocusState
z Zipper JIndex ValueF FocusState
-> (Zipper JIndex ValueF FocusState
    -> Zipper JIndex ValueF FocusState)
-> Zipper JIndex ValueF FocusState
forall a b. a -> (a -> b) -> b
& (FocusState -> Identity FocusState)
-> Zipper JIndex ValueF FocusState
-> Identity (Zipper JIndex ValueF FocusState)
forall i (f :: * -> *) a. Lens' (Zipper i f a) a
Z.focus_ ((FocusState -> Identity FocusState)
 -> Zipper JIndex ValueF FocusState
 -> Identity (Zipper JIndex ValueF FocusState))
-> ((Folded -> Identity Folded)
    -> FocusState -> Identity FocusState)
-> (Folded -> Identity Folded)
-> Zipper JIndex ValueF FocusState
-> Identity (Zipper JIndex ValueF FocusState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Folded -> Identity Folded) -> FocusState -> Identity FocusState
Lens FocusState FocusState Folded Folded
folded_ ((Folded -> Identity Folded)
 -> Zipper JIndex ValueF FocusState
 -> Identity (Zipper JIndex ValueF FocusState))
-> (Folded -> Folded)
-> Zipper JIndex ValueF FocusState
-> Zipper JIndex ValueF FocusState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Folded -> Folded
toggleFold)
          -- Fold all children
          KChar Char
'F' -> do
            -- Fold all child branches
            Zipper JIndex ValueF FocusState
-> Editor (Zipper JIndex ValueF FocusState)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Zipper JIndex ValueF FocusState
 -> Editor (Zipper JIndex ValueF FocusState))
-> Zipper JIndex ValueF FocusState
-> Editor (Zipper JIndex ValueF FocusState)
forall a b. (a -> b) -> a -> b
$ (Cofree ValueF FocusState -> Cofree ValueF FocusState)
-> Zipper JIndex ValueF FocusState
-> Zipper JIndex ValueF FocusState
mapChildren ((FocusState -> Identity FocusState)
-> Cofree ValueF FocusState -> Identity (Cofree ValueF FocusState)
forall (f :: * -> *) a b. Functor f => Setter (f a) (f b) a b
mapped ((FocusState -> Identity FocusState)
 -> Cofree ValueF FocusState -> Identity (Cofree ValueF FocusState))
-> ((Folded -> Identity Folded)
    -> FocusState -> Identity FocusState)
-> (Folded -> Identity Folded)
-> Cofree ValueF FocusState
-> Identity (Cofree ValueF FocusState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Folded -> Identity Folded) -> FocusState -> Identity FocusState
Lens FocusState FocusState Folded Folded
folded_ ((Folded -> Identity Folded)
 -> Cofree ValueF FocusState -> Identity (Cofree ValueF FocusState))
-> Folded -> Cofree ValueF FocusState -> Cofree ValueF FocusState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Folded
Folded) Zipper JIndex ValueF FocusState
z
          -- unfold all children
          KChar Char
'f' -> do
            -- Unfold all child branches
            Zipper JIndex ValueF FocusState
-> Editor (Zipper JIndex ValueF FocusState)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Zipper JIndex ValueF FocusState
 -> Editor (Zipper JIndex ValueF FocusState))
-> Zipper JIndex ValueF FocusState
-> Editor (Zipper JIndex ValueF FocusState)
forall a b. (a -> b) -> a -> b
$ (Cofree ValueF FocusState -> Cofree ValueF FocusState)
-> Zipper JIndex ValueF FocusState
-> Zipper JIndex ValueF FocusState
mapChildren ((FocusState -> Identity FocusState)
-> Cofree ValueF FocusState -> Identity (Cofree ValueF FocusState)
forall (f :: * -> *) a b. Functor f => Setter (f a) (f b) a b
mapped ((FocusState -> Identity FocusState)
 -> Cofree ValueF FocusState -> Identity (Cofree ValueF FocusState))
-> ((Folded -> Identity Folded)
    -> FocusState -> Identity FocusState)
-> (Folded -> Identity Folded)
-> Cofree ValueF FocusState
-> Identity (Cofree ValueF FocusState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Folded -> Identity Folded) -> FocusState -> Identity FocusState
Lens FocusState FocusState Folded Folded
folded_ ((Folded -> Identity Folded)
 -> Cofree ValueF FocusState -> Identity (Cofree ValueF FocusState))
-> Folded -> Cofree ValueF FocusState -> Cofree ValueF FocusState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Folded
NotFolded) Zipper JIndex ValueF FocusState
z
          -- delete node
          Key
KBS -> do
            (Text -> Identity Text) -> EditorState -> Identity EditorState
Lens EditorState EditorState Text Text
flash_ ((Text -> Identity Text) -> EditorState -> Identity EditorState)
-> Text -> Editor ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Text
"Deleted"
            Zipper JIndex ValueF FocusState -> Editor ()
pushUndo Zipper JIndex ValueF FocusState
z
            Zipper JIndex ValueF FocusState
-> Editor (Zipper JIndex ValueF FocusState)
delete Zipper JIndex ValueF FocusState
z
          Key
_ -> Zipper JIndex ValueF FocusState
-> Editor (Zipper JIndex ValueF FocusState)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Zipper JIndex ValueF FocusState
z
        Event
_ -> Zipper JIndex ValueF FocusState
-> Editor (Zipper JIndex ValueF FocusState)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Zipper JIndex ValueF FocusState
z
    paste :: Zipper JIndex ValueF FocusState
-> f (Zipper JIndex ValueF FocusState)
paste Zipper JIndex ValueF FocusState
z = do
      ValueF (Cofree ValueF FocusState)
reg <- Getting
  (ValueF (Cofree ValueF FocusState))
  EditorState
  (ValueF (Cofree ValueF FocusState))
-> f (ValueF (Cofree ValueF FocusState))
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting
  (ValueF (Cofree ValueF FocusState))
  EditorState
  (ValueF (Cofree ValueF FocusState))
Lens
  EditorState
  EditorState
  (ValueF (Cofree ValueF FocusState))
  (ValueF (Cofree ValueF FocusState))
register_
      pure (Zipper JIndex ValueF FocusState
z Zipper JIndex ValueF FocusState
-> (Zipper JIndex ValueF FocusState
    -> Zipper JIndex ValueF FocusState)
-> Zipper JIndex ValueF FocusState
forall a b. a -> (a -> b) -> b
& ValueF (Cofree ValueF FocusState)
-> Zipper JIndex ValueF FocusState
-> Zipper JIndex ValueF FocusState
setFocus ValueF (Cofree ValueF FocusState)
reg)
    copy :: Zipper i ValueF FocusState -> f (Zipper i ValueF FocusState)
copy Zipper i ValueF FocusState
z = do
      let curVal :: ValueF (Cofree ValueF FocusState)
curVal = Zipper i ValueF FocusState -> ValueF (Cofree ValueF FocusState)
forall i (f :: * -> *) a. Zipper i f a -> f (Cofree f a)
Z.branches Zipper i ValueF FocusState
z
      (ValueF (Cofree ValueF FocusState)
 -> Identity (ValueF (Cofree ValueF FocusState)))
-> EditorState -> Identity EditorState
Lens
  EditorState
  EditorState
  (ValueF (Cofree ValueF FocusState))
  (ValueF (Cofree ValueF FocusState))
register_ ((ValueF (Cofree ValueF FocusState)
  -> Identity (ValueF (Cofree ValueF FocusState)))
 -> EditorState -> Identity EditorState)
-> ValueF (Cofree ValueF FocusState) -> f ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= ValueF (Cofree ValueF FocusState)
curVal
      IO () -> f ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> f ()) -> IO () -> f ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
setClipboard (ValueF (Cofree ValueF FocusState) -> String
encodeValueFCofree ValueF (Cofree ValueF FocusState)
curVal)
      pure Zipper i ValueF FocusState
z
    insert :: Zipper i ValueF FocusState -> m (Zipper i ValueF FocusState)
insert Zipper i ValueF FocusState
z = do
      Getting Mode EditorState Mode -> m Mode
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Mode EditorState Mode
Lens EditorState EditorState Mode Mode
mode_ m Mode
-> (Mode -> m (Zipper i ValueF FocusState))
-> m (Zipper i ValueF FocusState)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        KeyMove Text
k -> do
          (Mode -> Identity Mode) -> EditorState -> Identity EditorState
Lens EditorState EditorState Mode Mode
mode_ ((Mode -> Identity Mode) -> EditorState -> Identity EditorState)
-> Mode -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Text -> Buffer -> Mode
KeyEdit Text
k (Text -> Buffer
newBuffer Text
k)
          pure $ Zipper i ValueF FocusState
z Zipper i ValueF FocusState
-> (Zipper i ValueF FocusState -> Zipper i ValueF FocusState)
-> Zipper i ValueF FocusState
forall a b. a -> (a -> b) -> b
& (FocusState -> Identity FocusState)
-> Zipper i ValueF FocusState
-> Identity (Zipper i ValueF FocusState)
forall i (f :: * -> *) a. Lens' (Zipper i f a) a
Z.focus_ ((FocusState -> Identity FocusState)
 -> Zipper i ValueF FocusState
 -> Identity (Zipper i ValueF FocusState))
-> ((Folded -> Identity Folded)
    -> FocusState -> Identity FocusState)
-> (Folded -> Identity Folded)
-> Zipper i ValueF FocusState
-> Identity (Zipper i ValueF FocusState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Folded -> Identity Folded) -> FocusState -> Identity FocusState
Lens FocusState FocusState Folded Folded
folded_ ((Folded -> Identity Folded)
 -> Zipper i ValueF FocusState
 -> Identity (Zipper i ValueF FocusState))
-> Folded
-> Zipper i ValueF FocusState
-> Zipper i ValueF FocusState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Folded
NotFolded
        Mode
Move
          | Just Buffer
editBuf <- ValueF (Cofree ValueF FocusState) -> Maybe Buffer
forall x. ValueF x -> Maybe Buffer
bufferForValueF (Zipper i ValueF FocusState
z Zipper i ValueF FocusState
-> Getting
     (ValueF (Cofree ValueF FocusState))
     (Zipper i ValueF FocusState)
     (ValueF (Cofree ValueF FocusState))
-> ValueF (Cofree ValueF FocusState)
forall s a. s -> Getting a s a -> a
^. Getting
  (ValueF (Cofree ValueF FocusState))
  (Zipper i ValueF FocusState)
  (ValueF (Cofree ValueF FocusState))
forall i (f :: * -> *) a. Lens' (Zipper i f a) (f (Cofree f a))
Z.branches_) -> do
            (Mode -> Identity Mode) -> EditorState -> Identity EditorState
Lens EditorState EditorState Mode Mode
mode_ ((Mode -> Identity Mode) -> EditorState -> Identity EditorState)
-> Mode -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Buffer -> Mode
Edit Buffer
editBuf
            pure $ Zipper i ValueF FocusState
z Zipper i ValueF FocusState
-> (Zipper i ValueF FocusState -> Zipper i ValueF FocusState)
-> Zipper i ValueF FocusState
forall a b. a -> (a -> b) -> b
& (FocusState -> Identity FocusState)
-> Zipper i ValueF FocusState
-> Identity (Zipper i ValueF FocusState)
forall i (f :: * -> *) a. Lens' (Zipper i f a) a
Z.focus_ ((FocusState -> Identity FocusState)
 -> Zipper i ValueF FocusState
 -> Identity (Zipper i ValueF FocusState))
-> ((Folded -> Identity Folded)
    -> FocusState -> Identity FocusState)
-> (Folded -> Identity Folded)
-> Zipper i ValueF FocusState
-> Identity (Zipper i ValueF FocusState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Folded -> Identity Folded) -> FocusState -> Identity FocusState
Lens FocusState FocusState Folded Folded
folded_ ((Folded -> Identity Folded)
 -> Zipper i ValueF FocusState
 -> Identity (Zipper i ValueF FocusState))
-> Folded
-> Zipper i ValueF FocusState
-> Zipper i ValueF FocusState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Folded
NotFolded
        Mode
_ -> Zipper i ValueF FocusState -> m (Zipper i ValueF FocusState)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Zipper i ValueF FocusState
z

encodeValueFCofree :: ValueF (Cofree ValueF FocusState) -> String
encodeValueFCofree :: ValueF (Cofree ValueF FocusState) -> String
encodeValueFCofree ValueF (Cofree ValueF FocusState)
vf = ByteString -> String
LBS.unpack (ByteString -> String)
-> (ValueF Value -> ByteString) -> ValueF Value -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty (Value -> ByteString)
-> (ValueF Value -> Value) -> ValueF Value -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueF Value -> Value
forall t. Corecursive t => Base t t -> t
FF.embed (ValueF Value -> String) -> ValueF Value -> String
forall a b. (a -> b) -> a -> b
$ (Cofree ValueF FocusState -> Value)
-> ValueF (Cofree ValueF FocusState) -> ValueF Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Base (Cofree ValueF FocusState) Value -> Value)
-> Cofree ValueF FocusState -> Value
forall t a. Recursive t => (Base t a -> a) -> t -> a
FF.cata Base (Cofree ValueF FocusState) Value -> Value
forall ann. CofreeF ValueF ann Value -> Value
alg) ValueF (Cofree ValueF FocusState)
vf
  where
    alg :: CofreeF.CofreeF ValueF ann Value -> Value
    alg :: CofreeF ValueF ann Value -> Value
alg (ann
_ CofreeF.:< ValueF Value
vf') = Base Value Value -> Value
forall t. Corecursive t => Base t t -> t
FF.embed ValueF Value
Base Value Value
vf'

-- | Set the value of the focused node.
setFocus ::
  ValueF (Cofree ValueF FocusState) ->
  Z.Zipper JIndex ValueF FocusState ->
  Z.Zipper JIndex ValueF FocusState
setFocus :: ValueF (Cofree ValueF FocusState)
-> Zipper JIndex ValueF FocusState
-> Zipper JIndex ValueF FocusState
setFocus ValueF (Cofree ValueF FocusState)
f Zipper JIndex ValueF FocusState
z = Zipper JIndex ValueF FocusState
z Zipper JIndex ValueF FocusState
-> (Zipper JIndex ValueF FocusState
    -> Zipper JIndex ValueF FocusState)
-> Zipper JIndex ValueF FocusState
forall a b. a -> (a -> b) -> b
& (ValueF (Cofree ValueF FocusState)
 -> Identity (ValueF (Cofree ValueF FocusState)))
-> Zipper JIndex ValueF FocusState
-> Identity (Zipper JIndex ValueF FocusState)
forall i (f :: * -> *) a. Lens' (Zipper i f a) (f (Cofree f a))
Z.branches_ ((ValueF (Cofree ValueF FocusState)
  -> Identity (ValueF (Cofree ValueF FocusState)))
 -> Zipper JIndex ValueF FocusState
 -> Identity (Zipper JIndex ValueF FocusState))
-> ValueF (Cofree ValueF FocusState)
-> Zipper JIndex ValueF FocusState
-> Zipper JIndex ValueF FocusState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ValueF (Cofree ValueF FocusState)
f Zipper JIndex ValueF FocusState
-> (Zipper JIndex ValueF FocusState
    -> Zipper JIndex ValueF FocusState)
-> Zipper JIndex ValueF FocusState
forall a b. a -> (a -> b) -> b
& Zipper JIndex ValueF FocusState -> Zipper JIndex ValueF FocusState
rerender

data Dir = Forward | Backward

-- | Move the current value within an array
moveElement :: Dir -> Z.Zipper JIndex ValueF FocusState -> Z.Zipper JIndex ValueF FocusState
moveElement :: Dir
-> Zipper JIndex ValueF FocusState
-> Zipper JIndex ValueF FocusState
moveElement Dir
dir Zipper JIndex ValueF FocusState
z = Zipper JIndex ValueF FocusState
-> Maybe (Zipper JIndex ValueF FocusState)
-> Zipper JIndex ValueF FocusState
forall a. a -> Maybe a -> a
fromMaybe Zipper JIndex ValueF FocusState
z (Maybe (Zipper JIndex ValueF FocusState)
 -> Zipper JIndex ValueF FocusState)
-> Maybe (Zipper JIndex ValueF FocusState)
-> Zipper JIndex ValueF FocusState
forall a b. (a -> b) -> a -> b
$ do
  Int
i <- case Zipper JIndex ValueF FocusState -> Maybe JIndex
forall i (f :: * -> *) a. Zipper i f a -> Maybe i
Z.currentIndex Zipper JIndex ValueF FocusState
z of
    Just (Index Int
i) -> Int -> Maybe Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
i
    Maybe JIndex
_ -> Maybe Int
forall a. Maybe a
Nothing
  Zipper JIndex ValueF FocusState
parent <- Zipper JIndex ValueF FocusState
z Zipper JIndex ValueF FocusState
-> (Zipper JIndex ValueF FocusState
    -> Zipper JIndex ValueF FocusState)
-> Zipper JIndex ValueF FocusState
forall a b. a -> (a -> b) -> b
& Zipper JIndex ValueF FocusState -> Zipper JIndex ValueF FocusState
rerender Zipper JIndex ValueF FocusState
-> (Zipper JIndex ValueF FocusState
    -> Maybe (Zipper JIndex ValueF FocusState))
-> Maybe (Zipper JIndex ValueF FocusState)
forall a b. a -> (a -> b) -> b
& Zipper JIndex ValueF FocusState
-> Maybe (Zipper JIndex ValueF FocusState)
forall i (f :: * -> *) a.
Idx i f a =>
Zipper i f a -> Maybe (Zipper i f a)
Z.up
  pure $
    case Zipper JIndex ValueF FocusState
parent Zipper JIndex ValueF FocusState
-> Getting
     (ValueF (Cofree ValueF FocusState))
     (Zipper JIndex ValueF FocusState)
     (ValueF (Cofree ValueF FocusState))
-> ValueF (Cofree ValueF FocusState)
forall s a. s -> Getting a s a -> a
^. Getting
  (ValueF (Cofree ValueF FocusState))
  (Zipper JIndex ValueF FocusState)
  (ValueF (Cofree ValueF FocusState))
forall i (f :: * -> *) a. Lens' (Zipper i f a) (f (Cofree f a))
Z.branches_ of
      ArrayF ArrayF (Cofree ValueF FocusState)
arr ->
        let swapI :: Int
swapI = case Dir
dir of
              Dir
Forward -> Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
              Dir
Backward -> Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
            moves :: [(Int, Cofree ValueF FocusState)]
moves =
              [ (Int
i, ArrayF (Cofree ValueF FocusState)
arr ArrayF (Cofree ValueF FocusState)
-> Int -> Maybe (Cofree ValueF FocusState)
forall a. Vector a -> Int -> Maybe a
Vector.!? Int
swapI),
                (Int
swapI, ArrayF (Cofree ValueF FocusState)
arr ArrayF (Cofree ValueF FocusState)
-> Int -> Maybe (Cofree ValueF FocusState)
forall a. Vector a -> Int -> Maybe a
Vector.!? Int
i)
              ]
                [(Int, Maybe (Cofree ValueF FocusState))]
-> ([(Int, Maybe (Cofree ValueF FocusState))]
    -> Maybe [(Int, Cofree ValueF FocusState)])
-> Maybe [(Int, Cofree ValueF FocusState)]
forall a b. a -> (a -> b) -> b
& LensLike
  (WrappedMonad Maybe)
  [(Int, Maybe (Cofree ValueF FocusState))]
  [(Int, Cofree ValueF FocusState)]
  (Maybe (Cofree ValueF FocusState))
  (Cofree ValueF FocusState)
-> [(Int, Maybe (Cofree ValueF FocusState))]
-> Maybe [(Int, Cofree ValueF FocusState)]
forall (m :: * -> *) s t b.
LensLike (WrappedMonad m) s t (m b) b -> s -> m t
sequenceOf (((Int, Maybe (Cofree ValueF FocusState))
 -> WrappedMonad Maybe (Int, Cofree ValueF FocusState))
-> [(Int, Maybe (Cofree ValueF FocusState))]
-> WrappedMonad Maybe [(Int, Cofree ValueF FocusState)]
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
traversed (((Int, Maybe (Cofree ValueF FocusState))
  -> WrappedMonad Maybe (Int, Cofree ValueF FocusState))
 -> [(Int, Maybe (Cofree ValueF FocusState))]
 -> WrappedMonad Maybe [(Int, Cofree ValueF FocusState)])
-> ((Maybe (Cofree ValueF FocusState)
     -> WrappedMonad Maybe (Cofree ValueF FocusState))
    -> (Int, Maybe (Cofree ValueF FocusState))
    -> WrappedMonad Maybe (Int, Cofree ValueF FocusState))
-> LensLike
     (WrappedMonad Maybe)
     [(Int, Maybe (Cofree ValueF FocusState))]
     [(Int, Cofree ValueF FocusState)]
     (Maybe (Cofree ValueF FocusState))
     (Cofree ValueF FocusState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Cofree ValueF FocusState)
 -> WrappedMonad Maybe (Cofree ValueF FocusState))
-> (Int, Maybe (Cofree ValueF FocusState))
-> WrappedMonad Maybe (Int, Cofree ValueF FocusState)
forall s t a b. Field2 s t a b => Lens s t a b
_2)
                Maybe [(Int, Cofree ValueF FocusState)]
-> (Maybe [(Int, Cofree ValueF FocusState)]
    -> [(Int, Cofree ValueF FocusState)])
-> [(Int, Cofree ValueF FocusState)]
forall a b. a -> (a -> b) -> b
& [(Int, Cofree ValueF FocusState)]
-> Maybe [(Int, Cofree ValueF FocusState)]
-> [(Int, Cofree ValueF FocusState)]
forall a. a -> Maybe a -> a
fromMaybe []
         in Zipper JIndex ValueF FocusState
parent
              Zipper JIndex ValueF FocusState
-> (Zipper JIndex ValueF FocusState
    -> Zipper JIndex ValueF FocusState)
-> Zipper JIndex ValueF FocusState
forall a b. a -> (a -> b) -> b
& (ValueF (Cofree ValueF FocusState)
 -> Identity (ValueF (Cofree ValueF FocusState)))
-> Zipper JIndex ValueF FocusState
-> Identity (Zipper JIndex ValueF FocusState)
forall i (f :: * -> *) a. Lens' (Zipper i f a) (f (Cofree f a))
Z.branches_ ((ValueF (Cofree ValueF FocusState)
  -> Identity (ValueF (Cofree ValueF FocusState)))
 -> Zipper JIndex ValueF FocusState
 -> Identity (Zipper JIndex ValueF FocusState))
-> ValueF (Cofree ValueF FocusState)
-> Zipper JIndex ValueF FocusState
-> Zipper JIndex ValueF FocusState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ArrayF (Cofree ValueF FocusState)
-> ValueF (Cofree ValueF FocusState)
forall a. ArrayF a -> ValueF a
ArrayF (ArrayF (Cofree ValueF FocusState)
arr ArrayF (Cofree ValueF FocusState)
-> [(Int, Cofree ValueF FocusState)]
-> ArrayF (Cofree ValueF FocusState)
forall a. Vector a -> [(Int, a)] -> Vector a
Vector.// [(Int, Cofree ValueF FocusState)]
moves)
              Zipper JIndex ValueF FocusState
-> (Zipper JIndex ValueF FocusState
    -> Zipper JIndex ValueF FocusState)
-> Zipper JIndex ValueF FocusState
forall a b. a -> (a -> b) -> b
& Zipper JIndex ValueF FocusState
-> Maybe (Zipper JIndex ValueF FocusState)
-> Zipper JIndex ValueF FocusState
forall a. a -> Maybe a -> a
fromMaybe Zipper JIndex ValueF FocusState
z (Maybe (Zipper JIndex ValueF FocusState)
 -> Zipper JIndex ValueF FocusState)
-> (Zipper JIndex ValueF FocusState
    -> Maybe (Zipper JIndex ValueF FocusState))
-> Zipper JIndex ValueF FocusState
-> Zipper JIndex ValueF FocusState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JIndex
-> Zipper JIndex ValueF FocusState
-> Maybe (Zipper JIndex ValueF FocusState)
forall i (f :: * -> *) a.
Idx i f a =>
i -> Zipper i f a -> Maybe (Zipper i f a)
Z.down (Int -> JIndex
Index Int
swapI)
      ValueF (Cofree ValueF FocusState)
_ -> Zipper JIndex ValueF FocusState
z

tryToggleBool :: Z.Zipper JIndex ValueF FocusState -> Z.Zipper JIndex ValueF FocusState
tryToggleBool :: Zipper JIndex ValueF FocusState -> Zipper JIndex ValueF FocusState
tryToggleBool Zipper JIndex ValueF FocusState
z =
  Zipper JIndex ValueF FocusState
z Zipper JIndex ValueF FocusState
-> (Zipper JIndex ValueF FocusState
    -> Zipper JIndex ValueF FocusState)
-> Zipper JIndex ValueF FocusState
forall a b. a -> (a -> b) -> b
& (ValueF (Cofree ValueF FocusState)
 -> Identity (ValueF (Cofree ValueF FocusState)))
-> Zipper JIndex ValueF FocusState
-> Identity (Zipper JIndex ValueF FocusState)
forall i (f :: * -> *) a. Lens' (Zipper i f a) (f (Cofree f a))
Z.branches_ ((ValueF (Cofree ValueF FocusState)
  -> Identity (ValueF (Cofree ValueF FocusState)))
 -> Zipper JIndex ValueF FocusState
 -> Identity (Zipper JIndex ValueF FocusState))
-> (ValueF (Cofree ValueF FocusState)
    -> ValueF (Cofree ValueF FocusState))
-> Zipper JIndex ValueF FocusState
-> Zipper JIndex ValueF FocusState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ \case
    BoolF Bool
b -> Bool -> ValueF (Cofree ValueF FocusState)
forall a. Bool -> ValueF a
BoolF (Bool -> Bool
not Bool
b)
    ValueF (Cofree ValueF FocusState)
x -> ValueF (Cofree ValueF FocusState)
x

tryAddChild :: Z.Zipper JIndex ValueF FocusState -> Editor (Z.Zipper JIndex ValueF FocusState)
tryAddChild :: Zipper JIndex ValueF FocusState
-> Editor (Zipper JIndex ValueF FocusState)
tryAddChild Zipper JIndex ValueF FocusState
z =
  Zipper JIndex ValueF FocusState
z Zipper JIndex ValueF FocusState
-> (Zipper JIndex ValueF FocusState
    -> Editor (Zipper JIndex ValueF FocusState))
-> Editor (Zipper JIndex ValueF FocusState)
forall a b. a -> (a -> b) -> b
& (ValueF (Cofree ValueF FocusState)
 -> Editor (ValueF (Cofree ValueF FocusState)))
-> Zipper JIndex ValueF FocusState
-> Editor (Zipper JIndex ValueF FocusState)
forall i (f :: * -> *) a. Lens' (Zipper i f a) (f (Cofree f a))
Z.branches_ ((ValueF (Cofree ValueF FocusState)
  -> Editor (ValueF (Cofree ValueF FocusState)))
 -> Zipper JIndex ValueF FocusState
 -> Editor (Zipper JIndex ValueF FocusState))
-> (ValueF (Cofree ValueF FocusState)
    -> Editor (ValueF (Cofree ValueF FocusState)))
-> Zipper JIndex ValueF FocusState
-> Editor (Zipper JIndex ValueF FocusState)
forall k (f :: k -> *) s (t :: k) a (b :: k).
LensLike f s t a b -> LensLike f s t a b
%%~ \case
    ObjectF ObjectF (Cofree ValueF FocusState)
hm -> do
      (Mode -> Identity Mode) -> EditorState -> Identity EditorState
Lens EditorState EditorState Mode Mode
mode_ ((Mode -> Identity Mode) -> EditorState -> Identity EditorState)
-> Mode -> Editor ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= (Text -> Buffer -> Mode
KeyEdit Text
"" (Buffer -> Mode) -> Buffer -> Mode
forall a b. (a -> b) -> a -> b
$ Text -> Buffer
newBuffer Text
"")
      pure $ ObjectF (Cofree ValueF FocusState)
-> ValueF (Cofree ValueF FocusState)
forall a. ObjectF a -> ValueF a
ObjectF (ObjectF (Cofree ValueF FocusState)
 -> ValueF (Cofree ValueF FocusState))
-> ObjectF (Cofree ValueF FocusState)
-> ValueF (Cofree ValueF FocusState)
forall a b. (a -> b) -> a -> b
$ Text
-> Cofree ValueF FocusState
-> ObjectF (Cofree ValueF FocusState)
-> ObjectF (Cofree ValueF FocusState)
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert Text
"" (Value -> Cofree ValueF FocusState
toCofree Value
Aeson.Null) ObjectF (Cofree ValueF FocusState)
hm
    ArrayF ArrayF (Cofree ValueF FocusState)
arr -> do
      (Mode -> Identity Mode) -> EditorState -> Identity EditorState
Lens EditorState EditorState Mode Mode
mode_ ((Mode -> Identity Mode) -> EditorState -> Identity EditorState)
-> Mode -> Editor ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Mode
Move
      pure $ ArrayF (Cofree ValueF FocusState)
-> ValueF (Cofree ValueF FocusState)
forall a. ArrayF a -> ValueF a
ArrayF (ArrayF (Cofree ValueF FocusState)
 -> ValueF (Cofree ValueF FocusState))
-> ArrayF (Cofree ValueF FocusState)
-> ValueF (Cofree ValueF FocusState)
forall a b. (a -> b) -> a -> b
$ ArrayF (Cofree ValueF FocusState)
arr ArrayF (Cofree ValueF FocusState)
-> ArrayF (Cofree ValueF FocusState)
-> ArrayF (Cofree ValueF FocusState)
forall a. Semigroup a => a -> a -> a
<> Cofree ValueF FocusState -> ArrayF (Cofree ValueF FocusState)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Cofree ValueF FocusState
toCofree Value
Aeson.Null)
    ValueF (Cofree ValueF FocusState)
x -> ValueF (Cofree ValueF FocusState)
-> Editor (ValueF (Cofree ValueF FocusState))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ValueF (Cofree ValueF FocusState)
x

-- | Delete the current node
delete :: Z.Zipper JIndex ValueF FocusState -> Editor (Z.Zipper JIndex ValueF FocusState)
delete :: Zipper JIndex ValueF FocusState
-> Editor (Zipper JIndex ValueF FocusState)
delete Zipper JIndex ValueF FocusState
z = do
  Mode
curMode <- Getting Mode EditorState Mode -> Editor Mode
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Mode EditorState Mode
Lens EditorState EditorState Mode Mode
mode_
  (Mode -> Identity Mode) -> EditorState -> Identity EditorState
Lens EditorState EditorState Mode Mode
mode_ ((Mode -> Identity Mode) -> EditorState -> Identity EditorState)
-> Mode -> Editor ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Mode
Move
  pure $ case Zipper JIndex ValueF FocusState
z Zipper JIndex ValueF FocusState
-> Getting
     (ValueF (Cofree ValueF FocusState))
     (Zipper JIndex ValueF FocusState)
     (ValueF (Cofree ValueF FocusState))
-> ValueF (Cofree ValueF FocusState)
forall s a. s -> Getting a s a -> a
^. Getting
  (ValueF (Cofree ValueF FocusState))
  (Zipper JIndex ValueF FocusState)
  (ValueF (Cofree ValueF FocusState))
forall i (f :: * -> *) a. Lens' (Zipper i f a) (f (Cofree f a))
Z.branches_ of
    -- If we're in a Key focus, delete that key
    ObjectF ObjectF (Cofree ValueF FocusState)
hm
      | KeyMove Text
k <- Mode
curMode ->
        ( Zipper JIndex ValueF FocusState
z Zipper JIndex ValueF FocusState
-> (Zipper JIndex ValueF FocusState
    -> Zipper JIndex ValueF FocusState)
-> Zipper JIndex ValueF FocusState
forall a b. a -> (a -> b) -> b
& (ValueF (Cofree ValueF FocusState)
 -> Identity (ValueF (Cofree ValueF FocusState)))
-> Zipper JIndex ValueF FocusState
-> Identity (Zipper JIndex ValueF FocusState)
forall i (f :: * -> *) a. Lens' (Zipper i f a) (f (Cofree f a))
Z.branches_ ((ValueF (Cofree ValueF FocusState)
  -> Identity (ValueF (Cofree ValueF FocusState)))
 -> Zipper JIndex ValueF FocusState
 -> Identity (Zipper JIndex ValueF FocusState))
-> ValueF (Cofree ValueF FocusState)
-> Zipper JIndex ValueF FocusState
-> Zipper JIndex ValueF FocusState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ObjectF (Cofree ValueF FocusState)
-> ValueF (Cofree ValueF FocusState)
forall a. ObjectF a -> ValueF a
ObjectF (Text
-> ObjectF (Cofree ValueF FocusState)
-> ObjectF (Cofree ValueF FocusState)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HM.delete Text
k ObjectF (Cofree ValueF FocusState)
hm)
        )
    -- Otherwise move up a layer and delete the key we were in.
    ValueF (Cofree ValueF FocusState)
_ -> case Zipper JIndex ValueF FocusState -> Maybe JIndex
forall i (f :: * -> *) a. Zipper i f a -> Maybe i
Z.currentIndex Zipper JIndex ValueF FocusState
z of
      -- If we don't have a parent, set the current node to null
      Maybe JIndex
Nothing ->
        Zipper JIndex ValueF FocusState
z Zipper JIndex ValueF FocusState
-> (Zipper JIndex ValueF FocusState
    -> Zipper JIndex ValueF FocusState)
-> Zipper JIndex ValueF FocusState
forall a b. a -> (a -> b) -> b
& (ValueF (Cofree ValueF FocusState)
 -> Identity (ValueF (Cofree ValueF FocusState)))
-> Zipper JIndex ValueF FocusState
-> Identity (Zipper JIndex ValueF FocusState)
forall i (f :: * -> *) a. Lens' (Zipper i f a) (f (Cofree f a))
Z.branches_ ((ValueF (Cofree ValueF FocusState)
  -> Identity (ValueF (Cofree ValueF FocusState)))
 -> Zipper JIndex ValueF FocusState
 -> Identity (Zipper JIndex ValueF FocusState))
-> ValueF (Cofree ValueF FocusState)
-> Zipper JIndex ValueF FocusState
-> Zipper JIndex ValueF FocusState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ValueF (Cofree ValueF FocusState)
forall a. ValueF a
NullF
      Just JIndex
i -> Zipper JIndex ValueF FocusState
-> Maybe (Zipper JIndex ValueF FocusState)
-> Zipper JIndex ValueF FocusState
forall a. a -> Maybe a -> a
fromMaybe Zipper JIndex ValueF FocusState
z (Maybe (Zipper JIndex ValueF FocusState)
 -> Zipper JIndex ValueF FocusState)
-> Maybe (Zipper JIndex ValueF FocusState)
-> Zipper JIndex ValueF FocusState
forall a b. (a -> b) -> a -> b
$ do
        Zipper JIndex ValueF FocusState
parent <- Zipper JIndex ValueF FocusState
z Zipper JIndex ValueF FocusState
-> (Zipper JIndex ValueF FocusState
    -> Zipper JIndex ValueF FocusState)
-> Zipper JIndex ValueF FocusState
forall a b. a -> (a -> b) -> b
& Zipper JIndex ValueF FocusState -> Zipper JIndex ValueF FocusState
rerender Zipper JIndex ValueF FocusState
-> (Zipper JIndex ValueF FocusState
    -> Maybe (Zipper JIndex ValueF FocusState))
-> Maybe (Zipper JIndex ValueF FocusState)
forall a b. a -> (a -> b) -> b
& Zipper JIndex ValueF FocusState
-> Maybe (Zipper JIndex ValueF FocusState)
forall i (f :: * -> *) a.
Idx i f a =>
Zipper i f a -> Maybe (Zipper i f a)
Z.up
        pure $
          Zipper JIndex ValueF FocusState
parent Zipper JIndex ValueF FocusState
-> (Zipper JIndex ValueF FocusState
    -> Zipper JIndex ValueF FocusState)
-> Zipper JIndex ValueF FocusState
forall a b. a -> (a -> b) -> b
& (ValueF (Cofree ValueF FocusState)
 -> Identity (ValueF (Cofree ValueF FocusState)))
-> Zipper JIndex ValueF FocusState
-> Identity (Zipper JIndex ValueF FocusState)
forall i (f :: * -> *) a. Lens' (Zipper i f a) (f (Cofree f a))
Z.branches_ ((ValueF (Cofree ValueF FocusState)
  -> Identity (ValueF (Cofree ValueF FocusState)))
 -> Zipper JIndex ValueF FocusState
 -> Identity (Zipper JIndex ValueF FocusState))
-> (ValueF (Cofree ValueF FocusState)
    -> ValueF (Cofree ValueF FocusState))
-> Zipper JIndex ValueF FocusState
-> Zipper JIndex ValueF FocusState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ \case
            ObjectF ObjectF (Cofree ValueF FocusState)
hm | Key Text
k <- JIndex
i -> ObjectF (Cofree ValueF FocusState)
-> ValueF (Cofree ValueF FocusState)
forall a. ObjectF a -> ValueF a
ObjectF (Text
-> ObjectF (Cofree ValueF FocusState)
-> ObjectF (Cofree ValueF FocusState)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HM.delete Text
k ObjectF (Cofree ValueF FocusState)
hm)
            ArrayF ArrayF (Cofree ValueF FocusState)
arr | Index Int
j <- JIndex
i -> ArrayF (Cofree ValueF FocusState)
-> ValueF (Cofree ValueF FocusState)
forall a. ArrayF a -> ValueF a
ArrayF ((Int -> Cofree ValueF FocusState -> Bool)
-> ArrayF (Cofree ValueF FocusState)
-> ArrayF (Cofree ValueF FocusState)
forall a. (Int -> a -> Bool) -> Vector a -> Vector a
Vector.ifilter (\Int
i' Cofree ValueF FocusState
_ -> Int
i' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
j) ArrayF (Cofree ValueF FocusState)
arr)
            ValueF (Cofree ValueF FocusState)
x -> ValueF (Cofree ValueF FocusState)
x

-- | Move to next/previous sibling.
sibling :: Dir -> Z.Zipper JIndex ValueF FocusState -> Editor (Z.Zipper JIndex ValueF FocusState)
sibling :: Dir
-> Zipper JIndex ValueF FocusState
-> Editor (Zipper JIndex ValueF FocusState)
sibling Dir
dir Zipper JIndex ValueF FocusState
z = Zipper JIndex ValueF FocusState
-> MaybeT Editor (Zipper JIndex ValueF FocusState)
-> Editor (Zipper JIndex ValueF FocusState)
forall a. a -> MaybeT Editor a -> Editor a
recover Zipper JIndex ValueF FocusState
z (MaybeT Editor (Zipper JIndex ValueF FocusState)
 -> Editor (Zipper JIndex ValueF FocusState))
-> MaybeT Editor (Zipper JIndex ValueF FocusState)
-> Editor (Zipper JIndex ValueF FocusState)
forall a b. (a -> b) -> a -> b
$ do
  Mode
mode <- Getting Mode EditorState Mode -> MaybeT Editor Mode
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Mode EditorState Mode
Lens EditorState EditorState Mode Mode
mode_
  case (Mode
mode, Zipper JIndex ValueF FocusState
-> ValueF (Cofree ValueF FocusState)
forall i (f :: * -> *) a. Zipper i f a -> f (Cofree f a)
Z.branches Zipper JIndex ValueF FocusState
z) of
    (KeyMove Text
k, ObjectF ObjectF (Cofree ValueF FocusState)
hm) -> do
      case (Text -> Bool) -> [Text] -> Maybe Text
findSiblingIndex (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
k) ([Text] -> Maybe Text) -> [Text] -> Maybe Text
forall a b. (a -> b) -> a -> b
$ ObjectF (Cofree ValueF FocusState) -> [Text]
forall k v. HashMap k v -> [k]
HashMap.keys ObjectF (Cofree ValueF FocusState)
hm of
        Maybe Text
Nothing -> Zipper JIndex ValueF FocusState
-> MaybeT Editor (Zipper JIndex ValueF FocusState)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Zipper JIndex ValueF FocusState
z
        Just Text
theKey -> do
          (Mode -> Identity Mode) -> EditorState -> Identity EditorState
Lens EditorState EditorState Mode Mode
mode_ ((Mode -> Identity Mode) -> EditorState -> Identity EditorState)
-> Mode -> MaybeT Editor ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Text -> Mode
KeyMove Text
theKey
          pure Zipper JIndex ValueF FocusState
z
    (Mode, ValueF (Cofree ValueF FocusState))
_ -> do
      JIndex
curI <- Maybe JIndex -> MaybeT Editor JIndex
forall a. Maybe a -> MaybeT Editor a
hoistMaybe (Maybe JIndex -> MaybeT Editor JIndex)
-> Maybe JIndex -> MaybeT Editor JIndex
forall a b. (a -> b) -> a -> b
$ Zipper JIndex ValueF FocusState -> Maybe JIndex
forall i (f :: * -> *) a. Zipper i f a -> Maybe i
Z.currentIndex Zipper JIndex ValueF FocusState
z
      Zipper JIndex ValueF FocusState
parent <- Maybe (Zipper JIndex ValueF FocusState)
-> MaybeT Editor (Zipper JIndex ValueF FocusState)
forall a. Maybe a -> MaybeT Editor a
hoistMaybe (Maybe (Zipper JIndex ValueF FocusState)
 -> MaybeT Editor (Zipper JIndex ValueF FocusState))
-> Maybe (Zipper JIndex ValueF FocusState)
-> MaybeT Editor (Zipper JIndex ValueF FocusState)
forall a b. (a -> b) -> a -> b
$ (Zipper JIndex ValueF FocusState
z Zipper JIndex ValueF FocusState
-> (Zipper JIndex ValueF FocusState
    -> Zipper JIndex ValueF FocusState)
-> Zipper JIndex ValueF FocusState
forall a b. a -> (a -> b) -> b
& Zipper JIndex ValueF FocusState -> Zipper JIndex ValueF FocusState
rerender Zipper JIndex ValueF FocusState
-> (Zipper JIndex ValueF FocusState
    -> Maybe (Zipper JIndex ValueF FocusState))
-> Maybe (Zipper JIndex ValueF FocusState)
forall a b. a -> (a -> b) -> b
& Zipper JIndex ValueF FocusState
-> Maybe (Zipper JIndex ValueF FocusState)
forall i (f :: * -> *) a.
Idx i f a =>
Zipper i f a -> Maybe (Zipper i f a)
Z.up)
      let newI :: Maybe JIndex
newI = case Zipper JIndex ValueF FocusState
-> ValueF (Cofree ValueF FocusState)
forall i (f :: * -> *) a. Zipper i f a -> f (Cofree f a)
Z.branches Zipper JIndex ValueF FocusState
parent of
            ObjectF ObjectF (Cofree ValueF FocusState)
hm -> do
              let keys :: [Text]
keys = ObjectF (Cofree ValueF FocusState) -> [Text]
forall k v. HashMap k v -> [k]
HM.keys ObjectF (Cofree ValueF FocusState)
hm
              Text
newKey <- (Text -> Bool) -> [Text] -> Maybe Text
findSiblingIndex (\Text
k -> Text -> JIndex
Key Text
k JIndex -> JIndex -> Bool
forall a. Eq a => a -> a -> Bool
== JIndex
curI) [Text]
keys
              pure $ Text -> JIndex
Key Text
newKey
            ArrayF ArrayF (Cofree ValueF FocusState)
xs -> case JIndex
curI of
              (Index Int
i) -> ArrayF (Cofree ValueF FocusState) -> Int -> Maybe JIndex
alterIndex ArrayF (Cofree ValueF FocusState)
xs Int
i
              JIndex
_ -> Maybe JIndex
forall a. Maybe a
Nothing
            StringF {} -> Maybe JIndex
forall a. Maybe a
Nothing
            NumberF {} -> Maybe JIndex
forall a. Maybe a
Nothing
            BoolF {} -> Maybe JIndex
forall a. Maybe a
Nothing
            ValueF (Cofree ValueF FocusState)
NullF -> Maybe JIndex
forall a. Maybe a
Nothing
      case Maybe JIndex
newI of
        Just JIndex
i -> Maybe (Zipper JIndex ValueF FocusState)
-> MaybeT Editor (Zipper JIndex ValueF FocusState)
forall a. Maybe a -> MaybeT Editor a
hoistMaybe (Maybe (Zipper JIndex ValueF FocusState)
 -> MaybeT Editor (Zipper JIndex ValueF FocusState))
-> Maybe (Zipper JIndex ValueF FocusState)
-> MaybeT Editor (Zipper JIndex ValueF FocusState)
forall a b. (a -> b) -> a -> b
$ JIndex
-> Zipper JIndex ValueF FocusState
-> Maybe (Zipper JIndex ValueF FocusState)
forall i (f :: * -> *) a.
Idx i f a =>
i -> Zipper i f a -> Maybe (Zipper i f a)
Z.down JIndex
i Zipper JIndex ValueF FocusState
parent
        Maybe JIndex
Nothing -> Maybe (Zipper JIndex ValueF FocusState)
-> MaybeT Editor (Zipper JIndex ValueF FocusState)
forall a. Maybe a -> MaybeT Editor a
hoistMaybe Maybe (Zipper JIndex ValueF FocusState)
forall a. Maybe a
Nothing
  where
    ((Text -> Bool) -> [Text] -> Maybe Text
findSiblingIndex, ArrayF (Cofree ValueF FocusState) -> Int -> Maybe JIndex
alterIndex) = case Dir
dir of
      Dir
Forward ->
        ( (Text -> Bool) -> [Text] -> Maybe Text
forall a. (a -> Bool) -> [a] -> Maybe a
findAfter,
          \ArrayF (Cofree ValueF FocusState)
xs Int
i -> if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< ArrayF (Cofree ValueF FocusState) -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ArrayF (Cofree ValueF FocusState)
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 then JIndex -> Maybe JIndex
forall a. a -> Maybe a
Just (Int -> JIndex
Index (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) else Maybe JIndex
forall a. Maybe a
Nothing
        )
      Dir
Backward ->
        ( (Text -> Bool) -> [Text] -> Maybe Text
forall a. (a -> Bool) -> [a] -> Maybe a
findBefore,
          \ArrayF (Cofree ValueF FocusState)
_xs Int
i -> if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then JIndex -> Maybe JIndex
forall a. a -> Maybe a
Just (Int -> JIndex
Index (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) else Maybe JIndex
forall a. Maybe a
Nothing
        )

findAfter :: (a -> Bool) -> [a] -> Maybe a
findAfter :: (a -> Bool) -> [a] -> Maybe a
findAfter a -> Bool
p [a]
xs = ((a, a) -> a) -> Maybe (a, a) -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, a) -> a
forall a b. (a, b) -> b
snd (Maybe (a, a) -> Maybe a)
-> ([(a, a)] -> Maybe (a, a)) -> [(a, a)] -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, a) -> Bool) -> [(a, a)] -> Maybe (a, a)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find (a -> Bool
p (a -> Bool) -> ((a, a) -> a) -> (a, a) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, a) -> a
forall a b. (a, b) -> a
fst) ([(a, a)] -> Maybe a) -> [(a, a)] -> Maybe a
forall a b. (a -> b) -> a -> b
$ [a] -> [a] -> [(a, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
xs (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
1 [a]
xs)

findBefore :: (a -> Bool) -> [a] -> Maybe a
findBefore :: (a -> Bool) -> [a] -> Maybe a
findBefore a -> Bool
p [a]
xs = ((a, a) -> a) -> Maybe (a, a) -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, a) -> a
forall a b. (a, b) -> b
snd (Maybe (a, a) -> Maybe a)
-> ([(a, a)] -> Maybe (a, a)) -> [(a, a)] -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, a) -> Bool) -> [(a, a)] -> Maybe (a, a)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find (a -> Bool
p (a -> Bool) -> ((a, a) -> a) -> (a, a) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, a) -> a
forall a b. (a, b) -> a
fst) ([(a, a)] -> Maybe a) -> [(a, a)] -> Maybe a
forall a b. (a -> b) -> a -> b
$ [a] -> [a] -> [(a, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
1 [a]
xs) [a]
xs

newBuffer :: Text -> Buffer
newBuffer :: Text -> Buffer
newBuffer Text
txt = Buffer -> Buffer
forall a. Monoid a => TextZipper a -> TextZipper a
TZ.gotoEOF (Buffer -> Buffer) -> Buffer -> Buffer
forall a b. (a -> b) -> a -> b
$ [Text] -> Maybe Int -> Buffer
TZ.textZipper (Text -> [Text]
Text.lines Text
txt) Maybe Int
forall a. Maybe a
Nothing

-- | Move into the current node
into :: Z.Zipper JIndex ValueF FocusState -> Editor (Z.Zipper JIndex ValueF FocusState)
into :: Zipper JIndex ValueF FocusState
-> Editor (Zipper JIndex ValueF FocusState)
into Zipper JIndex ValueF FocusState
z = do
  Mode
mode <- Getting Mode EditorState Mode -> Editor Mode
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Mode EditorState Mode
Lens EditorState EditorState Mode Mode
mode_
  case (Zipper JIndex ValueF FocusState
-> ValueF (Cofree ValueF FocusState)
forall i (f :: * -> *) a. Zipper i f a -> f (Cofree f a)
Z.branches Zipper JIndex ValueF FocusState
z, Mode
mode) of
    (ObjectF ObjectF (Cofree ValueF FocusState)
_, KeyMove Text
key) -> do
      (Mode -> Identity Mode) -> EditorState -> Identity EditorState
Lens EditorState EditorState Mode Mode
mode_ ((Mode -> Identity Mode) -> EditorState -> Identity EditorState)
-> Mode -> Editor ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Mode
Move
      pure ((Zipper JIndex ValueF FocusState
 -> Maybe (Zipper JIndex ValueF FocusState))
-> Zipper JIndex ValueF FocusState
-> Zipper JIndex ValueF FocusState
forall a. (a -> Maybe a) -> a -> a
Z.tug (JIndex
-> Zipper JIndex ValueF FocusState
-> Maybe (Zipper JIndex ValueF FocusState)
forall i (f :: * -> *) a.
Idx i f a =>
i -> Zipper i f a -> Maybe (Zipper i f a)
Z.down (Text -> JIndex
Key Text
key)) Zipper JIndex ValueF FocusState
z)
    (ObjectF ObjectF (Cofree ValueF FocusState)
hm, Mode
Move) -> do
      case (ObjectF (Cofree ValueF FocusState) -> [Text]
forall k v. HashMap k v -> [k]
HM.keys ObjectF (Cofree ValueF FocusState)
hm) [Text] -> Getting (First Text) [Text] Text -> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting (First Text) [Text] Text
forall s a. Cons s s a a => Traversal' s a
_head of
        Just Text
fstKey -> do
          (Mode -> Identity Mode) -> EditorState -> Identity EditorState
Lens EditorState EditorState Mode Mode
mode_ ((Mode -> Identity Mode) -> EditorState -> Identity EditorState)
-> Mode -> Editor ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Text -> Mode
KeyMove Text
fstKey
          pure Zipper JIndex ValueF FocusState
z
        Maybe Text
_ -> Zipper JIndex ValueF FocusState
-> Editor (Zipper JIndex ValueF FocusState)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Zipper JIndex ValueF FocusState
z
    (ArrayF {}, Mode
_) -> do
      Zipper JIndex ValueF FocusState
-> Editor (Zipper JIndex ValueF FocusState)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Zipper JIndex ValueF FocusState
 -> Editor (Zipper JIndex ValueF FocusState))
-> Zipper JIndex ValueF FocusState
-> Editor (Zipper JIndex ValueF FocusState)
forall a b. (a -> b) -> a -> b
$ (Zipper JIndex ValueF FocusState
 -> Maybe (Zipper JIndex ValueF FocusState))
-> Zipper JIndex ValueF FocusState
-> Zipper JIndex ValueF FocusState
forall a. (a -> Maybe a) -> a -> a
Z.tug (JIndex
-> Zipper JIndex ValueF FocusState
-> Maybe (Zipper JIndex ValueF FocusState)
forall i (f :: * -> *) a.
Idx i f a =>
i -> Zipper i f a -> Maybe (Zipper i f a)
Z.down (Int -> JIndex
Index Int
0)) Zipper JIndex ValueF FocusState
z
    (ValueF (Cofree ValueF FocusState), Mode)
_ -> Zipper JIndex ValueF FocusState
-> Editor (Zipper JIndex ValueF FocusState)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Zipper JIndex ValueF FocusState
z

-- | Move out of the current node
outOf :: Z.Zipper JIndex ValueF FocusState -> Editor (Z.Zipper JIndex ValueF FocusState)
outOf :: Zipper JIndex ValueF FocusState
-> Editor (Zipper JIndex ValueF FocusState)
outOf Zipper JIndex ValueF FocusState
z = do
  Mode
mode <- Getting Mode EditorState Mode -> Editor Mode
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Mode EditorState Mode
Lens EditorState EditorState Mode Mode
mode_
  Maybe Text
maybeParentKey <- case (Zipper JIndex ValueF FocusState -> Maybe JIndex
forall i (f :: * -> *) a. Zipper i f a -> Maybe i
Z.currentIndex Zipper JIndex ValueF FocusState
z) of
    Just (Key Text
k) -> Maybe Text -> Editor (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> Editor (Maybe Text))
-> Maybe Text -> Editor (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
k
    Maybe JIndex
_ -> Maybe Text -> Editor (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing

  case (Zipper JIndex ValueF FocusState
-> ValueF (Cofree ValueF FocusState)
forall i (f :: * -> *) a. Zipper i f a -> f (Cofree f a)
Z.branches Zipper JIndex ValueF FocusState
z, Mode
mode) of
    (ObjectF ObjectF (Cofree ValueF FocusState)
_, KeyMove {}) -> do
      (Mode -> Identity Mode) -> EditorState -> Identity EditorState
Lens EditorState EditorState Mode Mode
mode_ ((Mode -> Identity Mode) -> EditorState -> Identity EditorState)
-> Mode -> Editor ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Mode
Move
      pure Zipper JIndex ValueF FocusState
z
    (ValueF (Cofree ValueF FocusState), Mode)
_ -> do
      Editor () -> (Text -> Editor ()) -> Maybe Text -> Editor ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Editor ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (\Text
k -> (Mode -> Identity Mode) -> EditorState -> Identity EditorState
Lens EditorState EditorState Mode Mode
mode_ ((Mode -> Identity Mode) -> EditorState -> Identity EditorState)
-> Mode -> Editor ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Text -> Mode
KeyMove Text
k) Maybe Text
maybeParentKey
      pure ((Zipper JIndex ValueF FocusState
 -> Maybe (Zipper JIndex ValueF FocusState))
-> Zipper JIndex ValueF FocusState
-> Zipper JIndex ValueF FocusState
forall a. (a -> Maybe a) -> a -> a
Z.tug (Zipper JIndex ValueF FocusState -> Zipper JIndex ValueF FocusState
rerender (Zipper JIndex ValueF FocusState
 -> Zipper JIndex ValueF FocusState)
-> (Zipper JIndex ValueF FocusState
    -> Maybe (Zipper JIndex ValueF FocusState))
-> Zipper JIndex ValueF FocusState
-> Maybe (Zipper JIndex ValueF FocusState)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Zipper JIndex ValueF FocusState
-> Maybe (Zipper JIndex ValueF FocusState)
forall i (f :: * -> *) a.
Idx i f a =>
Zipper i f a -> Maybe (Zipper i f a)
Z.up) Zipper JIndex ValueF FocusState
z)

-- | Render the full zipper using render caches stored in each node.
fullRender :: Mode -> Z.Zipper JIndex ValueF FocusState -> PrettyJSON
fullRender :: Mode -> Zipper JIndex ValueF FocusState -> PrettyJSON
fullRender Mode
mode Zipper JIndex ValueF FocusState
z = do
  let focusedRender :: Zipper JIndex ValueF FocusState
focusedRender =
        Zipper JIndex ValueF FocusState
z Zipper JIndex ValueF FocusState
-> (Zipper JIndex ValueF FocusState
    -> Zipper JIndex ValueF FocusState)
-> Zipper JIndex ValueF FocusState
forall a b. a -> (a -> b) -> b
& (FocusState -> Identity FocusState)
-> Zipper JIndex ValueF FocusState
-> Identity (Zipper JIndex ValueF FocusState)
forall i (f :: * -> *) a. Lens' (Zipper i f a) a
Z.focus_ ((FocusState -> Identity FocusState)
 -> Zipper JIndex ValueF FocusState
 -> Identity (Zipper JIndex ValueF FocusState))
-> ((Focused -> Identity Focused)
    -> FocusState -> Identity FocusState)
-> (Focused -> Identity Focused)
-> Zipper JIndex ValueF FocusState
-> Identity (Zipper JIndex ValueF FocusState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Focused -> Identity Focused) -> FocusState -> Identity FocusState
Lens FocusState FocusState Focused Focused
focused_ ((Focused -> Identity Focused)
 -> Zipper JIndex ValueF FocusState
 -> Identity (Zipper JIndex ValueF FocusState))
-> Focused
-> Zipper JIndex ValueF FocusState
-> Zipper JIndex ValueF FocusState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Focused
Focused
          Zipper JIndex ValueF FocusState
-> (Zipper JIndex ValueF FocusState
    -> Zipper JIndex ValueF FocusState)
-> Zipper JIndex ValueF FocusState
forall a b. a -> (a -> b) -> b
& (Cofree ValueF FocusState -> Identity (Cofree ValueF FocusState))
-> Zipper JIndex ValueF FocusState
-> Identity (Zipper JIndex ValueF FocusState)
forall i (f :: * -> *) a. Lens' (Zipper i f a) (Cofree f a)
Z.unwrapped_ ((Cofree ValueF FocusState -> Identity (Cofree ValueF FocusState))
 -> Zipper JIndex ValueF FocusState
 -> Identity (Zipper JIndex ValueF FocusState))
-> (Cofree ValueF FocusState -> Cofree ValueF FocusState)
-> Zipper JIndex ValueF FocusState
-> Zipper JIndex ValueF FocusState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ \(FocusState
fs :< ValueF (Cofree ValueF FocusState)
vf) ->
            let rerendered :: PrettyJSON
rerendered = FocusState -> Mode -> ValueF PrettyJSON -> PrettyJSON
renderSubtree FocusState
fs Mode
mode (FocusState -> PrettyJSON
rendered (FocusState -> PrettyJSON)
-> (Cofree ValueF FocusState -> FocusState)
-> Cofree ValueF FocusState
-> PrettyJSON
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cofree ValueF FocusState -> FocusState
forall (w :: * -> *) a. Comonad w => w a -> a
extract (Cofree ValueF FocusState -> PrettyJSON)
-> ValueF (Cofree ValueF FocusState) -> ValueF PrettyJSON
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ValueF (Cofree ValueF FocusState)
vf)
             in (FocusState
fs {rendered :: PrettyJSON
rendered = PrettyJSON
rerendered} FocusState
-> ValueF (Cofree ValueF FocusState) -> Cofree ValueF FocusState
forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< ValueF (Cofree ValueF FocusState)
vf)
  FocusState -> PrettyJSON
rendered (FocusState -> PrettyJSON)
-> (Zipper JIndex ValueF FocusState -> FocusState)
-> Zipper JIndex ValueF FocusState
-> PrettyJSON
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FocusState -> ValueF FocusState -> FocusState)
-> Zipper JIndex ValueF FocusState -> FocusState
forall (f :: * -> *) i a.
(Functor f, Idx i f a) =>
(a -> f a -> a) -> Zipper i f a -> a
foldSpine FocusState -> ValueF FocusState -> FocusState
alg (Zipper JIndex ValueF FocusState -> PrettyJSON)
-> Zipper JIndex ValueF FocusState -> PrettyJSON
forall a b. (a -> b) -> a -> b
$ Zipper JIndex ValueF FocusState
focusedRender
  where
    alg :: FocusState -> ValueF FocusState -> FocusState
alg FocusState
fs ValueF FocusState
vf =
      FocusState
fs {rendered :: PrettyJSON
rendered = FocusState -> ValueF PrettyJSON -> PrettyJSON
rerenderCached FocusState
fs (FocusState -> PrettyJSON
rendered (FocusState -> PrettyJSON)
-> ValueF FocusState -> ValueF PrettyJSON
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ValueF FocusState
vf)}
    rerenderCached :: FocusState -> ValueF PrettyJSON -> PrettyJSON
rerenderCached FocusState
fs = \case
      ObjectF ObjectF PrettyJSON
o -> Focused -> Mode -> ObjectF PrettyJSON -> PrettyJSON
prettyObj (FocusState -> Focused
isFocused FocusState
fs) Mode
mode ObjectF PrettyJSON
o
      ArrayF ArrayF PrettyJSON
a -> Focused -> ArrayF PrettyJSON -> PrettyJSON
prettyArray (FocusState -> Focused
isFocused FocusState
fs) ArrayF PrettyJSON
a
      -- Nodes without children are never part of the spine, but just to have something
      -- we can render the cache.
      ValueF PrettyJSON
_ -> FocusState -> PrettyJSON
rendered FocusState
fs

-- | Updates the cached render of the current focus, using cached renders for subtrees.
rerender :: Z.Zipper JIndex ValueF FocusState -> Z.Zipper JIndex ValueF FocusState
rerender :: Zipper JIndex ValueF FocusState -> Zipper JIndex ValueF FocusState
rerender = (Cofree ValueF FocusState -> Identity (Cofree ValueF FocusState))
-> Zipper JIndex ValueF FocusState
-> Identity (Zipper JIndex ValueF FocusState)
forall i (f :: * -> *) a. Lens' (Zipper i f a) (Cofree f a)
Z.unwrapped_ ((Cofree ValueF FocusState -> Identity (Cofree ValueF FocusState))
 -> Zipper JIndex ValueF FocusState
 -> Identity (Zipper JIndex ValueF FocusState))
-> (Cofree ValueF FocusState -> Cofree ValueF FocusState)
-> Zipper JIndex ValueF FocusState
-> Zipper JIndex ValueF FocusState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Cofree ValueF FocusState -> Cofree ValueF FocusState
rerenderCofree

-- Rerenders a layer of a cofree structure. Doesn't re-render the children.
rerenderCofree :: Cofree ValueF FocusState -> Cofree ValueF FocusState
rerenderCofree :: Cofree ValueF FocusState -> Cofree ValueF FocusState
rerenderCofree (FocusState
fs :< ValueF (Cofree ValueF FocusState)
vf) =
  let rerendered :: PrettyJSON
rerendered = (FocusState -> Mode -> ValueF PrettyJSON -> PrettyJSON
renderSubtree FocusState
fs Mode
mode (FocusState -> PrettyJSON
rendered (FocusState -> PrettyJSON)
-> (Cofree ValueF FocusState -> FocusState)
-> Cofree ValueF FocusState
-> PrettyJSON
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cofree ValueF FocusState -> FocusState
forall (w :: * -> *) a. Comonad w => w a -> a
extract (Cofree ValueF FocusState -> PrettyJSON)
-> ValueF (Cofree ValueF FocusState) -> ValueF PrettyJSON
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ValueF (Cofree ValueF FocusState)
vf))
   in FocusState
fs {rendered :: PrettyJSON
rendered = PrettyJSON
rerendered} FocusState
-> ValueF (Cofree ValueF FocusState) -> Cofree ValueF FocusState
forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< ValueF (Cofree ValueF FocusState)
vf
  where
    -- Currently the mode is required by renderSubtree, but for the rerender cache it's
    -- irrelevant, because it only matters if we're 'focused', and if we're focused, we'll be
    -- manually rerendered later anyways.
    mode :: Mode
mode = Mode
Move

-- | Renders a subtree
renderSubtree :: FocusState -> Mode -> ValueF PrettyJSON -> PrettyJSON
renderSubtree :: FocusState -> Mode -> ValueF PrettyJSON -> PrettyJSON
renderSubtree (FocusState {isFolded :: FocusState -> Folded
isFolded = Folded
Folded, Focused
isFocused :: Focused
isFocused :: FocusState -> Focused
isFocused}) Mode
_ ValueF PrettyJSON
vf = case ValueF PrettyJSON
vf of
  ObjectF {} -> Color -> String -> PrettyJSON
colored' Color
Vty.white String
"{...}"
  ArrayF {} -> Color -> String -> PrettyJSON
colored' Color
Vty.white String
"[...]"
  StringF {} -> Color -> String -> PrettyJSON
colored' Color
Vty.green String
"\"...\""
  NumberF {} -> Color -> String -> PrettyJSON
colored' Color
Vty.blue String
"..."
  NullF {} -> Color -> String -> PrettyJSON
colored' Color
Vty.yellow String
"..."
  BoolF {} -> Color -> String -> PrettyJSON
colored' Color
Vty.magenta String
"..."
  where
    colored' :: Vty.Color -> String -> PrettyJSON
    colored' :: Color -> String -> PrettyJSON
colored' Color
col String
txt =
      Either Cursor Attr -> PrettyJSON -> PrettyJSON
forall ann. ann -> Doc ann -> Doc ann
P.annotate (Attr -> Either Cursor Attr
forall a b. b -> Either a b
Right (Attr -> Either Cursor Attr) -> Attr -> Either Cursor Attr
forall a b. (a -> b) -> a -> b
$ if Focused
isFocused Focused -> Focused -> Bool
forall a. Eq a => a -> a -> Bool
== Focused
Focused then Color -> Attr
reverseCol Color
col else Attr
Vty.defAttr Attr -> Color -> Attr
`Vty.withForeColor` Color
col) (String -> PrettyJSON
forall a ann. Pretty a => a -> Doc ann
pretty String
txt)
renderSubtree (FocusState {Focused
isFocused :: Focused
isFocused :: FocusState -> Focused
isFocused}) Mode
mode ValueF PrettyJSON
vf = case ValueF PrettyJSON
vf of
  (StringF Text
txt) -> Focused -> PrettyJSON -> PrettyJSON
cursor Focused
isFocused (PrettyJSON -> PrettyJSON) -> PrettyJSON -> PrettyJSON
forall a b. (a -> b) -> a -> b
$ case (Focused
isFocused, Mode
mode) of
    (Focused
Focused, Edit Buffer
buf) ->
      Color -> String -> PrettyJSON
colored' Color
Vty.green String
"\"" PrettyJSON -> PrettyJSON -> PrettyJSON
forall a. Semigroup a => a -> a -> a
<> Color -> Buffer -> PrettyJSON
renderBuffer Color
Vty.green Buffer
buf PrettyJSON -> PrettyJSON -> PrettyJSON
forall a. Semigroup a => a -> a -> a
<> Color -> String -> PrettyJSON
colored' Color
Vty.green String
"\""
    (Focused, Mode)
_ -> Color -> String -> PrettyJSON
colored' Color
Vty.green String
"\"" PrettyJSON -> PrettyJSON -> PrettyJSON
forall a. Semigroup a => a -> a -> a
<> Color -> String -> PrettyJSON
colored' Color
Vty.green (Text -> String
Text.unpack Text
txt) PrettyJSON -> PrettyJSON -> PrettyJSON
forall a. Semigroup a => a -> a -> a
<> Color -> String -> PrettyJSON
colored' Color
Vty.green String
"\""
  (ValueF PrettyJSON
NullF) -> Focused -> PrettyJSON -> PrettyJSON
cursor Focused
isFocused (PrettyJSON -> PrettyJSON) -> PrettyJSON -> PrettyJSON
forall a b. (a -> b) -> a -> b
$ Color -> String -> PrettyJSON
colored' Color
Vty.yellow String
"null"
  (NumberF Scientific
n) -> Focused -> PrettyJSON -> PrettyJSON
cursor Focused
isFocused (PrettyJSON -> PrettyJSON) -> PrettyJSON -> PrettyJSON
forall a b. (a -> b) -> a -> b
$ case (Focused
isFocused, Mode
mode) of
    (Focused
Focused, Edit Buffer
buf) -> Color -> Buffer -> PrettyJSON
renderBuffer Color
Vty.blue Buffer
buf
    (Focused, Mode)
_ -> Color -> String -> PrettyJSON
colored' Color
Vty.blue (Scientific -> String
forall a. Show a => a -> String
show Scientific
n)
  (BoolF Bool
b) -> Focused -> PrettyJSON -> PrettyJSON
cursor Focused
isFocused (PrettyJSON -> PrettyJSON) -> PrettyJSON -> PrettyJSON
forall a b. (a -> b) -> a -> b
$ Color -> String -> PrettyJSON
colored' Color
Vty.magenta (Text -> String
Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Tagged Bool (Identity Bool) -> Tagged Text (Identity Text)
Prism Text Text Bool Bool
boolText_ (Tagged Bool (Identity Bool) -> Tagged Text (Identity Text))
-> Bool -> Text
forall t b. AReview t b -> b -> t
# Bool
b)
  (ArrayF ArrayF PrettyJSON
xs) -> Focused -> ArrayF PrettyJSON -> PrettyJSON
prettyArray Focused
isFocused ArrayF PrettyJSON
xs
  (ObjectF ObjectF PrettyJSON
xs) -> Focused -> Mode -> ObjectF PrettyJSON -> PrettyJSON
prettyObj Focused
isFocused Mode
mode ObjectF PrettyJSON
xs
  where
    colored' :: Vty.Color -> String -> PrettyJSON
    colored' :: Color -> String -> PrettyJSON
colored' Color
col String
txt =
      Either Cursor Attr -> PrettyJSON -> PrettyJSON
forall ann. ann -> Doc ann -> Doc ann
P.annotate (Attr -> Either Cursor Attr
forall a b. b -> Either a b
Right (Attr -> Either Cursor Attr) -> Attr -> Either Cursor Attr
forall a b. (a -> b) -> a -> b
$ if Focused
isFocused Focused -> Focused -> Bool
forall a. Eq a => a -> a -> Bool
== Focused
Focused then Color -> Attr
reverseCol Color
col else Attr
Vty.defAttr Attr -> Color -> Attr
`Vty.withForeColor` Color
col) (String -> PrettyJSON
forall a ann. Pretty a => a -> Doc ann
pretty String
txt)

-- | Attr in reverse-video
reverseCol :: Vty.Color -> Vty.Attr
reverseCol :: Color -> Attr
reverseCol Color
col = Attr
Vty.defAttr Attr -> Color -> Attr
`Vty.withForeColor` Color
col Attr -> Style -> Attr
`Vty.withStyle` Style
Vty.reverseVideo

-- | Map over all children of the current node, re-rendering after changes.
mapChildren ::
  (Cofree ValueF FocusState -> Cofree ValueF FocusState) ->
  Z.Zipper JIndex ValueF FocusState ->
  Z.Zipper JIndex ValueF FocusState
mapChildren :: (Cofree ValueF FocusState -> Cofree ValueF FocusState)
-> Zipper JIndex ValueF FocusState
-> Zipper JIndex ValueF FocusState
mapChildren Cofree ValueF FocusState -> Cofree ValueF FocusState
f = (ValueF (Cofree ValueF FocusState)
 -> Identity (ValueF (Cofree ValueF FocusState)))
-> Zipper JIndex ValueF FocusState
-> Identity (Zipper JIndex ValueF FocusState)
forall i (f :: * -> *) a. Lens' (Zipper i f a) (f (Cofree f a))
Z.branches_ ((ValueF (Cofree ValueF FocusState)
  -> Identity (ValueF (Cofree ValueF FocusState)))
 -> Zipper JIndex ValueF FocusState
 -> Identity (Zipper JIndex ValueF FocusState))
-> ((Cofree ValueF FocusState
     -> Identity (Cofree ValueF FocusState))
    -> ValueF (Cofree ValueF FocusState)
    -> Identity (ValueF (Cofree ValueF FocusState)))
-> (Cofree ValueF FocusState
    -> Identity (Cofree ValueF FocusState))
-> Zipper JIndex ValueF FocusState
-> Identity (Zipper JIndex ValueF FocusState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Cofree ValueF FocusState -> Identity (Cofree ValueF FocusState))
-> ValueF (Cofree ValueF FocusState)
-> Identity (ValueF (Cofree ValueF FocusState))
forall (f :: * -> *) a b. Functor f => Setter (f a) (f b) a b
mapped ((Cofree ValueF FocusState -> Identity (Cofree ValueF FocusState))
 -> Zipper JIndex ValueF FocusState
 -> Identity (Zipper JIndex ValueF FocusState))
-> (Cofree ValueF FocusState -> Cofree ValueF FocusState)
-> Zipper JIndex ValueF FocusState
-> Zipper JIndex ValueF FocusState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Base (Cofree ValueF FocusState) (Cofree ValueF FocusState)
 -> Cofree ValueF FocusState)
-> Cofree ValueF FocusState -> Cofree ValueF FocusState
forall t a. Recursive t => (Base t a -> a) -> t -> a
FF.cata CofreeF ValueF FocusState (Cofree ValueF FocusState)
-> Cofree ValueF FocusState
Base (Cofree ValueF FocusState) (Cofree ValueF FocusState)
-> Cofree ValueF FocusState
alg
  where
    alg :: CofreeF.CofreeF ValueF FocusState (Cofree ValueF FocusState) -> Cofree ValueF FocusState
    alg :: CofreeF ValueF FocusState (Cofree ValueF FocusState)
-> Cofree ValueF FocusState
alg (FocusState
cf CofreeF.:< ValueF (Cofree ValueF FocusState)
vf) = Cofree ValueF FocusState -> Cofree ValueF FocusState
rerenderCofree (Cofree ValueF FocusState -> Cofree ValueF FocusState)
-> Cofree ValueF FocusState -> Cofree ValueF FocusState
forall a b. (a -> b) -> a -> b
$ Cofree ValueF FocusState -> Cofree ValueF FocusState
f (FocusState
cf FocusState
-> ValueF (Cofree ValueF FocusState) -> Cofree ValueF FocusState
forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< ValueF (Cofree ValueF FocusState)
vf)

prettyWith :: Pretty a => Vty.Attr -> a -> PrettyJSON
prettyWith :: Attr -> a -> PrettyJSON
prettyWith Attr
ann a
a = Either Cursor Attr -> PrettyJSON -> PrettyJSON
forall ann. ann -> Doc ann -> Doc ann
annotate (Attr -> Either Cursor Attr
forall a b. b -> Either a b
Right Attr
ann) (PrettyJSON -> PrettyJSON) -> PrettyJSON -> PrettyJSON
forall a b. (a -> b) -> a -> b
$ a -> PrettyJSON
forall a ann. Pretty a => a -> Doc ann
pretty a
a

colored :: Pretty a => Vty.Color -> a -> PrettyJSON
colored :: Color -> a -> PrettyJSON
colored Color
col a
a = Either Cursor Attr -> PrettyJSON -> PrettyJSON
forall ann. ann -> Doc ann -> Doc ann
annotate (Attr -> Either Cursor Attr
forall a b. b -> Either a b
Right (Attr -> Either Cursor Attr) -> Attr -> Either Cursor Attr
forall a b. (a -> b) -> a -> b
$ Attr
Vty.defAttr Attr -> Color -> Attr
`Vty.withForeColor` Color
col) (PrettyJSON -> PrettyJSON) -> PrettyJSON -> PrettyJSON
forall a b. (a -> b) -> a -> b
$ a -> PrettyJSON
forall a ann. Pretty a => a -> Doc ann
pretty a
a

renderBuffer :: Vty.Color -> Buffer -> PrettyJSON
renderBuffer :: Color -> Buffer -> PrettyJSON
renderBuffer Color
col Buffer
buf =
  let (Text
prefix, Text
suffix) = Int -> Text -> (Text, Text)
Text.splitAt ((Int, Int) -> Int
forall a b. (a, b) -> b
snd ((Int, Int) -> Int) -> (Int, Int) -> Int
forall a b. (a -> b) -> a -> b
$ Buffer -> (Int, Int)
forall a. TextZipper a -> (Int, Int)
TZ.cursorPosition Buffer
buf) (Buffer -> Text
bufferText Buffer
buf)
      suffixImg :: PrettyJSON
suffixImg = case Text -> Maybe (Char, Text)
Text.uncons Text
suffix of
        Maybe (Char, Text)
Nothing -> Attr -> Char -> PrettyJSON
forall a. Pretty a => Attr -> a -> PrettyJSON
prettyWith (Color -> Attr
reverseCol Color
col) Char
' '
        Just (Char
c, Text
rest) -> Attr -> Char -> PrettyJSON
forall a. Pretty a => Attr -> a -> PrettyJSON
prettyWith (Color -> Attr
reverseCol Color
col) Char
c PrettyJSON -> PrettyJSON -> PrettyJSON
forall a. Semigroup a => a -> a -> a
<> Color -> Text -> PrettyJSON
forall a. Pretty a => Color -> a -> PrettyJSON
colored Color
col Text
rest
   in Color -> Text -> PrettyJSON
forall a. Pretty a => Color -> a -> PrettyJSON
colored Color
col Text
prefix PrettyJSON -> PrettyJSON -> PrettyJSON
forall a. Semigroup a => a -> a -> a
<> PrettyJSON
suffixImg

cursor :: Focused -> PrettyJSON -> PrettyJSON
cursor :: Focused -> PrettyJSON -> PrettyJSON
cursor Focused
Focused = Either Cursor Attr -> PrettyJSON -> PrettyJSON
forall ann. ann -> Doc ann -> Doc ann
P.annotate (Cursor -> Either Cursor Attr
forall a b. a -> Either a b
Left Cursor
Render.Cursor)
cursor Focused
_ = PrettyJSON -> PrettyJSON
forall a. a -> a
id

prettyArray :: Focused -> Vector PrettyJSON -> PrettyJSON
prettyArray :: Focused -> ArrayF PrettyJSON -> PrettyJSON
prettyArray Focused
foc ArrayF PrettyJSON
vs =
  let [PrettyJSON]
inner :: [PrettyJSON] =
        ArrayF PrettyJSON -> [PrettyJSON]
forall a. Vector a -> [a]
Vector.toList ArrayF PrettyJSON
vs
          [PrettyJSON] -> ([PrettyJSON] -> [PrettyJSON]) -> [PrettyJSON]
forall a b. a -> (a -> b) -> b
& (Int -> PrettyJSON -> PrettyJSON) -> [PrettyJSON] -> [PrettyJSON]
forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap (\Int
i PrettyJSON
v -> PrettyJSON
v PrettyJSON -> PrettyJSON -> PrettyJSON
forall a. Semigroup a => a -> a -> a
<> Int -> PrettyJSON
commaKey Int
i)
   in Focused -> PrettyJSON -> PrettyJSON
cursor Focused
foc (PrettyJSON -> PrettyJSON) -> PrettyJSON -> PrettyJSON
forall a b. (a -> b) -> a -> b
$ [PrettyJSON] -> PrettyJSON
forall ann. [Doc ann] -> Doc ann
vsep ([PrettyJSON] -> PrettyJSON) -> [PrettyJSON] -> PrettyJSON
forall a b. (a -> b) -> a -> b
$ [Text -> PrettyJSON
img Text
"[", Int -> PrettyJSON -> PrettyJSON
forall ann. Int -> Doc ann -> Doc ann
indent Int
tabSize ([PrettyJSON] -> PrettyJSON
forall ann. [Doc ann] -> Doc ann
vsep [PrettyJSON]
inner), Text -> PrettyJSON
img Text
"]"]
  where
    img :: Text -> PrettyJSON
    img :: Text -> PrettyJSON
img Text
t = case Focused
foc of
      Focused
Focused -> Attr -> Text -> PrettyJSON
forall a. Pretty a => Attr -> a -> PrettyJSON
prettyWith (Color -> Attr
reverseCol Color
Vty.white) Text
t
      Focused
NotFocused -> Text -> PrettyJSON
forall a ann. Pretty a => a -> Doc ann
pretty Text
t
    commaKey :: Int -> PrettyJSON
commaKey Int
i
      | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== ArrayF PrettyJSON -> Int
forall a. Vector a -> Int
Vector.length ArrayF PrettyJSON
vs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 = PrettyJSON
forall a. Monoid a => a
mempty
      | Bool
otherwise = PrettyJSON
","

prettyObj :: Focused -> Mode -> HashMap Text PrettyJSON -> PrettyJSON
prettyObj :: Focused -> Mode -> ObjectF PrettyJSON -> PrettyJSON
prettyObj Focused
focused Mode
mode ObjectF PrettyJSON
vs =
  let inner :: PrettyJSON
      inner :: PrettyJSON
inner =
        [PrettyJSON] -> PrettyJSON
forall ann. [Doc ann] -> Doc ann
vsep
          ( ObjectF PrettyJSON -> [(Text, PrettyJSON)]
forall k v. HashMap k v -> [(k, v)]
HM.toList ObjectF PrettyJSON
vs
              [(Text, PrettyJSON)]
-> ([(Text, PrettyJSON)] -> [PrettyJSON]) -> [PrettyJSON]
forall a b. a -> (a -> b) -> b
& (Int -> (Text, PrettyJSON) -> PrettyJSON)
-> [(Text, PrettyJSON)] -> [PrettyJSON]
forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap
                ( \Int
i (Text
k, PrettyJSON
v) ->
                    [PrettyJSON] -> PrettyJSON
forall ann. [Doc ann] -> Doc ann
vsep [Text -> PrettyJSON
imgForKey Text
k PrettyJSON -> PrettyJSON -> PrettyJSON
forall a. Semigroup a => a -> a -> a
<> Text -> PrettyJSON
forall a ann. Pretty a => a -> Doc ann
pretty @Text Text
": ", Int -> PrettyJSON -> PrettyJSON
forall ann. Int -> Doc ann -> Doc ann
indent Int
tabSize (PrettyJSON
v PrettyJSON -> PrettyJSON -> PrettyJSON
forall a. Semigroup a => a -> a -> a
<> Int -> PrettyJSON
commaKey Int
i)]
                )
          )
      rendered :: PrettyJSON
rendered = [PrettyJSON] -> PrettyJSON
forall ann. [Doc ann] -> Doc ann
vsep [Text -> PrettyJSON
img Text
"{", Int -> PrettyJSON -> PrettyJSON
forall ann. Int -> Doc ann -> Doc ann
indent Int
tabSize PrettyJSON
inner, Text -> PrettyJSON
img Text
"}"]
   in case Mode
mode of
        Mode
Move -> Focused -> PrettyJSON -> PrettyJSON
cursor Focused
focused PrettyJSON
rendered
        Mode
_ -> PrettyJSON
rendered
  where
    hmSize :: Int
hmSize = ObjectF PrettyJSON -> Int
forall k v. HashMap k v -> Int
HM.size ObjectF PrettyJSON
vs
    commaKey :: Int -> PrettyJSON
commaKey Int
i
      | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
hmSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 = PrettyJSON
forall a. Monoid a => a
mempty
      | Bool
otherwise = PrettyJSON
","
    imgForKey :: Text -> PrettyJSON
imgForKey Text
k = case Focused
focused of
      Focused
NotFocused -> Color -> String -> PrettyJSON
forall a. Pretty a => Color -> a -> PrettyJSON
colored Color
Vty.cyan (Text -> String
forall a. Show a => a -> String
show Text
k)
      Focused
Focused -> case Mode
mode of
        KeyMove Text
focKey | Text
focKey Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
k -> Focused -> PrettyJSON -> PrettyJSON
cursor Focused
Focused (PrettyJSON -> PrettyJSON) -> PrettyJSON -> PrettyJSON
forall a b. (a -> b) -> a -> b
$ Attr -> String -> PrettyJSON
forall a. Pretty a => Attr -> a -> PrettyJSON
prettyWith (Color -> Attr
reverseCol Color
Vty.cyan) (Text -> String
forall a. Show a => a -> String
show Text
focKey)
        KeyEdit Text
focKey Buffer
buf | Text
focKey Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
k -> Focused -> PrettyJSON -> PrettyJSON
cursor Focused
Focused (PrettyJSON -> PrettyJSON) -> PrettyJSON -> PrettyJSON
forall a b. (a -> b) -> a -> b
$ Color -> Char -> PrettyJSON
forall a. Pretty a => Color -> a -> PrettyJSON
colored Color
Vty.cyan Char
'"' PrettyJSON -> PrettyJSON -> PrettyJSON
forall a. Semigroup a => a -> a -> a
<> Color -> Buffer -> PrettyJSON
renderBuffer Color
Vty.cyan Buffer
buf PrettyJSON -> PrettyJSON -> PrettyJSON
forall a. Semigroup a => a -> a -> a
<> Color -> Char -> PrettyJSON
forall a. Pretty a => Color -> a -> PrettyJSON
colored Color
Vty.cyan Char
'"'
        Mode
_ -> Color -> String -> PrettyJSON
forall a. Pretty a => Color -> a -> PrettyJSON
colored Color
Vty.cyan (Text -> String
forall a. Show a => a -> String
show Text
k)
    img :: Text -> PrettyJSON
    img :: Text -> PrettyJSON
img Text
t = case (Focused
focused, Mode
mode) of
      (Focused
Focused, Mode
Move) -> Attr -> Text -> PrettyJSON
forall a. Pretty a => Attr -> a -> PrettyJSON
prettyWith (Color -> Attr
reverseCol Color
Vty.white) Text
t
      (Focused, Mode)
_ -> Text -> PrettyJSON
forall a ann. Pretty a => a -> Doc ann
pretty Text
t

-- Orphan instances
instance Eq1 ValueF where
  liftEq :: (a -> b -> Bool) -> ValueF a -> ValueF b -> Bool
liftEq a -> b -> Bool
f ValueF a
vf1 ValueF b
vf2 = case (ValueF a
vf1, ValueF b
vf2) of
    (ObjectF ObjectF a
l, ObjectF ObjectF b
r) -> (a -> b -> Bool) -> ObjectF a -> ObjectF b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
f ObjectF a
l ObjectF b
r
    (ArrayF ArrayF a
l, ArrayF ArrayF b
r) -> (a -> b -> Bool) -> ArrayF a -> ArrayF b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
f ArrayF a
l ArrayF b
r
    (ValueF a
NullF, ValueF b
NullF) -> Bool
True
    (StringF Text
l, StringF Text
r) -> Text
l Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
r
    (NumberF Scientific
l, NumberF Scientific
r) -> Scientific
l Scientific -> Scientific -> Bool
forall a. Eq a => a -> a -> Bool
== Scientific
r
    (BoolF Bool
l, BoolF Bool
r) -> Bool
l Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
r
    (ValueF a, ValueF b)
_ -> Bool
False

instance Ord1 ValueF where
  liftCompare :: (a -> b -> Ordering) -> ValueF a -> ValueF b -> Ordering
liftCompare a -> b -> Ordering
f ValueF a
vf1 ValueF b
vf2 = case (ValueF a
vf1, ValueF b
vf2) of
    (ObjectF ObjectF a
l, ObjectF ObjectF b
r) -> (a -> b -> Ordering) -> ObjectF a -> ObjectF b -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
f ObjectF a
l ObjectF b
r
    (ArrayF ArrayF a
l, ArrayF ArrayF b
r) -> (a -> b -> Ordering) -> ArrayF a -> ArrayF b -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
f ArrayF a
l ArrayF b
r
    (ValueF a
NullF, ValueF b
NullF) -> Ordering
EQ
    (StringF Text
l, StringF Text
r) -> Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Text
l Text
r
    (NumberF Scientific
l, NumberF Scientific
r) -> Scientific -> Scientific -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Scientific
l Scientific
r
    (BoolF Bool
l, BoolF Bool
r) -> Bool -> Bool -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Bool
l Bool
r
    (ValueF a
NullF, ValueF b
_) -> Ordering
LT
    (ValueF a
_, ValueF b
NullF) -> Ordering
GT
    (BoolF Bool
_, ValueF b
_) -> Ordering
LT
    (ValueF a
_, BoolF Bool
_) -> Ordering
GT
    (NumberF Scientific
_, ValueF b
_) -> Ordering
LT
    (ValueF a
_, NumberF Scientific
_) -> Ordering
GT
    (StringF Text
_, ValueF b
_) -> Ordering
LT
    (ValueF a
_, StringF Text
_) -> Ordering
GT
    (ArrayF ArrayF a
_, ValueF b
_) -> Ordering
LT
    (ValueF a
_, ArrayF ArrayF b
_) -> Ordering
GT

data JIndex
  = Index Int
  | Key Text
  deriving (Int -> JIndex -> ShowS
[JIndex] -> ShowS
JIndex -> String
(Int -> JIndex -> ShowS)
-> (JIndex -> String) -> ([JIndex] -> ShowS) -> Show JIndex
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JIndex] -> ShowS
$cshowList :: [JIndex] -> ShowS
show :: JIndex -> String
$cshow :: JIndex -> String
showsPrec :: Int -> JIndex -> ShowS
$cshowsPrec :: Int -> JIndex -> ShowS
Show, JIndex -> JIndex -> Bool
(JIndex -> JIndex -> Bool)
-> (JIndex -> JIndex -> Bool) -> Eq JIndex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JIndex -> JIndex -> Bool
$c/= :: JIndex -> JIndex -> Bool
== :: JIndex -> JIndex -> Bool
$c== :: JIndex -> JIndex -> Bool
Eq, Eq JIndex
Eq JIndex
-> (JIndex -> JIndex -> Ordering)
-> (JIndex -> JIndex -> Bool)
-> (JIndex -> JIndex -> Bool)
-> (JIndex -> JIndex -> Bool)
-> (JIndex -> JIndex -> Bool)
-> (JIndex -> JIndex -> JIndex)
-> (JIndex -> JIndex -> JIndex)
-> Ord JIndex
JIndex -> JIndex -> Bool
JIndex -> JIndex -> Ordering
JIndex -> JIndex -> JIndex
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: JIndex -> JIndex -> JIndex
$cmin :: JIndex -> JIndex -> JIndex
max :: JIndex -> JIndex -> JIndex
$cmax :: JIndex -> JIndex -> JIndex
>= :: JIndex -> JIndex -> Bool
$c>= :: JIndex -> JIndex -> Bool
> :: JIndex -> JIndex -> Bool
$c> :: JIndex -> JIndex -> Bool
<= :: JIndex -> JIndex -> Bool
$c<= :: JIndex -> JIndex -> Bool
< :: JIndex -> JIndex -> Bool
$c< :: JIndex -> JIndex -> Bool
compare :: JIndex -> JIndex -> Ordering
$ccompare :: JIndex -> JIndex -> Ordering
$cp1Ord :: Eq JIndex
Ord)

instance FunctorWithIndex JIndex ValueF

instance FoldableWithIndex JIndex ValueF

instance TraversableWithIndex JIndex ValueF where
  itraverse :: (JIndex -> a -> f b) -> ValueF a -> f (ValueF b)
itraverse JIndex -> a -> f b
f = \case
    ValueF a
NullF -> ValueF b -> f (ValueF b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ValueF b
forall a. ValueF a
NullF
    StringF Text
txt -> ValueF b -> f (ValueF b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> ValueF b
forall a. Text -> ValueF a
StringF Text
txt)
    NumberF Scientific
sci -> ValueF b -> f (ValueF b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Scientific -> ValueF b
forall a. Scientific -> ValueF a
NumberF Scientific
sci)
    BoolF Bool
b -> ValueF b -> f (ValueF b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> ValueF b
forall a. Bool -> ValueF a
BoolF Bool
b)
    ObjectF ObjectF a
hm -> ObjectF b -> ValueF b
forall a. ObjectF a -> ValueF a
ObjectF (ObjectF b -> ValueF b) -> f (ObjectF b) -> f (ValueF b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> a -> f b) -> ObjectF a -> f (ObjectF b)
forall i (t :: * -> *) (f :: * -> *) a b.
(TraversableWithIndex i t, Applicative f) =>
(i -> a -> f b) -> t a -> f (t b)
itraverse (\Text
k a
a -> JIndex -> a -> f b
f (Text -> JIndex
Key Text
k) a
a) ObjectF a
hm
    ArrayF ArrayF a
arr -> ArrayF b -> ValueF b
forall a. ArrayF a -> ValueF a
ArrayF (ArrayF b -> ValueF b) -> f (ArrayF b) -> f (ValueF b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> a -> f b) -> ArrayF a -> f (ArrayF b)
forall i (t :: * -> *) (f :: * -> *) a b.
(TraversableWithIndex i t, Applicative f) =>
(i -> a -> f b) -> t a -> f (t b)
itraverse (\Int
k a
a -> JIndex -> a -> f b
f (Int -> JIndex
Index Int
k) a
a) ArrayF a
arr

type instance Index (ValueF a) = JIndex

type instance IxValue (ValueF a) = a

instance Ixed (ValueF a) where
  ix :: Index (ValueF a) -> Traversal' (ValueF a) (IxValue (ValueF a))
ix (Index i) IxValue (ValueF a) -> f (IxValue (ValueF a))
f (ArrayF ArrayF a
xs) = ArrayF a -> ValueF a
forall a. ArrayF a -> ValueF a
ArrayF (ArrayF a -> ValueF a) -> f (ArrayF a) -> f (ValueF a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Index (ArrayF a)
-> (IxValue (ArrayF a) -> f (IxValue (ArrayF a)))
-> ArrayF a
-> f (ArrayF a)
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
Index (ArrayF a)
i IxValue (ValueF a) -> f (IxValue (ValueF a))
IxValue (ArrayF a) -> f (IxValue (ArrayF a))
f ArrayF a
xs
  ix (Key k) IxValue (ValueF a) -> f (IxValue (ValueF a))
f (ObjectF ObjectF a
xs) = ObjectF a -> ValueF a
forall a. ObjectF a -> ValueF a
ObjectF (ObjectF a -> ValueF a) -> f (ObjectF a) -> f (ValueF a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Index (ObjectF a)
-> (IxValue (ObjectF a) -> f (IxValue (ObjectF a)))
-> ObjectF a
-> f (ObjectF a)
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Text
Index (ObjectF a)
k IxValue (ObjectF a) -> f (IxValue (ObjectF a))
IxValue (ValueF a) -> f (IxValue (ValueF a))
f ObjectF a
xs
  ix Index (ValueF a)
_ IxValue (ValueF a) -> f (IxValue (ValueF a))
_ ValueF a
x = ValueF a -> f (ValueF a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ValueF a
x

toCofree :: (Value -> Cofree ValueF FocusState)
toCofree :: Value -> Cofree ValueF FocusState
toCofree Value
t = (ValueF (Cofree ValueF FocusState) -> Cofree ValueF FocusState)
-> (Value -> ValueF Value) -> Value -> Cofree ValueF FocusState
forall (f :: * -> *) b a.
Functor f =>
(f b -> b) -> (a -> f a) -> a -> b
FF.hylo ValueF (Cofree ValueF FocusState) -> Cofree ValueF FocusState
alg Value -> ValueF Value
forall t. Recursive t => t -> Base t t
FF.project (Value -> Cofree ValueF FocusState)
-> Value -> Cofree ValueF FocusState
forall a b. (a -> b) -> a -> b
$ Value
t
  where
    defaultFs :: FocusState
defaultFs = Focused -> Folded -> PrettyJSON -> FocusState
FocusState Focused
NotFocused Folded
NotFolded PrettyJSON
forall a. Monoid a => a
mempty
    mode :: Mode
mode = Mode
Move
    alg :: ValueF (Cofree ValueF FocusState) -> Cofree ValueF FocusState
    alg :: ValueF (Cofree ValueF FocusState) -> Cofree ValueF FocusState
alg ValueF (Cofree ValueF FocusState)
vf = FocusState
defaultFs {rendered :: PrettyJSON
rendered = FocusState -> Mode -> ValueF PrettyJSON -> PrettyJSON
renderSubtree FocusState
defaultFs Mode
mode (FocusState -> PrettyJSON
rendered (FocusState -> PrettyJSON)
-> (Cofree ValueF FocusState -> FocusState)
-> Cofree ValueF FocusState
-> PrettyJSON
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cofree ValueF FocusState -> FocusState
forall (w :: * -> *) a. Comonad w => w a -> a
extract (Cofree ValueF FocusState -> PrettyJSON)
-> ValueF (Cofree ValueF FocusState) -> ValueF PrettyJSON
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ValueF (Cofree ValueF FocusState)
vf)} FocusState
-> ValueF (Cofree ValueF FocusState) -> Cofree ValueF FocusState
forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< ValueF (Cofree ValueF FocusState)
vf

helpImg :: Vty.Image
helpImg :: Image
helpImg =
  let helps :: [(Text, Text)]
helps =
        [ (Text
"h", Text
"ascend"),
          (Text
"l", Text
"descend"),
          (Text
"j", Text
"next sibling"),
          (Text
"k", Text
"previous sibling"),
          (Text
"J", Text
"move down (in array)"),
          (Text
"K", Text
"move up (in array)"),
          (Text
"i", Text
"enter edit mode (string/number)"),
          (Text
"<C-s>", Text
"save file"),
          (Text
"<SPACE>", Text
"toggle boolean"),
          (Text
"<ESC>", Text
"exit edit mode"),
          (Text
"<BS>", Text
"delete key/element"),
          (Text
"<ENTER>", Text
"add new key/element (object/array)"),
          (Text
"<TAB>", Text
"toggle fold"),
          (Text
"f", Text
"unfold all children"),
          (Text
"F", Text
"fold all children"),
          (Text
"s", Text
"replace element with string"),
          (Text
"b", Text
"replace element with bool"),
          (Text
"n", Text
"replace element with number"),
          (Text
"N", Text
"replace element with null"),
          (Text
"a", Text
"replace element with array"),
          (Text
"o", Text
"replace element with object"),
          (Text
"u", Text
"undo last change (undo buffer keeps 100 states)"),
          (Text
"<C-r>", Text
"redo from undo states"),
          (Text
"y", Text
"copy current value into buffer (and clipboard)"),
          (Text
"p", Text
"paste value from buffer over current value"),
          (Text
"x", Text
"cut a value, equivalent to a copy -> delete"),
          (Text
"q | ctrl-c", Text
"quit without saving. Due to a bug, tap twice")
        ]

      ([Image]
keys, [Image]
descs) =
        [(Image, Image)] -> ([Image], [Image])
forall a b. [(a, b)] -> ([a], [b])
unzip
          ( [(Text, Text)]
helps [(Text, Text)]
-> ((Text, Text) -> (Image, Image)) -> [(Image, Image)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(Text
key, Text
desc) ->
              ( Attr -> Text -> Image
Vty.text' (Attr
Vty.defAttr Attr -> Color -> Attr
`Vty.withForeColor` Color
Vty.green) (Text
key Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": "),
                Attr -> Text -> Image
Vty.text' Attr
Vty.defAttr Text
desc
              )
          )
   in ([Image] -> Image
Vty.vertCat [Image]
keys Image -> Image -> Image
Vty.<|> [Image] -> Image
Vty.vertCat [Image]
descs)

-- | Recomputes the spine at the current position, then at every position from that point
-- upwards until the zipper is closed, returning the result.
foldSpine :: (Functor f, Z.Idx i f a) => (a -> f a -> a) -> Z.Zipper i f a -> a
foldSpine :: (a -> f a -> a) -> Zipper i f a -> a
foldSpine a -> f a -> a
f Zipper i f a
z =
  case Zipper i f a -> Maybe (Zipper i f a)
forall i (f :: * -> *) a.
Idx i f a =>
Zipper i f a -> Maybe (Zipper i f a)
Z.up Zipper i f a
z of
    Maybe (Zipper i f a)
Nothing -> Zipper i f a
z Zipper i f a -> Getting a (Zipper i f a) a -> a
forall s a. s -> Getting a s a -> a
^. Getting a (Zipper i f a) a
forall i (f :: * -> *) a. Lens' (Zipper i f a) a
Z.focus_
    Just Zipper i f a
parent ->
      let next :: a
next = a -> f a -> a
f (Zipper i f a
parent Zipper i f a -> Getting a (Zipper i f a) a -> a
forall s a. s -> Getting a s a -> a
^. Getting a (Zipper i f a) a
forall i (f :: * -> *) a. Lens' (Zipper i f a) a
Z.focus_) ((Cofree f a -> a) -> f (Cofree f a) -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Cofree f a -> a
forall (w :: * -> *) a. Comonad w => w a -> a
Comonad.extract (f (Cofree f a) -> f a)
-> (Zipper i f a -> f (Cofree f a)) -> Zipper i f a -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Zipper i f a -> f (Cofree f a)
forall i (f :: * -> *) a. Zipper i f a -> f (Cofree f a)
Z.branches (Zipper i f a -> f a) -> Zipper i f a -> f a
forall a b. (a -> b) -> a -> b
$ Zipper i f a
parent)
       in (a -> f a -> a) -> Zipper i f a -> a
forall (f :: * -> *) i a.
(Functor f, Idx i f a) =>
(a -> f a -> a) -> Zipper i f a -> a
foldSpine a -> f a -> a
f (Zipper i f a
parent Zipper i f a -> (Zipper i f a -> Zipper i f a) -> Zipper i f a
forall a b. a -> (a -> b) -> b
& (a -> Identity a) -> Zipper i f a -> Identity (Zipper i f a)
forall i (f :: * -> *) a. Lens' (Zipper i f a) a
Z.focus_ ((a -> Identity a) -> Zipper i f a -> Identity (Zipper i f a))
-> a -> Zipper i f a -> Zipper i f a
forall s t a b. ASetter s t a b -> b -> s -> t
.~ a
next)

data UndoZipper a
  = UndoZipper
      (Seq a)
      -- ^ undo states
      (Seq a)
      -- ^ redo states