{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Panes.FileMgr ( FileMgrPane , FileMgrOps(..) , initFileMgr , showFileMgr , isFileMgrActive , fileMgrReadProjectsFile , unsavedChanges , fileMgrNotices ) where import Brick hiding ( Location ) import Brick.Panes import Brick.Widgets.Center import qualified Brick.Widgets.Core as BC import Brick.Widgets.FileBrowser import qualified Control.Exception as X import Control.Lens import Control.Monad ( unless ) import Control.Monad.IO.Class ( MonadIO, liftIO ) import Data.Aeson ( eitherDecode, encode ) import qualified Data.ByteString.Lazy as BS import Data.Maybe ( catMaybes ) import Data.Maybe ( isJust ) import qualified Data.Sequence as Seq import qualified Graphics.Vty as Vty import Path ( Path, Abs, File, (), parseAbsFile , relfile, reldir, parent, toFilePath ) import Path.IO ( createDirIfMissing, doesFileExist , XdgDirectory(XdgData), getXdgDir ) import Defs import Defs.JSON () import Defs.Static import Panes.Common.Attrs import Sync data FileMgrPane data FileMgrOps = AckProjectChanges | UpdProject (Maybe ProjectName) Project -- add/replace project | DelProject ProjectName | DelLocation ProjectName LocationSpec | DelNote ProjectName LocationSpec NoteTitle instance Pane WName MyWorkEvent FileMgrPane where data (PaneState FileMgrPane MyWorkEvent) = FB { fB :: Maybe (FileBrowser WName) -- ^ A Nothing value indicates the modal is not currently active , myProjects :: Projects -- ^ Current loaded set of projects , myProjFile :: Maybe (Path Abs File) , projsChanged :: Either Confirm Bool -- ^ True when myProjects has been updated; clear this via updatePane , unsavedChanges :: Bool -- ^ True when myProjects has been changed since the last load , errMsg :: String -- ^ Internal error message to display in the FileMgr modal , fmgrMsgs :: [ Widget WName ] -- ^ Messages to display when the FileMgr modal exits } type (DrawConstraints FileMgrPane s WName) = ( HasFocus s WName ) type (EventConstraints FileMgrPane e) = ( HasFocus e WName ) initPaneState _ = FB Nothing (Projects mempty) Nothing (Right False) False "" mempty drawPane ps gs = drawFB ps gs <$> fB ps focusable _ ps = case fB ps of Nothing -> mempty Just _ -> Seq.fromList $ catMaybes [ Just $ WName "FMgr:Browser" , const (WName "FMgr:SaveBtn") <$> myProjFile ps , if isDirSelected ps then Nothing else Just $ WName "FMgr:SaveAsBtn" ] handlePaneEvent bs ev ts = let isSearching = maybe False fileBrowserIsSearching (ts^.fBrowser) in case ev of Vty.EvKey Vty.KEsc [] | not isSearching -> return $ ts & fBrowser .~ Nothing Vty.EvKey (Vty.KChar 's') [Vty.MCtrl] -> do ts' <- case myProjFile ts of Just fp -> fileMgrSaveProjectsFile fp ts Nothing -> -- Ctrl-S dismisses the FileMgr window, even on failure return ts return $ ts' & exitMsgsL <>~ (if null (ts ^. errMsgL) then [] else [ withAttr a'Error $ str $ ts ^. errMsgL]) & fBrowser .~ Nothing _ -> case bs^.getFocus of Focused (Just (WName "FMgr:Browser")) -> handleFileLoadEvent ev ts Focused (Just (WName "FMgr:SaveAsBtn")) -> handleFileSaveEvent ev ts Focused (Just (WName "FMgr:SaveBtn")) -> case myProjFile ts of Just fp -> fileMgrSaveProjectsFile fp ts Nothing -> return ts _ -> return ts type (UpdateType FileMgrPane) = FileMgrOps updatePane = \case AckProjectChanges -> \ps -> ps { projsChanged = Right False, fmgrMsgs = mempty } UpdProject mbOldNm prj -> (myProjectsL %~ updateProject mbOldNm prj) . (projsChangedL .~ Right True) . (unsavedChangesL .~ True) DelProject pname -> (myProjectsL %~ Projects . filter ((/= pname) . view projNameL) . projects) . (projsChangedL .~ Right True) . (unsavedChangesL .~ True) DelLocation pname locn -> let rmvLoc p = if p ^. projNameL == pname then p & locationsL %~ filter (not . thisLoc) else p thisLoc = ((== locn) . view locationL) in (myProjectsL %~ Projects . fmap rmvLoc . projects) . (projsChangedL .~ Right True) . (unsavedChangesL .~ True) DelNote pname locn nt -> let rmvNote p = if p ^. projNameL == pname then p & locationsL %~ fmap rmvNote' else p rmvNote' l = if l ^. locationL == locn then l & notesL %~ filter (not . thisNote) else l thisNote = ((== nt) . noteTitle) in (myProjectsL %~ Projects . fmap rmvNote . projects) . (projsChangedL .~ Right True) . (unsavedChangesL .~ True) fBrowser :: Lens' (PaneState FileMgrPane MyWorkEvent) (Maybe (FileBrowser WName)) fBrowser f ps = (\n -> ps { fB = n }) <$> f (fB ps) myProjectsL :: Lens' (PaneState FileMgrPane MyWorkEvent) Projects myProjectsL f wc = (\n -> wc { myProjects = n }) <$> f (myProjects wc) myProjFileL :: Lens' (PaneState FileMgrPane MyWorkEvent) (Maybe (Path Abs File)) myProjFileL f wc = (\n -> wc { myProjFile = n }) <$> f (myProjFile wc) projsChangedL :: Lens' (PaneState FileMgrPane MyWorkEvent) (Either Confirm Bool) projsChangedL f wc = (\n -> wc { projsChanged = n }) <$> f (projsChanged wc) unsavedChangesL :: Lens' (PaneState FileMgrPane MyWorkEvent) Bool unsavedChangesL = lens unsavedChanges (\wc n -> wc { unsavedChanges = n }) errMsgL :: Lens' (PaneState FileMgrPane MyWorkEvent) String errMsgL f wc = (\n -> wc { errMsg = n }) <$> f (errMsg wc) exitMsgsL :: Lens' (PaneState FileMgrPane MyWorkEvent) [ Widget WName ] exitMsgsL f wc = (\n -> wc { fmgrMsgs = n }) <$> f (fmgrMsgs wc) isFileMgrActive :: PaneState FileMgrPane MyWorkEvent -> Bool isFileMgrActive = isJust . fB fileMgrNotices :: Lens' (PaneState FileMgrPane MyWorkEvent) [ Widget WName ] fileMgrNotices = exitMsgsL isDirSelected :: PaneState FileMgrPane MyWorkEvent -> Bool isDirSelected ps = case fileBrowserCursor =<< fB ps of Just fi -> case fileStatusFileType <$> fileInfoFileStatus fi of Right (Just Directory) -> True Right (Just SymbolicLink) -> case fileInfoLinkTargetType fi of Just Directory -> True _ -> False _ -> False Nothing -> False instance ( PanelOps FileMgrPane WName MyWorkEvent panes MyWorkCore , HasProjects (PaneState FileMgrPane MyWorkEvent) ) => HasProjects (Panel WName MyWorkEvent MyWorkCore panes) where getProjects = getProjects . view (onPane @FileMgrPane) instance HasProjects (PaneState FileMgrPane MyWorkEvent) where getProjects ps = (projsChanged ps, myProjects ps) drawFB :: DrawConstraints FileMgrPane drawstate WName => PaneState FileMgrPane MyWorkEvent -> drawstate -> FileBrowser WName -> Widget WName drawFB ps ds b = let width = 70 fcsd = ds^.getFocus.to focused browserFocused = fcsd == Just (WName "FMgr:Browser") isDir = isDirSelected ps browserPane fb = vLimitPercent 55 $ hLimitPercent width $ titledB browserFocused "Choose a file" $ renderFileBrowser browserFocused fb helpPane = let esact = if browserFocused then if isDir then "change directory" else "load file" else "save" in padTop (BC.Pad 1) $ hLimitPercent width $ vBox [ hCenter $ txt "/: search, Ctrl-C or Esc: cancel search" , hCenter $ txt $ "Enter/Space: " <> esact , hCenter $ txt "TAB: select Save/Load options" , hCenter $ txt "ESC: quit" ] errDisplay fb = case fileBrowserException fb of Nothing -> if null $ errMsg ps then emptyWidget else hLimitPercent width $ withDefAttr a'Error $ strWrap $ errMsg ps Just e -> hLimitPercent width $ withDefAttr a'Error $ strWrap $ X.displayException e savePane = padTop (Pad 1) $ vBox [ let a = if fcsd == Just (WName "FMgr:SaveBtn") then withAttr a'Selected else if null f then withAttr a'Disabled else id f = myProjFile ps btxt = case f of Nothing -> " " Just x -> "[SAVE] " <> show x in a $ str btxt , if isDir then withAttr a'Disabled $ str "[SAVE]" else let a = if fcsd == Just (WName "FMgr:SaveAsBtn") then withAttr a'Selected else id btxt = case fileBrowserCursor =<< fB ps of Just fi -> "[SAVE] " <> fileInfoFilePath fi Nothing -> "[SAVE]" in a $ str btxt ] in centerLayer (browserPane b <=> errDisplay b <=> savePane <=> helpPane) handleFileLoadEvent :: Vty.Event -> PaneState FileMgrPane MyWorkEvent -> EventM WName es (PaneState FileMgrPane MyWorkEvent) handleFileLoadEvent ev ts = case ts^.fBrowser of Just fb -> do b <- nestEventM' fb $ handleFileBrowserEvent ev let selectFile = case fileBrowserCursor b of Nothing -> return $ ts & fBrowser .~ Just b -- navigation Just f -> case parseAbsFile $ fileInfoFilePath f of Just fp -> if unsavedChanges ts then let msg = ConfirmLoad fp in return $ ts & projsChangedL .~ Left msg & fBrowser .~ Nothing else (fBrowser .~ Nothing) <$> fileMgrReadProjectsFile fp ts Nothing -> -- Current selection is a directory; cannot load a directory, -- so just allow the fBrowser to change to that directory. return $ ts & fBrowser .~ Just b case ev of Vty.EvKey Vty.KEnter [] -> selectFile Vty.EvKey (Vty.KChar ' ') [] -> selectFile -- override filebrowser's default multi-select ability _ -> return $ ts & fBrowser .~ Just b & errMsgL .~ "" Nothing -> return ts -- shouldn't happen handleFileSaveEvent :: Vty.Event -> PaneState FileMgrPane MyWorkEvent -> EventM WName es (PaneState FileMgrPane MyWorkEvent) handleFileSaveEvent ev ts = case fileBrowserCursor =<< ts^.fBrowser of Nothing -> return ts Just f -> case ev of Vty.EvKey Vty.KEnter [] -> doSave f Vty.EvKey (Vty.KChar ' ') [] -> doSave f _ -> return ts where doSave f = case parseAbsFile $ fileInfoFilePath f of Just fp -> fileMgrSaveProjectsFile fp ts Nothing -> return $ ts & errMsgL .~ dirErr dirErr = "Cannot save to a directory: please select a file" ensureDefaultProjectFile :: IO (Path Abs File) ensureDefaultProjectFile = do dataDir <- getXdgDir XdgData $ Just [reldir|mywork|] createDirIfMissing True dataDir let pFile = dataDir [relfile|projects.json|] e <- doesFileExist pFile unless e $ BS.writeFile (toFilePath pFile) "" return pFile -- | Called to initialize the FileMgr at startup. Reads the default Projects -- file. initFileMgr :: PaneState FileMgrPane MyWorkEvent -> IO (PaneState FileMgrPane MyWorkEvent) initFileMgr ps = do f <- ensureDefaultProjectFile ps' <- fileMgrReadProjectsFile f ps let e = ps' ^. errMsgL unless (null e) $ error e return ps' readProjectsFile :: MonadIO m => Path Abs File -> m (Either String Projects) readProjectsFile fp = do newprjs <- eitherDecode <$> liftIO (BS.readFile $ toFilePath fp) case newprjs of Right prjs -> Right . Projects <$> mapM (syncProject . hydrate) (projects prjs) Left e -> return $ Left e fileMgrReadProjectsFile :: MonadIO m => Path Abs File -> PaneState FileMgrPane MyWorkEvent -> m (PaneState FileMgrPane MyWorkEvent) fileMgrReadProjectsFile fp ps = readProjectsFile fp >>= \case Left er -> return $ ps & errMsgL .~ er Right prjs -> return $ ps & myProjectsL .~ prjs & myProjFileL .~ Just fp & projsChangedL .~ Right True & unsavedChangesL .~ False & exitMsgsL <>~ [ withAttr a'Notice $ str $ "Loaded " <> show fp ] fileMgrSaveProjectsFile :: MonadIO m => Path Abs File -> PaneState FileMgrPane MyWorkEvent -> m (PaneState FileMgrPane MyWorkEvent) fileMgrSaveProjectsFile fp ps = do let prjs = Projects (dehydrate <$> (projects $ myProjects ps)) liftIO $ BS.writeFile (toFilePath fp) (encode prjs) return $ ps & fBrowser .~ Nothing & myProjFileL .~ Just fp & unsavedChangesL .~ False & exitMsgsL <>~ [ withAttr a'Notice $ str $ "Wrote " <> show fp ] -- | Called to display the FileMgr modal pane to allow the user to Load or Save. showFileMgr :: PaneState FileMgrPane MyWorkEvent -> IO (PaneState FileMgrPane MyWorkEvent) showFileMgr prev = case prev ^. fBrowser of Just _ -> return prev Nothing -> do let n = WName "FMgr:Browser" dataDir <- parent <$> ensureDefaultProjectFile fb <- newFileBrowser selectNonDirectories n (Just $ toFilePath dataDir) return $ prev & fBrowser .~ Just fb ----------------------------------------------------------------------