~jackwines/fast-bronze

d90bbf2ca2dc8f7ef7e074b9fdabd906186cdc5c — Jack Wines 4 months ago 917548d
major major refactor (again hehe)
5 files changed, 149 insertions(+), 115 deletions(-)

M cabal.project
M fast-bronze.cabal
M src/Catalog.hs
M src/ListZipper.hs
M src/Main.hs
M cabal.project => cabal.project +5 -5
@@ 1,10 1,10 @@
packages: *.cabal

source-repository-package
    type: git
    location: https://github.com/haskell-gi/haskell-gi.git
    branch: master
    tag: d04ecd11d0afeb88ffcc3802ac3c3b589646c51e
-- source-repository-package
--     type: git
--     location: https://github.com/haskell-gi/haskell-gi.git
--     branch: master
--     tag: a3855b5c8e3d098e56e8eaf9b4bdcba6dbdbe3dc

jobs: $ncpus
allow-newer: all

M fast-bronze.cabal => fast-bronze.cabal +9 -4
@@ 1,14 1,15 @@
cabal-version:       >= 2.0
cabal-version:       2.0
-- Initial package description 'fast-bronze.cabal' generated by 'cabal
-- init'.  For further documentation, see
-- http://haskell.org/cabal/users-guide/

name:                fast-bronze
version:             0.1.0.0
-- synopsis:
synopsis:            A reimplementation of quicksilver

-- description:
-- bug-reports:
-- license:
license:             MIT
license-file:        LICENSE
author:              Jack Wines
maintainer:          jackwines@mac.com


@@ 17,6 18,10 @@ maintainer:          jackwines@mac.com
build-type:          Simple
extra-source-files:  CHANGELOG.md

source-repository head
  type: git
  location: https://git.sr.ht/~jackwines/fast-bronze

executable fast-bronze
  main-is:             Main.hs
  default-extensions:  ScopedTypeVariables,


@@ 44,7 49,7 @@ executable fast-bronze
                       directory                     >= 1.3.6 && < 1.4,
                       unix                          >= 2.7.2 && < 2.8,
                       gi-gdk                        >= 3.0.22 && < 3.1,
                       haskell-gi-base               >= 0.23.0 && < 0.24,
                       haskell-gi-base               >= 0.23.0,
                       vector                        >= 0.12.1 && < 0.13,
                       gi-gtk                        >= 3.0.33 && < 3.1,
                       gi-gtk-declarative            >= 0.6.3 && < 0.7,

M src/Catalog.hs => src/Catalog.hs +8 -8
@@ 9,7 9,7 @@ data SearchDir = SearchDir {
                 } deriving (Show)
data Action = Action {
  actionSearchString :: T.Text,
  action :: [Cataloged] -> IO (),
  action :: Cataloged -> IO (),
  inputs :: [InputType]
  }



@@ 74,17 74,17 @@ getActions cataloged =
  [
    Action {
      actionSearchString = "open",
      action = \[cataloged] ->  P.executeFile "open" True [T.unpack . dirPath $ cataloged] Nothing,
      action = \cataloged ->  P.executeFile "open" True [T.unpack . dirPath $ cataloged] Nothing,
      inputs = [Other]
    },
    Action {
      actionSearchString = "move to trash",
      action = \[cataloged] -> P.executeFile "mv" True [T.unpack . dirPath $ cataloged, "~/.Trash"] Nothing,
      inputs = [Other]
      },
    Action {
      actionSearchString = "move to",
      action = \cataloged -> P.executeFile "mv" True (map (T.unpack . dirPath) cataloged) Nothing,
      action = \cataloged -> P.executeFile "mv" True [T.unpack . dirPath $ cataloged, "~/.Trash"] Nothing,
      inputs = [Other]
      }
    -- Action {
    --   actionSearchString = "move to",
    --   action = \cataloged -> P.executeFile "mv" True (map (T.unpack . dirPath) cataloged) Nothing,
    --   inputs = [Other]
    --   }
  ]

M src/ListZipper.hs => src/ListZipper.hs +9 -7
@@ 31,10 31,12 @@ asListMaybe :: Maybe (ListZipper a) -> [a]
asListMaybe Nothing = []
asListMaybe (Just a) = asList a

