Can't go above root

This commit is contained in:
pingu 2023-10-17 13:21:03 +02:00
parent 6f027562b6
commit 262413cc69

View File

@ -16,6 +16,7 @@ import System.IO.Error
import Brick import Brick
import Brick.Widgets.Edit import Brick.Widgets.Edit
import Graphics.Vty import Graphics.Vty
import Data.List ( isPrefixOf )
import Data.List.Extra ( sortOn import Data.List.Extra ( sortOn
, (!?)) , (!?))
import qualified Data.Ord import qualified Data.Ord
@ -35,7 +36,10 @@ listSym dir = filterM pathIsSymbolicLink =<< listContents dir
handlePermissionError :: IOError -> IO Integer handlePermissionError :: IOError -> IO Integer
handlePermissionError e = if isPermissionError e then pure 0 else ioError e handlePermissionError e = if isPermissionError e then pure 0 else ioError e
getSizeSubpaths :: FilePath -> IORef (IOHashMap FilePath [(FilePath, Integer)]) -> IO [(FilePath, Integer)] getSizeSubpaths ::
FilePath ->
IORef (IOHashMap FilePath [(FilePath, Integer)]) ->
IO [(FilePath, Integer)]
getSizeSubpaths x i = do getSizeSubpaths x i = do
memo <- readIORef i memo <- readIORef i
val <- lookup x memo val <- lookup x memo
@ -64,11 +68,12 @@ data ScrollDirection where
data AppS = AppS data AppS = AppS
{ {
appCWD :: FilePath appCWD :: FilePath
, appCursor :: Int , appCursor :: Int
, appFocus :: Maybe FilePath , appFocus :: Maybe FilePath
, appSubFiles :: [(FilePath, Integer)] , appSubFiles :: [(FilePath, Integer)]
, appMemo :: IORef (IOHashMap FilePath [(FilePath, Integer)]) , appMemo :: IORef (IOHashMap FilePath [(FilePath, Integer)])
, appRoot :: FilePath
} }
app :: App AppS e () app :: App AppS e ()
@ -150,12 +155,14 @@ overDir :: AppS -> IO AppS
overDir s = do overDir s = do
changeWorkingDirectory ".." changeWorkingDirectory ".."
a <- getWorkingDirectory a <- getWorkingDirectory
changeDir $ s { if a `isPrefixOf` appRoot s && a /= appRoot s then
appCWD = a pure s else
, appCursor = 0 changeDir $ s {
, appFocus = pure a appCWD = a
, appSubFiles = [] , appCursor = 0
} , appFocus = pure a
, appSubFiles = []
}
scroll :: ScrollDirection -> AppS -> AppS scroll :: ScrollDirection -> AppS -> AppS
scroll d s = s { scroll d s = s {
@ -194,7 +201,10 @@ eventHandler (VtyEvent (EvKey k _)) = do
eventHandler (VtyEvent (EvResize _ _)) = pure () eventHandler (VtyEvent (EvResize _ _)) = pure ()
eventHandler _ = undefined eventHandler _ = undefined
initialState :: FilePath -> IORef (IOHashMap FilePath [(FilePath, Integer)]) -> AppS initialState ::
FilePath ->
IORef (IOHashMap FilePath [(FilePath, Integer)]) ->
AppS
initialState f i = initialState f i =
AppS { AppS {
appCWD = f appCWD = f
@ -202,6 +212,7 @@ initialState f i =
, appFocus = pure f , appFocus = pure f
, appSubFiles = [] , appSubFiles = []
, appMemo = i , appMemo = i
, appRoot = f
} }
main :: IO () main :: IO ()