{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} {-# HLINT ignore "Redundant multi-way if" #-} module Daffm.State where import qualified Brick.Widgets.Edit as Editor import qualified Brick.Widgets.List as L import Control.Applicative ((<|>)) import Control.Exception (try) import Control.Monad (filterM, forM) import Daffm.Types import Daffm.Utils (trim) import Data.List (findIndex, sortBy) import qualified Data.Map.Strict as Map import Data.Maybe (fromMaybe) import qualified Data.Set as Set import qualified Data.Text as Text import qualified Data.Text.Zipper.Generic as Zipper import qualified Data.Vector as Vec import System.Directory (doesPathExist, getCurrentDirectory, getHomeDirectory, getPermissions, getSymbolicLinkTarget, listDirectory, makeAbsolute, readable, setCurrentDirectory) import System.FilePath (joinPath, takeDirectory) import qualified System.PosixCompat as Posix import qualified System.Posix.User as Posix mkEditor :: (Zipper.GenericTextZipper a) => a -> Editor.Editor a FocusTarget mkEditor = Editor.editor FocusCmdline (Just 1) mkEmptyAppState :: Configuration -> AppState mkEmptyAppState config = AppState { stateFiles = L.list FocusMain (Vec.fromList []) 1, stateMessage = Nothing, stateCmdlineEditor = mkEditor "", stateFocusTarget = FocusMain, stateListPositionHistory = Map.empty, stateFileSelections = Set.empty, stateCwd = "", stateKeyMap = configKeymap config, stateOpenerScript = configOpener config, stateKeySequence = [], stateSearchTerm = Nothing, stateSearchMatches = Vec.empty, stateCustomCommands = configCommands config, stateSearchIndex = 0 } toggleSetItem :: (Ord a) => a -> Set.Set a -> Set.Set a toggleSetItem val set | Set.member val set = Set.delete val set | otherwise = Set.insert val set toggleFileSelection :: FilePathText -> AppState -> AppState toggleFileSelection path st = st {stateFileSelections = toggleSetItem path $ stateFileSelections st} normalizePath :: FilePathText -> IO FilePathText normalizePath "~" = Text.pack <$> getHomeDirectory normalizePath (Text.stripPrefix "~/" -> (Just rest)) = do home <- getHomeDirectory pure . Text.pack . joinPath $ [home, Text.unpack rest] normalizePath dir = Text.pack <$> makeAbsolute (Text.unpack dir) withCwdFallback :: FilePathText -> IO FilePathText withCwdFallback path = do exists <- doesPathExist $ Text.unpack path if exists then pure path else Text.pack <$> getCurrentDirectory stripQuotes :: Text.Text -> Text.Text stripQuotes txt = fromMaybe txt (double <|> single) where double = Text.stripPrefix "\"" txt >>= Text.stripSuffix "\"" single = Text.stripPrefix "'" txt >>= Text.stripSuffix "'" stripTrailingSlash :: Text.Text -> Text.Text stripTrailingSlash path@"/" = path stripTrailingSlash path = fromMaybe path $ Text.stripSuffix "/" path textAsString :: (String -> String) -> Text.Text -> Text.Text textAsString f = Text.pack . f . Text.unpack loadDirToState :: FilePathText -> AppState -> IO AppState loadDirToState dir' appState@(AppState {stateCwd, stateListPositionHistory}) = do normalizedDir <- (normalizePath . stripTrailingSlash . stripQuotes . trim) dir' >>= withCwdFallback stat <- Posix.getFileStatus $ Text.unpack normalizedDir let (dir, targetFilePath) = if Posix.isDirectory stat then (normalizedDir, Nothing) else (textAsString takeDirectory normalizedDir, Just normalizedDir) isReadable <- readable <$> getPermissions (Text.unpack dir) if isReadable then do setCurrentDirectory $ Text.unpack dir newState <- dirToAppState dir targetFilePath doesPathExist (Text.unpack dir') >>= \case True -> pure newState _ -> pure newState {stateMessage = Just $ "No such file or directory: " <> dir'} else do let list = L.list FocusMain (Vec.fromList []) 1 pure $ (withNewDir dir list appState) {stateMessage = Just "Unable to read directory"} where withNewDir dir fileList st = st { stateCwd = dir, stateFiles = fileList, stateMessage = Nothing, stateSearchIndex = 0, stateSearchMatches = Vec.empty } dirToAppState dir targetFilePath = do files <- listFilesInDir dir let prevDirPos = findIndex ((== stateCwd) . filePath) files let cachedPos = Map.lookup dir stateListPositionHistory let targetFilePos = targetFilePath >>= \target -> findIndex ((== target) . filePath) files let pos = fromMaybe 0 (targetFilePos <|> cachedPos <|> prevDirPos) let list = L.listMoveTo pos $ L.list FocusMain (Vec.fromList files) 1 pure $ withNewDir dir list appState fileTypeFromStatus :: Posix.FileStatus -> FileType fileTypeFromStatus s = if | Posix.isBlockDevice s -> BlockDevice | Posix.isCharacterDevice s -> CharacterDevice | Posix.isNamedPipe s -> NamedPipe | Posix.isRegularFile s -> RegularFile | Posix.isDirectory s -> Directory | Posix.isSocket s -> UnixSocket | Posix.isSymbolicLink s -> SymbolicLink | otherwise -> UnknownFileType getFileInfo :: FilePathText -> IO FileInfo getFileInfo name = do path <- makeAbsolute $ Text.unpack name stat <- Posix.getSymbolicLinkStatus path let either2Maybe :: Either IOError a -> Maybe a either2Maybe = either (const Nothing) Just linkStat <- either2Maybe <$> try (Posix.getFileStatus path) linkTarget <- if | Posix.isSymbolicLink stat -> Just . Text.pack <$> getSymbolicLinkTarget path | otherwise -> pure Nothing user <- Posix.getUserEntryForID $ Posix.fileOwner stat group <- Posix.getGroupEntryForID $ Posix.fileGroup stat pure $ FileInfo { filePath = Text.pack path, fileName = name, fileSize = Posix.fileSize stat, fileMode = Posix.fileMode stat, fileUser = Text.pack . Posix.userName $ user, fileGroup = Text.pack . Posix.groupName $ group, fileType = fileTypeFromStatus stat, fileLinkType = fileTypeFromStatus <$> linkStat, fileLinkTarget = linkTarget } fileSorter :: FileInfo -> FileInfo -> Ordering fileSorter (FileInfo {fileType = Directory, fileName = fa}) (FileInfo {fileType = Directory, fileName = fb}) = compare (Text.toLower fa) (Text.toLower fb) fileSorter (FileInfo {fileType = SymbolicLink, fileLinkType = Just Directory, fileName = fa}) (FileInfo {fileType = SymbolicLink, fileLinkType = Just Directory, fileName = fb}) = compare (Text.toLower fa) (Text.toLower fb) fileSorter (FileInfo {fileType = Directory}) (FileInfo {fileType = SymbolicLink, fileLinkType = Just Directory}) = LT fileSorter (FileInfo {fileType = SymbolicLink, fileLinkType = Just Directory}) (FileInfo {fileType = Directory}) = GT fileSorter (FileInfo {fileType = Directory}) _ = LT fileSorter _ (FileInfo {fileType = Directory}) = GT fileSorter (FileInfo {fileLinkType = Just Directory}) _ = LT fileSorter _ (FileInfo {fileLinkType = Just Directory}) = GT fileSorter (FileInfo {fileName = fa}) (FileInfo {fileName = fb}) = compare (Text.toLower fa) (Text.toLower fb) listFilesInDir :: FilePathText -> IO [FileInfo] listFilesInDir dir = do files <- listDirectory (Text.unpack dir) sortBy fileSorter <$> forM files (getFileInfo . Text.pack) cacheDirPosition :: AppState -> AppState cacheDirPosition appState@(AppState {stateListPositionHistory, stateCwd, stateFiles}) = appState {stateListPositionHistory = Map.insert stateCwd pos stateListPositionHistory} where pos = fromMaybe 0 $ L.listSelected stateFiles filterInvalidSelections :: AppState -> IO AppState filterInvalidSelections st = do selections <- filterM (Posix.fileExist . Text.unpack) . Set.elems $ stateFileSelections st pure $ st {stateFileSelections = Set.fromList selections}