Further work

1 files changed, 95 insertions, 47 deletions

diff --git a/interactive-edit-lens/src/Interact.hs b/interactive-edit-lens/src/Interact.hs
index 0074e86..662052b 100644
--- a/interactive-edit-lens/src/Interact.hs
+++ b/interactive-edit-lens/src/Interact.hs
@@ -14,6 +14,7 @@ import Interact.Types
 
 import Data.Text (Text)
 import qualified Data.Text as Text
+import qualified Data.Text.IO as Text
 
 import Data.Text.Zipper
 
@@ -41,6 +42,7 @@ import Brick hiding (on)
 import Brick.Focus
 import Brick.Widgets.Center
 import Brick.Widgets.Border
+import Brick.Widgets.FileBrowser
 import Graphics.Vty hiding (showCursor)
 
 import Config.Dyre
@@ -48,14 +50,20 @@ import Config.Dyre
 import System.IO.Unsafe
 import Debug.Trace
 
-interactiveEditLens :: (Params (InteractConfig c) -> Params (InteractConfig c)) -> InteractConfig c -> IO ()
+import System.CPUTime
+import Text.Printf
+
+import Control.Exception (evaluate)
+import Control.DeepSeq
+
+interactiveEditLens :: forall c. NFData c => (Params (InteractConfig c) -> Params (InteractConfig c)) -> InteractConfig c -> IO ()
 interactiveEditLens f = wrapMain . f $ defaultParams
   { projectName = "interact-edit-lens"
   , showError   = \s err -> s & compileError .~ Just err
   , realMain    = interactiveEditLens'
   }
 
-interactiveEditLens' :: forall c. InteractConfig c -> IO ()
+interactiveEditLens' :: forall c. NFData c => InteractConfig c -> IO ()
 interactiveEditLens' cfg@InteractConfig{..}
   | Just err <- icfgCompileError
   = hPutStrLn stderr err
@@ -89,9 +97,8 @@ interactiveEditLens' cfg@InteractConfig{..}
   where
     infix 1 &?~
     
-    (&?~) :: a -> RWS (InteractConfig c) () a b -> a
+    (&?~), actOn :: a -> RWS (InteractConfig c) () a b -> a
     st &?~ act = (\(s, ()) -> s) $ execRWS act cfg st
-
     actOn = (&?~)
 
     initialState :: InteractState c
@@ -101,6 +108,8 @@ interactiveEditLens' cfg@InteractConfig{..}
       , istRight = (Last Valid, Last (init @(StringEdits Natural Char), 0), mempty)
       , istFocus = focusRing [LeftEditor, RightEditor] &
                      focusSetCurrent (case icfgInitial of InitialRight _ -> RightEditor; _other -> LeftEditor)
+      , istActive = True
+      , istLoadBrowser = Nothing
       }
 
     app :: InteractApp c
@@ -109,10 +118,15 @@ interactiveEditLens' cfg@InteractConfig{..}
     appDraw :: InteractState c -> [Widget InteractName]
     appDraw InteractState{..} = [ editors ]
       where
