From cf874686b755ebc3784c7123752473f7c12c0580 Mon Sep 17 00:00:00 2001 From: jao Date: Mon, 3 Dec 2018 03:47:05 +0000 Subject: CoreCommon -> Common.Files --- src/Xmobar/Plugins/Monitors/CatInt.hs | 1 - src/Xmobar/Plugins/Monitors/Common.hs | 2 + src/Xmobar/Plugins/Monitors/Common/Files.hs | 141 ++++++++++++++++++++++++++++ src/Xmobar/Plugins/Monitors/CoreCommon.hs | 138 --------------------------- src/Xmobar/Plugins/Monitors/CoreTemp.hs | 2 - src/Xmobar/Plugins/Monitors/CpuFreq.hs | 1 - xmobar.cabal | 3 +- 7 files changed, 145 insertions(+), 143 deletions(-) create mode 100644 src/Xmobar/Plugins/Monitors/Common/Files.hs delete mode 100644 src/Xmobar/Plugins/Monitors/CoreCommon.hs diff --git a/src/Xmobar/Plugins/Monitors/CatInt.hs b/src/Xmobar/Plugins/Monitors/CatInt.hs index 781eded..0c4e391 100644 --- a/src/Xmobar/Plugins/Monitors/CatInt.hs +++ b/src/Xmobar/Plugins/Monitors/CatInt.hs @@ -13,7 +13,6 @@ module Xmobar.Plugins.Monitors.CatInt where import Xmobar.Plugins.Monitors.Common -import Xmobar.Plugins.Monitors.CoreCommon catIntConfig :: IO MConfig catIntConfig = mkMConfig "" ["v"] diff --git a/src/Xmobar/Plugins/Monitors/Common.hs b/src/Xmobar/Plugins/Monitors/Common.hs index 10c3c9f..02eb7ae 100644 --- a/src/Xmobar/Plugins/Monitors/Common.hs +++ b/src/Xmobar/Plugins/Monitors/Common.hs @@ -18,9 +18,11 @@ module Xmobar.Plugins.Monitors.Common , module Xmobar.Plugins.Monitors.Common.Run , module Xmobar.Plugins.Monitors.Common.Output , module Xmobar.Plugins.Monitors.Common.Parsers + , module Xmobar.Plugins.Monitors.Common.Files ) where import Xmobar.Plugins.Monitors.Common.Types import Xmobar.Plugins.Monitors.Common.Run import Xmobar.Plugins.Monitors.Common.Output import Xmobar.Plugins.Monitors.Common.Parsers +import Xmobar.Plugins.Monitors.Common.Files 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 +-- 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 diff --git a/src/Xmobar/Plugins/Monitors/CoreCommon.hs b/src/Xmobar/Plugins/Monitors/CoreCommon.hs deleted file mode 100644 index a84198e..0000000 --- a/src/Xmobar/Plugins/Monitors/CoreCommon.hs +++ /dev/null @@ -1,138 +0,0 @@ -{-# LANGUAGE CPP, PatternGuards #-} - ------------------------------------------------------------------------------ --- | --- Module : Plugins.Monitors.CoreCommon --- Copyright : (c) Juraj Hercek --- License : BSD-style (see LICENSE) --- --- Maintainer : Juraj Hercek --- Stability : unstable --- Portability : unportable --- --- The common part for cpu core monitors (e.g. cpufreq, coretemp) --- ------------------------------------------------------------------------------ - -module Xmobar.Plugins.Monitors.CoreCommon where - -#if __GLASGOW_HASKELL__ < 800 -import Control.Applicative -#endif - -import Data.Char hiding (Space) -import Data.Function -import Data.List -import Data.Maybe -import Xmobar.Plugins.Monitors.Common -import System.Directory - -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 diff --git a/src/Xmobar/Plugins/Monitors/CoreTemp.hs b/src/Xmobar/Plugins/Monitors/CoreTemp.hs index 48fe428..3e462ce 100644 --- a/src/Xmobar/Plugins/Monitors/CoreTemp.hs +++ b/src/Xmobar/Plugins/Monitors/CoreTemp.hs @@ -15,8 +15,6 @@ module Xmobar.Plugins.Monitors.CoreTemp where import Xmobar.Plugins.Monitors.Common -import Xmobar.Plugins.Monitors.CoreCommon - import Data.Char (isDigit) diff --git a/src/Xmobar/Plugins/Monitors/CpuFreq.hs b/src/Xmobar/Plugins/Monitors/CpuFreq.hs index 1afedfa..9274cd7 100644 --- a/src/Xmobar/Plugins/Monitors/CpuFreq.hs +++ b/src/Xmobar/Plugins/Monitors/CpuFreq.hs @@ -15,7 +15,6 @@ module Xmobar.Plugins.Monitors.CpuFreq where import Xmobar.Plugins.Monitors.Common -import Xmobar.Plugins.Monitors.CoreCommon -- | -- Cpu frequency default configuration. Default template contains only diff --git a/xmobar.cabal b/xmobar.cabal index 3436ecb..bef4bdd 100644 --- a/xmobar.cabal +++ b/xmobar.cabal @@ -141,7 +141,7 @@ library Xmobar.Plugins.Monitors.Common.Run, Xmobar.Plugins.Monitors.Common.Output, Xmobar.Plugins.Monitors.Common.Parsers, - Xmobar.Plugins.Monitors.CoreCommon, + Xmobar.Plugins.Monitors.Common.Files, Xmobar.Plugins.Monitors.CoreTemp, Xmobar.Plugins.Monitors.CpuFreq, Xmobar.Plugins.Monitors.Cpu, @@ -320,6 +320,7 @@ test-suite XmobarTest Xmobar.Plugins.Monitors.Common.Run Xmobar.Plugins.Monitors.Common.Types Xmobar.Plugins.Monitors.Common.Output + Xmobar.Plugins.Monitors.Common.Files Xmobar.Run.Exec Xmobar.System.Signal -- cgit v1.2.3