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
@ -69,6 +73,7 @@ data AppS = AppS
, 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,6 +155,8 @@ overDir :: AppS -> IO AppS
overDir s = do overDir s = do
changeWorkingDirectory ".." changeWorkingDirectory ".."
a <- getWorkingDirectory a <- getWorkingDirectory
if a `isPrefixOf` appRoot s && a /= appRoot s then
pure s else
changeDir $ s { changeDir $ s {
appCWD = a appCWD = a
, appCursor = 0 , appCursor = 0
@ -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 ()