{-# 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
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
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})
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))
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
footerImg :: Editor Vty.Image
= 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
]
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
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
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
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 [] ->
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
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
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
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
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)
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
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)
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
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))
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))
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))
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))
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)
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
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
""))
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)
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)
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)
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
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
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
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
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
KChar Char
'\t' -> 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 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)
KChar Char
'F' -> 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
$ (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
KChar Char
'f' -> 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
$ (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
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'
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
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 :: 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
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)
)
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
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
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
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
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)
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
ValueF PrettyJSON
_ -> FocusState -> PrettyJSON
rendered FocusState
fs
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
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
mode :: Mode
mode = Mode
Move
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)
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
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
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)
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)
(Seq a)