diff options
Diffstat (limited to 'src/Xmobar/Plugins/Monitors/Common')
| -rw-r--r-- | src/Xmobar/Plugins/Monitors/Common/Files.hs | 141 |
1 files changed, 141 insertions, 0 deletions
diff --git a/src/Xmobar/Plugins/Monitors/Common/Files.hs b/src/Xmobar/Plugins/Monitors/Common/Files.hs new file mode 100644 index 0000000..b08fe6c --- /dev/null +++ b/src/Xmobar/Plugins/Monitors/Common/Files.hs @@ -0,0 +1,141 @@ +{-# LANGUAGE CPP, PatternGuards #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Plugins.Monitors.Files +-- Copyright : (c) Juraj Hercek +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Juraj Hercek <juhe_haskell@hck.sk> +-- Stability : unstable +-- Portability : unportable +-- +-- Specialized helpers to access files and their contents +-- +----------------------------------------------------------------------------- + +module Xmobar.Plugins.Monitors.Common.Files (checkedDataRetrieval) where + +#if __GLASGOW_HASKELL__ < 800 +import Control.Applicative +#endif + +import Data.Char hiding (Space) +import Data.Function +import Data.List +import Data.Maybe +import System.Directory + +import Xmobar.Plugins.Monitors.Common.Types +import Xmobar.Plugins.Monitors.Common.Parsers +import Xmobar.Plugins.Monitors.Common.Output + +checkedDataRetrieval :: (Ord a, Num a) + => String -> [[String]] -> Maybe (String, String -> Int) + -> (Double -> a) -> (a -> String) -> Monitor String +checkedDataRetrieval msg paths lbl trans fmt = + fmap (fromMaybe msg . listToMaybe . catMaybes) $ + mapM (\p -> retrieveData p lbl trans fmt) paths + +retrieveData :: (Ord a, Num a) + => [String] -> Maybe (String, String -> Int) + -> (Double -> a) -> (a -> String) -> Monitor (Maybe String) +retrieveData path lbl trans fmt = do + pairs <- map snd . sortBy (compare `on` fst) <$> + (mapM readFiles =<< findFilesAndLabel path lbl) + if null pairs + then return Nothing + else Just <$> ( parseTemplate + =<< mapM (showWithColors fmt . trans . read) pairs + ) + +-- | Represents the different types of path components +data Comp = Fix String + | Var [String] + deriving Show + +-- | Used to represent parts of file names separated by slashes and spaces +data CompOrSep = Slash + | Space + | Comp String + deriving (Eq, Show) + +-- | Function to turn a list of of strings into a list of path components +pathComponents :: [String] -> [Comp] +pathComponents = joinComps . drop 2 . intercalate [Space] . map splitParts + where + splitParts p | (l, _:r) <- break (== '/') p = Comp l : Slash : splitParts r + | otherwise = [Comp p] + + joinComps = uncurry joinComps' . partition isComp + + isComp (Comp _) = True + isComp _ = False + + fromComp (Comp s) = s + fromComp _ = error "fromComp applied to value other than (Comp _)" + + joinComps' cs [] = [Fix $ fromComp $ head cs] -- cs should have only one element here, + -- but this keeps the pattern matching + -- exhaustive + joinComps' cs (p:ps) = let (ss, ps') = span (== p) ps + ct = if null ps' || (p == Space) then length ss + 1 + else length ss + (ls, rs) = splitAt (ct+1) cs + c = case p of + Space -> Var $ map fromComp ls + Slash -> Fix $ intercalate "/" $ map fromComp ls + _ -> error "Should not happen" + in if null ps' then [c] + else c:joinComps' rs (drop ct ps) + +-- | Function to find all files matching the given path and possible label file. +-- The path must be absolute (start with a leading slash). +findFilesAndLabel :: [String] -> Maybe (String, String -> Int) + -> Monitor [(String, Either Int (String, String -> Int))] +findFilesAndLabel path lbl = catMaybes + <$> ( mapM addLabel . zip [0..] . sort + =<< recFindFiles (pathComponents path) "/" + ) + where + addLabel (i, f) = maybe (return $ Just (f, Left i)) + (uncurry (justIfExists f)) + lbl + + justIfExists f s t = let f' = take (length f - length s) f ++ s + in ifthen (Just (f, Right (f', t))) Nothing <$> io (doesFileExist f') + + recFindFiles [] d = ifthen [d] [] + <$> io (if null d then return False else doesFileExist d) + recFindFiles ps d = ifthen (recFindFiles' ps d) (return []) + =<< io (if null d then return True else doesDirectoryExist d) + + recFindFiles' [] _ = error "Should not happen" + recFindFiles' (Fix p:ps) d = recFindFiles ps (d ++ "/" ++ p) + recFindFiles' (Var p:ps) d = concat + <$> ((mapM (recFindFiles ps + . (\f -> d ++ "/" ++ f)) + . filter (matchesVar p)) + =<< io (getDirectoryContents d) + ) + + matchesVar [] _ = False + matchesVar [v] f = v == f + matchesVar (v:vs) f = let f' = drop (length v) f + f'' = dropWhile isDigit f' + in and [ v `isPrefixOf` f + , not (null f') + , isDigit (head f') + , matchesVar vs f'' + ] + +-- | Function to read the contents of the given file(s) +readFiles :: (String, Either Int (String, String -> Int)) + -> Monitor (Int, String) +readFiles (fval, flbl) = (,) <$> either return (\(f, ex) -> fmap ex + $ io $ readFile f) flbl + <*> io (readFile fval) + +-- | Function that captures if-then-else +ifthen :: a -> a -> Bool -> a +ifthen thn els cnd = if cnd then thn else els |