Action: init

1 files changed, 1 insertions, 171 deletions

diff --git a/test5.hs b/test5.hs
index fc46495..f3012b9 100644
--- a/test5.hs
+++ b/test5.hs
@@ -19,6 +19,7 @@ import qualified Notmuch.SearchResult as Notmuch
 import qualified System.Console.Terminal.Size as Term
 import Blessings.String (Blessings(Plain,SGR),pp)
 import qualified Blessings.Internal as Blessings
+import Action
 import Control.Concurrent
 import Control.Exception
 import Control.Monad
@@ -338,172 +339,6 @@ mousemap info = \q ->
     return q { flashMessage = SGR [38,5,202] $ Plain $ show info }
 
 
-defaultMouse1Click :: Monad m => Int -> State -> m State
-defaultMouse1Click y q@State{..} = do
-    let linearClickPos =
-            let i = (y - length headBuffer + yoffset) - 1 {-zero-based-}
-            in if 0 <= i && i < length treeBuffer
-                then Just i
-                else Nothing
-    case linearClickPos of
-        Nothing ->
-            return q
-                { flashMessage = Plain $ "nothing to click"
-                }
-        Just i ->
-            return q
-                { cursor = findNextN i $ Z.root cursor
-                }
-
-
-
-topOverrun :: State -> Int
-topOverrun State{..} =
-    max 0 (- (linearPos cursor - yoffset))
-
-
-botOverrun :: State -> Int
-botOverrun State{..} =
-    max 0 (linearPos cursor - yoffset - (screenHeight - (length headBuffer) - 1))
-
-
-
-moveCursorDown :: Monad m => Int -> State -> m State
-moveCursorDown n q@State{..} =
-    let cursor' = findNextN n cursor
-        q' = q { cursor = cursor' }
-    in case botOverrun q' of
-        0 -> return q'
-        i -> moveTreeUp i q'
-
-
-moveCursorUp :: Monad m => Int -> State -> m State
-moveCursorUp n q@State{..} =
-    let cursor' = findPrevN n cursor
-        q' = q { cursor = cursor' }
-    in case topOverrun q' of
-        0 -> return q'
-        i -> moveTreeDown i q'
-
-
-moveTreeUp :: Monad m => Int -> State -> m State
-moveTreeUp n q@State{..} =
-    let q' = q { yoffset = min (length treeBuffer - 1) $ max 0 (yoffset + n) }
-    in case topOverrun q' of
-        0 -> return q'
-        i -> moveCursorDown i q'
-
-
-moveTreeDown :: Monad m => Int -> State -> m State
-moveTreeDown n q@State{..} =
-    let q' = q { yoffset = min (length treeBuffer - 1) $ max 0 (yoffset - n) }
-    in case botOverrun q' of
-        0 -> return q'
-        i -> moveCursorUp i q'
-
-
-moveTreeLeft :: Monad m => Int -> State -> m State
-moveTreeLeft n q@State{..} =
-    return q { xoffset = xoffset + n }
-
-moveTreeRight :: Monad m => Int -> State -> m State
-moveTreeRight n q@State{..} =
-    return q { xoffset = max 0 (xoffset - n) }
-
-
-moveToParent :: Monad m => State -> m State
-moveToParent q@State{..} =
-    case Z.parent cursor of
-        Nothing -> return q { flashMessage = "cannot go further up" }
-        Just cursor' ->
-            let q' = q { cursor = cursor' }
-            in case topOverrun q' of
-                0 -> return q'
-                i -> moveTreeDown i q'
-
-
-moveCursorToUnread
-    :: (Num a, Monad m, Eq a)
-    => (Z.TreePos Z.Full TreeView -> Maybe (Z.TreePos Z.Full TreeView))
-    -> (State -> a)
-    -> (a -> State -> m State)
-    -> State -> m State
-moveCursorToUnread cursorMove getTreeMoveCount treeMove q@State{..} =
-    case cursorMove cursor >>= rec of
-        Just cursor' ->
-            let q' = q { cursor = cursor' }
-            in case getTreeMoveCount q' of
-                0 -> return q'
-                i -> treeMove i q'
-        Nothing ->
-            return q { flashMessage = "no unread message in sight" }
-  where
-    rec loc =
-        if hasTag "unread" loc
-            then Just loc
-            else cursorMove loc >>= rec
-    hasTag tag loc =
-        case Z.label loc of
-            TVSearchResult sr ->
-                tag `elem` Notmuch.searchTags sr
-            TVMessage m ->
-                tag `elem` Notmuch.messageTags m
-            _ ->
-                False
-
-moveCursorUpToPrevUnread :: Monad m => State -> m State
-moveCursorUpToPrevUnread =
-    moveCursorToUnread findPrev topOverrun moveTreeDown
-
-moveCursorDownToNextUnread :: Monad m => State -> m State
-moveCursorDownToNextUnread =
-    moveCursorToUnread findNext botOverrun moveTreeUp
-
-
-toggleFold :: State -> IO State
-toggleFold q@State{..} =
-    getNewSubForest >>= return . \case
-        Left err ->
-            q { flashMessage = SGR [31] $ Plain err }
-        Right sf ->
-            q { cursor = Z.modifyTree (setSubForest sf) cursor }
-  where
-    getNewSubForest =
-        if hasUnloadedSubForest (Z.tree cursor)
-            then loadSubForest (Z.label cursor)
-            else return $ Right $ unloadSubForest (Z.tree cursor)
-
-
-toggleTagAtCursor :: Tag -> State -> IO State
-toggleTagAtCursor tag q@State{..} = case Z.label cursor of
-
-    TVSearchResult sr -> do
-        let tagOp =
-                if tag `elem` Notmuch.searchTags sr
-                    then DelTag
-                    else AddTag
-            tagOps = [tagOp tag]
-        Notmuch.notmuchTag tagOps sr
-        let cursor' = Z.modifyTree (patchTreeTags tagOps) cursor
-        return q { cursor = cursor' }
-
-    TVMessage m -> do
-        let tagOp =
-                if tag `elem` Notmuch.messageTags m
-                    then DelTag
-                    else AddTag
-            tagOps = [tagOp tag]
-        Notmuch.notmuchTag tagOps m
-        let cursor' =
-                -- TODO this needs a nice name
-                modifyFirstParentLabelWhere isTVSearchResult f $
-                Z.modifyLabel f cursor
-            f = patchTags tagOps
-        return q { cursor = cursor' }
-
-    _ -> return q { flashMessage = "nothing happened" }
-
-
 attachFilesToDraft :: State -> IO State
 attachFilesToDraft q0 =
     runExceptT (go q0) >>= return . \result ->
@@ -650,11 +485,6 @@ editTagsAtCursor q0 =
 -- utilities
 --
 
-
-setSubForest :: Tree.Forest a -> Tree.Tree a -> Tree.Tree a
-setSubForest sf t = t { Tree.subForest = sf }
-
-
 patchMessage
     :: [TagOp] -> Z.TreePos Z.Full TreeView -> Z.TreePos Z.Full TreeView
 patchMessage tagOps loc =