clifm-0.5.0.0: src/Widgets/Entry.hs
module Widgets.Entry where
import Commons
import Control.Lens
import Data.Maybe (fromMaybe)
import Data.Time.Clock (UTCTime)
import Data.Time.Format (formatTime, defaultTimeLocale)
import Control.Exception (try, SomeException)
import Conduit
import System.FilePath (takeFileName)
import System.Directory (Permissions, getPermissions, readable, writable, executable, searchable,
getAccessTime, getModificationTime, doesFileExist, getFileSize)
import Brick.Types (Widget)
import Brick.Widgets.Core (vLimit, hBox, str, fill)
import Data.ByteUnits (ByteValue(..), ByteUnit(Bytes), getShortHand, getAppropriateUnits)
data Entry = Dir {_name :: String, _path :: FilePath, _info :: Info} |
File {_name :: String, _path :: FilePath, _info :: Info} deriving (Ord)
data Info = Info {_size :: Size, _perms :: Maybe Permissions, _times :: Maybe (UTCTime, UTCTime)} deriving (Show, Eq, Ord)
data Size = Waiting | Calculating | Known Integer | Unknown | Avoided deriving (Show, Eq)
instance Show Entry where
show Dir {_name = n} = "+ " ++ n
show File {_name = n} = "- " ++ n
instance Eq Entry where
Dir {_path = p1} == Dir {_path = p2} = p1 == p2
File {_path = p1} == File {_path = p2} = p1 == p2
_ == _ = False
instance Ord Size where
compare (Known a) (Known b) = compare a b
compare (Known _) _ = GT
compare _ (Known _) = LT
compare _ _ = EQ
-- lenses
name :: Lens' Entry String
name = lens _name (\entry n -> entry {_name = n})
path :: Lens' Entry FilePath
path = lens _path (\entry p -> entry {_path = p})
info :: Lens' Entry Info
info = lens _info (\entry i -> entry {_info = i})
size :: Lens' Entry Size
size = info.infoSize
perms :: Lens' Entry (Maybe Permissions)
perms = info.infoPerms
times :: Lens' Entry (Maybe (UTCTime, UTCTime))
times = info.infoTimes
accessTime :: Traversal' Entry UTCTime
accessTime = times._Just._1
modifTime :: Traversal' Entry UTCTime
modifTime = times._Just._2
infoSize :: Lens' Info Size
infoSize = lens _size (\entry s -> entry {_size = s})
infoPerms :: Lens' Info (Maybe Permissions)
infoPerms = lens _perms (\entry p -> entry {_perms = p})
infoTimes :: Lens' Info (Maybe (UTCTime, UTCTime))
infoTimes = lens _times (\entry t -> entry {_times = t})
-- creation
make :: FilePath -> IO Entry
make filePath = do
isFile <- doesFileExist filePath
if isFile then File (takeFileName filePath) filePath <$> makeInfo filePath True
else Dir (takeFileName filePath) filePath <$> makeInfo filePath False
makeInfo :: FilePath -> Bool -> IO Info
makeInfo filePath isFile = do
enSize <- getEntrySize filePath isFile
enPerms <- toMaybe <$> try (getPermissions filePath)
enTimes <- toMaybe <$> try (getTimes filePath)
return $ Info enSize enPerms enTimes
getTimes :: FilePath -> IO (UTCTime, UTCTime)
getTimes filePath = do
accTime <- getAccessTime filePath
modTime <- getModificationTime filePath
return (accTime, modTime)
makeBackDir :: FilePath -> IO Entry
makeBackDir filePath = do
enPerms <- toMaybe <$> try (getPermissions filePath)
enTimes <- toMaybe <$> try (getTimes filePath)
return $ Dir ".." filePath (Info Avoided enPerms enTimes)
-- rendering
render :: Bool -> Entry -> Widget Name
render _ entry = vLimit 1 $ hBox [
str $ show entry,
fill ' ',
views size (str . shortSize) entry,
views perms renderPerms entry,
renderModTime $ preview modifTime entry
]
renderPerms :: Maybe Permissions -> Widget Name
renderPerms Nothing = str " ----"
renderPerms (Just p) = str [
' ',
if readable p then 'r' else '-',
if writable p then 'w' else '-',
if executable p then 'x' else '-',
if searchable p then 's' else '-'
]
renderModTime :: Maybe UTCTime -> Widget Name
renderModTime modTime = str $ case modTime of
Just mtm -> formatTime defaultTimeLocale " %R %b %e %Y" mtm
_ -> " -----------------"
-- utility
isDir :: Entry -> Bool
isDir Dir {} = True
isDir _ = False
isFile :: Entry -> Bool
isFile File {} = True
isFile _ = False
isWaiting :: Entry -> Bool
isWaiting entry = entry ^. size == Waiting
toMaybe :: Either SomeException b -> Maybe b
toMaybe = either (const Nothing) Just
isExecutable :: Entry -> Bool
isExecutable = hasPermission executable
isReadable :: Entry -> Bool
isReadable = hasPermission readable
hasPermission :: (Permissions -> Bool) -> Entry -> Bool
hasPermission p = maybe False p . view perms
shortSize :: Size -> String
shortSize sz = case sz of
Known enSize -> getShortHand . getAppropriateUnits $ ByteValue (fromInteger enSize) Bytes
Unknown -> "???"
Calculating -> "..."
Waiting -> "..."
_ -> ""
-- directory size
getEntrySize :: FilePath -> Bool -> IO Size
getEntrySize filePath isFile
| isFile = toSizeResult <$> try (getFileSize filePath)
| otherwise = return Waiting
toSizeResult :: Either SomeException Integer -> Size
toSizeResult = either (const Unknown) Known
getDirSize :: FilePath -> IO Integer
getDirSize filePath = runConduitRes
$ sourceDirectoryDeep False filePath
.| mapMC (liftIO . getFileSize)
.| sumC