zipperFilter :: (a -> Bool) -> ListZipper a -> Maybe (ListZipper a)
zipperFilter p (ListZipper xs x xs') | p x = Just $ ListZipper (filter p xs) x (filter p xs')
zipperFilter p (ListZipper xs x xs') = case filter p xs of
  x':xs'' -> Just $ ListZipper xs'' x' xs'
  [] -> case filter p xs' of
    x'':xs''' -> Just $ ListZipper [] x'' xs'''
    [] -> Nothing
filter :: (a -> Bool) -> ListZipper a -> Maybe (ListZipper a)
filter p (ListZipper xs x xs') = case (Prelude.filter p xs, justIf p x, Prelude.filter p xs') of
  ([], Nothing, []) -> Nothing
  (x:xs, Nothing, xs') -> Just $ ListZipper xs x xs'
  (xs, Nothing, x:xs') -> Just $ ListZipper xs x xs'
  (xs, Just x, xs') -> Just $ ListZipper xs x xs'

justIf :: (a -> Bool) -> a -> Maybe a
justIf fn  x = if fn x then Just x else Nothing

M src/Main.hs => src/Main.hs +118 -91
@@ 5,7 5,7 @@ import           Data.Text ( Text )
import           Pipes
import qualified Pipes.Extras as Pipes

import           GI.Gtk ( Button(..)
import           GI.Gtk (ListBoxRow,  Button(..)
                                                , Grid(..)
                                                , Box(..)
                                                , Label(..)


@@ 34,10 34,23 @@ import qualified Control.Monad.IO.Class as M
import qualified Control.Applicative as A
import           Catalog
import qualified ListZipper as LZ
import Data.List as L
import GI.Gtk.Objects.ListBox (ListBox(ListBox))


data Event = Closed | KeyPressed Char | Delete | Tab | Enter | Up | Down | Left | Right | ReplaceCatalog [Cataloged]

data AppState = AppState {
  catalog :: [Cataloged],
  currCatalogs :: Maybe (LZ.ListZipper Cataloged),
  currActions :: Maybe (LZ.ListZipper Action),
  focus :: Focus,
  searchText :: T.Text
                         }

-- what should be highlighted? The catalog or the actions
data Focus = Action | Catalog deriving (Show, Eq)

view' :: AppState -> AppView Window Event
view' s =
  bin


@@ 62,7 75,7 @@ view' s =
              #label := topBoxText,
              #hexpand := True,
              #vexpand := True,
              classes bottomClasses
              classes topClasses
            ]
          },
          GridChild { -- the actions panel


@@ 86,99 99,130 @@ view' s =
              topAttach = 0,
              leftAttach = 6
            },
            child = container Grid [
              #widthRequest := 200,
              classes ["optionslist"],
              #vexpand := True
            ] []-- selectionOptions
            child = container ListBox [] . Vec.fromList . take 15 $ otherOptions
          }
        ]
      where
        otherOptions = map searchListWidget . reverse . maybe [] LZ.after $ case focus s of
          Main.Action ->  LZ.map searchString <$> currActions s
          Catalog -> LZ.map searchString <$> currCatalogs s

        searchListWidget txt = bin Gtk.ListBoxRow [] $ widget Label [
                #label := txt,
                #hexpand := True,
                #vexpand := True
              ]

        bottomBoxText :: T.Text
        bottomBoxText = maybe "" searchString . searchAction $ s

        topBoxText :: T.Text
        topBoxText = maybe "" searchString . searchCatalog $ s

        topClasses :: Vec.Vector Text
        topClasses :: [Text]
        topClasses = case focus s of
          Catalog -> ["selected"]
          _ -> ["unselected"]

        bottomClasses :: [Text]
        bottomClasses = case focus s of
          Main.Action -> ["selected"]
          _ -> ["unselected"]

        makeGridChild label index = GridChild {
          properties = defaultGridChildProperties {
            height = 1,
            width = 1,
            topAttach = index
          },
          child = widget Label [#widthRequest := 600, #label := label, #vexpand := True, #hexpand := True]
        }

update' :: AppState -> Event -> Transition AppState Event
update' _ Closed = Exit
-- remove everything on delete
update' s Delete = Transition s {search = emptySearch} (return Nothing)
update' s Delete = Transition (resetCurrZipper s) (return Nothing)
-- flip focus to bottom or top on tab
update' s Tab = Transition s {focus = Main.Action, search = emptySearch} (return Nothing)
update' s Tab = Transition (resetCurrZipper s {focus = flipFocus . focus $ s}) (return Nothing)
-- move up or down the catalog/actions
-- update' s Up =   Transition (selectedZipperRight s) (return Nothing)
-- update' s Down = Transition (selectedZipperLeft  s) (return Nothing)
update' s Up =   Transition (selectedZipperRight s) (return Nothing)
update' s Down = Transition (selectedZipperLeft  s) (return Nothing)
-- move right, into the current directory
-- update' s Main.Right = Transition s $
--   case searchCatalog s of
--     [] -> return Nothing
--     [zipper] -> do
--       let currPath :: String = T.unpack . dirPath . LZ.focus $ zipper
--       isDir <- P.isDirectory <$> P.getFileStatus currPath
--       if not isDir then return Nothing else do
--         childPaths <- map (\x -> getFocusFilePath zipper ++ '/':x) . filterHiddenFiles <$> (D.listDirectory .  getFocusFilePath $ zipper)
--         childIsDirs <- mapM (fmap P.isDirectory . P.getFileStatus) childPaths
--         return . Just . ReplaceCatalog $ zipWith dirToCatalog childPaths childIsDirs

-- update' s (ReplaceCatalog c) = Transition (resetSearchActions (s { searchCatalog = LZ.fromList c, focus = Focus 0 "" })) (return Nothing)
update' s (ReplaceCatalog c) = Transition (resetSearchActions (s {search = emptySearch})) (return Nothing)
-- execute the focused action
-- update' s Enter = s
  -- Transition s (do
    -- let action' = maybe (const $ return ()) (action . LZ.focus) (searchActions s)
    -- let catalogs = map LZ.focus . searchCatalog $ s
    -- action' catalogs
    -- return $ Just Closed)
update' s (KeyPressed c) = Transition updatedAppState (return Nothing)
update' s Main.Right = Transition s $
  case (currCatalogs s, focus s) of
    (Just zipper, Catalog) -> do
      let currPath :: String = T.unpack . dirPath . LZ.focus $ zipper
      isDir <- P.isDirectory <$> P.getFileStatus currPath
      if not isDir then return Nothing else do
        childPaths <- map (\x -> getFocusFilePath zipper ++ '/':x) . filterHiddenFiles <$> (D.listDirectory .  getFocusFilePath $ zipper)
        mapM (putStrLn . show) childPaths
        childIsDirs <- mapM (fmap P.isDirectory . P.getFileStatus) childPaths
        return . Just . ReplaceCatalog $ zipWith dirToCatalog childPaths childIsDirs
    _ -> return Nothing
update' s (ReplaceCatalog c) = Transition (s {currCatalogs = LZ.fromList c, searchText = ""}) (do
                                                                                                  print c
                                                                                                  return Nothing)





update' s Enter =
  Transition s (do
    fromMaybe (return ()) $ (fromMaybe (const $ return ()) (action <$> (searchAction s))) <$> (searchCatalog s)
    return $ Just Closed)
update' s (KeyPressed c) = Transition (applySearchFilter s searchText') (return Nothing)
  where
    searchText' = T.snoc (searchText s) c

resetCurrZipper s = (case focus s of
  Catalog -> s {currCatalogs = Nothing, currActions = Nothing}
  Main.Action -> s {currActions = Nothing})
  {searchText = ""}


applySearchFilter s searchText'= ( -- looks like lisp lol
    case focus s of
      Catalog -> s {currCatalogs = currCatalogs', currActions = newActions}
      Main.Action -> s {currActions = currActions'}
  ) {searchText = searchText'}
  where
    updatedAppState = s {
        search = (search s) {searchText = searchText'},
        searchCatalog = if focus s == Catalog then listToMaybe . focused $ catalog s else searchCatalog s,
        searchAction = if focus s == Main.Action then listToMaybe . focused . getActions =<< searchCatalog s else searchAction s
      }
    -- here because we'll to check if it's changed later on the actions list
    currCatalogs' = case currCatalogs s of
      Nothing -> LZ.fromList . searchableMatches searchText' $ catalog s
      Just toFilter -> LZ.filter (fuzzyMatches searchText' . searchString) toFilter

    -- derived soley from the current catalog
    newActions = LZ.fromList . getActions . LZ.focus =<< currCatalogs s

    currActions' = case currActions s of
      Nothing -> newActions
      Just toFilter -> LZ.filter (fuzzyMatches searchText' . searchString) toFilter


selectedZipperLeft :: AppState  -> AppState
selectedZipperLeft s = case focus s of
  Main.Action -> s {currActions = fmap LZ.moveLeft (currActions s)}
  Catalog     -> s {currCatalogs = fmap LZ.moveLeft (currCatalogs s)}

    focused :: Searchable a => [a] -> [a]
    focused xs = searchableMatches searchText' xs
selectedZipperRight :: AppState -> AppState
selectedZipperRight s = case focus s of
  Main.Action -> s {currActions = fmap LZ.moveRight (currActions s)}
  Catalog     -> s {currCatalogs = fmap LZ.moveRight (currCatalogs s)}

    searchText' :: T.Text
    searchText' = T.snoc (searchText . search $ s) c
    -- updatedAppState = resetSearchActions $ s' { focus = setCurrSelection (focus s ) newSearchText}
    -- s' = case focus s of
    --   (Focus 0 txt) -> s { searchCatalog = updateSelectionZipper (catalog s) (searchCatalog s) newSearchText }
    --   (Focus _ _) -> s { searchActions = updateSelectionZipper (actions . LZ.focus . fromJust . searchCatalog $ s) (searchActions s) newSearchText }
    -- newSearchText = Prelude.flip T.snoc c $ currSelection . focus $ s
-- TODO: fails to compile, don't know why
-- mapFocus :: Searchable a => AppState -> (LZ.ListZipper a -> LZ.ListZipper a) -> AppState
-- mapFocus s f = case focus s of
--   Catalog -> s {currCatalogs = currCatalogs s}
--   Main.Action -> s {currActions = currActions s}

resetSearchActions s = s -- { searchActions = LZ.fromList . getActions . LZ.focus =<< searchCatalog s }
replaceNothingWith :: Maybe (LZ.ListZipper Cataloged) -> Maybe (LZ.ListZipper Action) -> AppState -> AppState
replaceNothingWith catalogZipper actionZipper s = case focus s of
  Catalog -> s {currCatalogs = replaceNothingMaybe (currCatalogs s) catalogZipper}
  Main.Action -> s {currActions = replaceNothingMaybe (currActions s) actionZipper}
  where
    replaceNothingMaybe :: Maybe a -> Maybe a -> Maybe a
    replaceNothingMaybe (Just a) _ = Just a
    replaceNothingMaybe Nothing a = a

filterHiddenFiles :: [FilePath] -> [FilePath]
filterHiddenFiles = filter (elem '.')
filterHiddenFiles = filter (not . L.isInfixOf "/.")

getFocusFilePath :: LZ.ListZipper Cataloged -> FilePath
getFocusFilePath = T.unpack . dirPath . LZ.focus

-- updateSelectionZipper :: Searchable a => [a] -> Maybe (LZ.ListZipper a) -> Text -> Maybe (LZ.ListZipper a)
-- updateSelectionZipper catalog (Just zipper) txt = LZ.zipperFilter (search txt . searchString) zipper
-- updateSelectionZipper catalog Nothing txt = LZ.fromList . catalogMatches txt $ catalog

main :: IO ()
main = do
  void $ Gtk.init Nothing


@@ 218,44 262,27 @@ handleKeyPress key window = do
             65364 -> Down
             65361 -> Main.Left
             65363 -> Main.Right
             65511 -> Closed
             char -> KeyPressed . C.chr $ char)

initialAppState catalog' = AppState {
  catalog = catalog',
  searchCatalog = Nothing,
  searchAction = Nothing,
  search = emptySearch,
  focus = Catalog
  }

emptySearch :: SearchTelescope
emptySearch = SearchTelescope {
      searchText = "",
      numScrolls = 0
                           }

data AppState = AppState {
  catalog :: [Cataloged],
  searchCatalog :: Maybe Cataloged,
  searchAction :: Maybe Action,
  focus :: Focus,
  search :: SearchTelescope
                         }
  searchText = "",
  focus = Catalog,
  currCatalogs = Nothing,
  currActions = Nothing
}

-- what should be highlighted? The catalog or the actions
data Focus = Action | Catalog deriving Eq
searchCatalog :: AppState -> Maybe Cataloged
searchCatalog s = LZ.focus <$> currCatalogs s

-- keeps track of current search. What they've typed, how much they've scrolled, .etc
data SearchTelescope = SearchTelescope {
  searchText :: T.Text,
  numScrolls :: Word
                     } deriving Eq
searchAction :: AppState -> Maybe Action
searchAction s = LZ.focus <$> currActions s

-- mapOverFocus :: (Text -> Text) -> Focus -> Focus
-- mapOverFocus f (Focus n t) = Focus n (f t)

-- advance :: Word -> Focus -> Focus
-- advance numFrames (Focus selection _) = Focus (succ selection `mod` numFrames) ""
flipFocus :: Focus -> Focus
flipFocus Main.Action = Catalog
flipFocus Catalog = Main.Action

searchableMatches :: Searchable s => T.Text -> [s] -> [s]
searchableMatches s = filter (fuzzyMatches s . searchString)