FileMgr.hs

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Panes.FileMgr
  (
    FileMgrPane
  , initFileMgr
  , myProjectsL
  )
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.Monad.IO.Class ( liftIO )
import           Data.Aeson ( ToJSON, FromJSON, decode, encode )
import qualified Data.ByteString.Lazy as BS
import qualified Data.Sequence as Seq
import qualified Graphics.Vty as Vty
import           Lens.Micro
import           Lens.Micro.Extras ( view )
import           System.Directory ( doesDirectoryExist )

import           Defs


data FileMgrPane

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
       , newProjects :: Bool
         -- ^ True when myProjects has been updated; clear this via updatePane
       }
  type (InitConstraints FileMgrPane s) = ()
  type (DrawConstraints FileMgrPane s WName) = ( HasFocus s WName )
  type (EventConstraints FileMgrPane e) = ( HasFocus e WName )
  initPaneState _ = FB Nothing (Projects mempty) False
  drawPane ps gs = drawFB gs <$> fB ps
  focusable _ ps = case fB ps of
                     Nothing -> mempty
                     Just _ -> Seq.fromList [ WFBrowser, WFSaveBtn ]
  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
      _ -> case bs^.getFocus of
             Focused (Just WFBrowser) -> handleFileLoadEvent ev ts
             Focused (Just WFSaveBtn) -> handleFileSaveEvent ev ts
             _ -> return ts
  type (UpdateType FileMgrPane) = Bool
  updatePane newFlag ps = ps { newProjects = newFlag }



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)


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 = (newProjects ps, myProjects ps)


drawFB :: DrawConstraints FileMgrPane drawstate WName
       => drawstate -> FileBrowser WName -> Widget WName
drawFB ds b =
  let width = 70
      fcsd = ds^.getFocus.to focused
      browserPane fb =
        let hasFocus = fcsd == Just WFBrowser
        in vLimitPercent 55 $ hLimitPercent width
           $ titledB hasFocus "Choose a file"
           $ renderFileBrowser hasFocus fb
      helpPane =
        padTop (BC.Pad 1) $ hLimitPercent width $ vBox
        [ hCenter $ txt "Up/Down: select"
        , hCenter $ txt "/: search, Ctrl-C or Esc: cancel search"
        , hCenter $ txt "Enter: change directory or select file"
        , hCenter $ txt "Space: change directory"
        , hCenter $ txt "TAB: select Save option"
        , hCenter $ txt "ESC: quit"
        ]
      errDisplay fb = case fileBrowserException fb of
                        Nothing -> emptyWidget
                        Just e -> hLimitPercent width
                                  $ withDefAttr (attrName "Error")
                                  $ strWrap
                                  $ X.displayException e
      savePane = (if fcsd == Just WFSaveBtn
                  then withAttr (attrName "Selected")
                  else id)
                 $ str "[SAVE]"
  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 ->
                let fp = fileInfoFilePath f
                in liftIO $ doesDirectoryExist fp >>= \e ->
                  if e
                  then return $ ts & fBrowser .~ Just b
                  else do newprjs <- decode <$> liftIO (BS.readFile fp)
                          -- Setting fBrowser to Nothing: exit from modal
                          case newprjs of
                            Nothing -> return $ ts & fBrowser .~ Nothing
                            Just prjs -> return $ (ts { newProjects = True})
                                         & fBrowser .~ Nothing
                                         & myProjectsL .~ prjs
      case ev of
        Vty.EvKey Vty.KEnter [] -> selectFile
        Vty.EvKey (Vty.KChar ' ') [] -> selectFile
        _ -> return $ ts & fBrowser .~ Just b
    Nothing -> return ts  -- shouldn't happen


handleFileSaveEvent :: Vty.Event
                    -> PaneState FileMgrPane MyWorkEvent
                    -> EventM WName es (PaneState FileMgrPane MyWorkEvent)
handleFileSaveEvent _ ts =
  case fileBrowserCursor =<< ts^.fBrowser of
    Nothing -> return ts
    Just f -> let fp = fileInfoFilePath f
              in liftIO (doesDirectoryExist fp) >>= \case
                    True -> return ts -- TODO: show error
                    False -> do liftIO $ BS.writeFile fp (encode $ myProjects ts)
                                return ts


instance ToJSON Projects
instance ToJSON Project
instance ToJSON Role
instance ToJSON Language
instance ToJSON Location
instance ToJSON Note

instance FromJSON Projects
instance FromJSON Project
instance FromJSON Role
instance FromJSON Language
instance FromJSON Location
instance FromJSON Note
-- deriving via Generically Note instance ToJSON Note


initFileMgr :: IO (PaneState FileMgrPane MyWorkEvent)
initFileMgr = do
  fb <- newFileBrowser selectNonDirectories WFBrowser Nothing
  return $ initPaneState fb & fBrowser .~ Just fb