-        editors = hBox
-          [ mbInvalid (withFocusRing istFocus renderEditor') (istLeft `WithName` LeftEditor)
-          , vBorder
-          , mbInvalid (withFocusRing istFocus renderEditor') (istRight `WithName` RightEditor)
+        editors = vBox
+          [ case istLoadBrowser of
+              Nothing -> hBox
+                [ mbInvalid (withFocusRing istFocus renderEditor') (istLeft `WithName` LeftEditor)
+                , vBorder
+                , mbInvalid (withFocusRing istFocus renderEditor') (istRight `WithName` RightEditor)
+                ]
+              Just lBrowser -> renderFileBrowser True lBrowser
+          , hCenter . str $ bool "Inactive" "" istActive
           ]
         renderEditor' :: Bool -> (Seq Char, Int) `WithName` InteractName -> Widget InteractName
         renderEditor' foc ((content, cPos) `WithName` n)
@@ -133,42 +147,75 @@ interactiveEditLens' cfg@InteractConfig{..}
         mbInvalid f ((Last Valid  , Last x, _) `WithName` n) = f $ x `WithName` n
 
     appHandleEvent :: InteractState c -> BrickEvent InteractName InteractEvent -> EventM InteractName (Next (InteractState c))
-    appHandleEvent st@InteractState{..} (VtyEvent ev) = case ev of
-      EvKey  KEsc        []      -> halt st
-      EvKey (KChar 'c')  [MCtrl] -> halt st
-      EvKey (KChar '\t') []      -> continue $ st & focus %~ focusNext
-      EvKey  KBackTab    []      -> continue $ st & focus %~ focusPrev
-      EvKey (KChar 'a')  [MCtrl] -> continue $ st &?~ doMove
-        (moveSplit (== '\n') $ \(c, (l, p)) -> if any (== '\n') (c l) || Seq.null (c l) then (pred l, 0) else (l, 0))
-      EvKey (KChar 'e')  [MCtrl] -> continue $ st &?~ doMove
-        (moveSplit (== '\n') $ \(c, (l, p)) -> if any (== '\n') $ c l then (pred l, Seq.length . c $ pred l) else (l, Seq.length $ c l))
-      EvKey  KLeft       [MCtrl] -> continue $ st &?~ doMove
-        (moveSplit isSpace   $ \(c, (l, _)) -> if any isSpace (c l) || Seq.null (c l) then (pred l, 0) else (l - 2, 0))
-      EvKey  KRight      [MCtrl] -> continue $ st &?~ doMove
-        (moveSplit isSpace   $ \(c, (l, _)) -> if any isSpace $ c l then (succ l, 0) else (l + 2, 0))
-      EvKey  KUp         []      -> continue $ st &?~ doMove
-        (moveSplit (== '\n') $ \(c, (l, p)) -> if any (== '\n') (c l) || Seq.null (c l) then (pred l, p) else (l - 2, p))
-      EvKey  KDown       []      -> continue $ st &?~ doMove
-        (moveSplit (== '\n') $ \(c, (l, p)) -> if any (== '\n') (c l) then (succ l, p) else (l + 2, p))
-      EvKey  KLeft       []      -> continue $ st &?~ doMove moveLeft
-      EvKey  KRight      []      -> continue $ st &?~ doMove moveRight
-      EvKey  KDel        []      -> continue $ st &?~ doEdit (delete 0)
-      EvKey  KBS         []      -> continue . actOn st $ do
-        focused' <- preuse $ focused . _2 . _Wrapped
-        doEdit . delete $ -1
-        unless (maybe False ((==) <$> view _2 <*> view (_1 . to Seq.length)) focused') $
-          doMove moveLeft
-      EvKey (KChar c)    []      -> continue . actOn st $ do
-        doEdit $ insert 0 c
-        doMove moveRight
-      EvKey KEnter       []      -> continue . actOn st $ do
-        doEdit $ insert 0 '\n'
-        doMove moveRight
-      other                      -> suspendAndResume $ do
-        traceIO $ "Unhandled event:\n\t" ++ show other
-        return st
-      -- where
-      --   editorMovement f = continue $ st & focused . _Just . editContentsL %~ f
+    appHandleEvent st@InteractState{..} (VtyEvent ev)
+      | Nothing <- istLoadBrowser = case ev of
+          EvKey  KEsc        []      -> halt st
+          EvKey (KChar 'c')  [MCtrl] -> halt st
+          EvKey (KChar '\t') []      -> continue . actOn st . runMaybeT $ do
+            guard =<< use active
+            focus %= focusNext
+          EvKey  KBackTab    []      -> continue . actOn st . runMaybeT $ do
+            guard =<< use active
+            focus %= focusPrev
+          EvKey (KChar 'a')  [MCtrl] -> continue $ st &?~ doMove
+            (moveSplit (== '\n') $ \(c, (l, p)) -> if any (== '\n') (c l) || Seq.null (c l) then (pred l, 0) else (l, 0))
+          EvKey (KChar 'e')  [MCtrl] -> continue $ st &?~ doMove
+            (moveSplit (== '\n') $ \(c, (l, p)) -> if any (== '\n') $ c l then (pred l, Seq.length . c $ pred l) else (l, Seq.length $ c l))
+          EvKey  KLeft       [MCtrl] -> continue $ st &?~ doMove
+            (moveSplit isSpace   $ \(c, (l, _)) -> if any isSpace (c l) || Seq.null (c l) then (pred l, 0) else (l - 2, 0))
+          EvKey  KRight      [MCtrl] -> continue $ st &?~ doMove
+            (moveSplit isSpace   $ \(c, (l, _)) -> if any isSpace $ c l then (succ l, 0) else (l + 2, 0))
+          EvKey  KUp         []      -> continue $ st &?~ doMove
+            (moveSplit (== '\n') $ \(c, (l, p)) -> if any (== '\n') (c l) || Seq.null (c l) then (pred l, p) else (l - 2, p))
+          EvKey  KDown       []      -> continue $ st &?~ doMove
+            (moveSplit (== '\n') $ \(c, (l, p)) -> if any (== '\n') (c l) then (succ l, p) else (l + 2, p))
+          EvKey  KLeft       []      -> continue $ st &?~ doMove moveLeft
+          EvKey  KRight      []      -> continue $ st &?~ doMove moveRight
+          EvKey  KDel        []      -> continue $ st &?~ doEdit (delete 0)
+          EvKey  KBS         []      -> continue . actOn st $ do
+            focused' <- preuse $ focused . _2 . _Wrapped
+            doEdit . delete $ -1
+            unless (maybe False ((==) <$> view _2 <*> view (_1 . to Seq.length)) focused') $
+              doMove moveLeft
+          EvKey (KChar c)    []      -> continue . actOn st $ do
+            doEdit $ insert 0 c
+            doMove moveRight
+          EvKey KEnter       []      -> continue . actOn st $ do
+            doEdit $ insert 0 '\n'
+            doMove moveRight
+          EvKey (KChar 'p')  [MCtrl]
+            | istActive -> do
+                void . liftIO . evaluate . force . ($ st) $ (,,) <$> view left <*> view right <*> view complement
+                continue $ st & active .~ False
+            | otherwise -> do
+                let st' = actOn st $ do
+                      active .= True
+                      doEdit mempty
+                before <- liftIO getCPUTime
+                void . liftIO . evaluate . force . ($ st') $ (,,) <$> view left <*> view right <*> view complement
+                after <- liftIO getCPUTime
+                suspendAndResume $ do
+                  printf "Resume took %.12fs\n" (fromInteger (after - before) * 1e-12 :: Double)
+                  return st'
+          EvKey (KChar 'o')  [MCtrl] -> do
+            lBrowser <- liftIO $ newFileBrowser selectNonDirectories LoadBrowser Nothing
+            continue $ st & loadBrowser .~ Just lBrowser
+          other                      -> suspendAndResume $ do
+            traceIO $ "Unhandled event:\n\t" ++ show other
+            return st
+          -- where
+          --   editorMovement f = continue $ st & focused . _Just . editContentsL %~ f
+      | Just lBrowser <- istLoadBrowser = do
+          lBrowser' <- handleFileBrowserEvent ev lBrowser
+          case fileBrowserSelection lBrowser' of
+            [] -> continue $ st &?~ loadBrowser .= Just lBrowser'
+            (FileInfo{..} : _) -> do
+              insEdit <- divInit . view charseq <$> liftIO (Text.readFile fileInfoFilePath)
+              let st' = actOn st $ do
+                    doEdit $ (insEdit :: StringEdits Natural Char) & stringEdits . sePos %~ fromIntegral
+                    loadBrowser .= Nothing
+              continue st'
+              
     appHandleEvent st _ = continue st
 
     doMove = zoom $ focused . _2 . _Wrapped
@@ -259,9 +306,10 @@ doEdit relativeEdit = void . runMaybeT $ do
         | otherwise = currentPos
   aL . _2 %= (<> Last (newContent, currentPos'))
   absoluteEdit' <- uses (aL . _3) (absoluteEdit `mappend`)
-  bEdits <- prop direction absoluteEdit'
-  bDom <- use $ bL . _2 . _Wrapped . _1
-  case bDom `apply` bEdits of
+  bRes <- runMaybeT $ do
+    guard =<< use active
+    (,) <$> use (bL . _2 . _Wrapped . _1) <*> prop direction absoluteEdit'
+  case uncurry apply =<< bRes of
     Nothing -> do
       bL . _1 %= (<> Last Invalid)
       aL . _3 .= absoluteEdit'