Can't go above root
This commit is contained in:
parent
6f027562b6
commit
262413cc69
35
app/Main.hs
35
app/Main.hs
@ -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 ()
|
||||||
|
Loading…
Reference in New Issue
Block a user