Cope with new file system layout of CPU temperature sensor readings

Either due to a change in lm_sensors or in the kernel itself, the core
temperature readings are no longer found in one directory per core but in
multiple files in the same directory.  What's worse is that the file names have
little to do with the actual core number.  This patch addresses this and is
flexible enough to handle the old layout and the new one.

3 files changed, 125 insertions, 56 deletions

diff --git a/src/Plugins/Monitors/CoreCommon.hs b/src/Plugins/Monitors/CoreCommon.hs
index 80e7700..e508f7d 100644
--- a/src/Plugins/Monitors/CoreCommon.hs
+++ b/src/Plugins/Monitors/CoreCommon.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE PatternGuards #-}
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Plugins.Monitors.CoreCommon
@@ -14,46 +16,119 @@
 
 module Plugins.Monitors.CoreCommon where
 
+import Control.Applicative
+import Control.Monad
+import Data.Char hiding (Space)
+import Data.Function
+import Data.List
+import Data.Maybe
 import Plugins.Monitors.Common
-import System.Posix.Files (fileExist)
-import System.IO (withFile, IOMode(ReadMode), hGetLine)
 import System.Directory
-import Data.Char (isDigit)
-import Data.List (isPrefixOf)
 
--- |
--- Function checks the existence of first file specified by pattern and if the
--- file doesn't exists failure message is shown, otherwise the data retrieval
--- is performed.
-checkedDataRetrieval :: (Num a, Ord a, Show a) =>
-                        String -> String -> String -> String -> (Double -> a)
-                        -> (a -> String) -> Monitor String
-checkedDataRetrieval failureMessage dir file pattern trans fmt = do
-    exists <- io $ fileExist $ concat [dir, "/", pattern, "0/", file]
-    case exists of
-         False  -> return failureMessage
-         True   -> retrieveData dir file pattern trans fmt
+checkedDataRetrieval :: (Ord a, Num a)
+                     => String -> [String] -> Maybe (String, String -> Int)
+                     -> (Double -> a) -> (a -> String) -> Monitor String
+checkedDataRetrieval msg path lbl trans fmt = liftM (maybe msg id) $
+                                              retrieveData path lbl trans fmt
 
--- |
--- Function retrieves data from files in directory dir specified by
--- pattern. String values are converted to double and 'trans' applied
--- to each one. Final array is processed by template parser function
--- and returned as monitor string.
-retrieveData :: (Num a, Ord a, Show a) =>
-                String -> String -> String -> (Double -> a) -> (a -> String) ->
-                Monitor String
-retrieveData dir file pattern trans fmt = do
-    count <- io $ dirCount dir pattern
-    contents <- io $ mapM getGuts $ files count
-    values <- mapM (showWithColors fmt) $ map conversion contents
-    parseTemplate values
-    where
-        getGuts f = withFile f ReadMode hGetLine
-        dirCount path str = getDirectoryContents path
-                            >>= return . length
-                                       . filter (\s -> str `isPrefixOf` s
-                                                       && isDigit (last s))
-        files count = map (\i -> concat [dir, "/", pattern, show i, "/", file])
-                          [0 .. count - 1]
-        conversion = trans . (read :: String -> Double)
+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 =<< findFiles 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 . concat . intersperse [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).
+findFiles :: [String] -> Maybe (String, String -> Int)
+          -> Monitor [(String, Either Int (String, String -> Int))]
+findFiles path lbl  =  catMaybes
+                   <$> (     mapM addLabel . zip [0..] . sort
+                         =<< recFindFiles (pathComponents path) "/"
+                       )
+  where
+    addLabel (i, f) = maybe (return $ Just (f, Left i))
+                            (\(s, t) -> justIfExists f s t)
+                            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)
+                                      .  map (\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) -> liftM 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
\ No newline at end of file
diff --git a/src/Plugins/Monitors/CoreTemp.hs b/src/Plugins/Monitors/CoreTemp.hs
index a24b284..f7b5c95 100644
--- a/src/Plugins/Monitors/CoreTemp.hs
+++ b/src/Plugins/Monitors/CoreTemp.hs
@@ -31,11 +31,9 @@ coreTempConfig = mkMConfig
 -- Function retrieves monitor string holding the core temperature
 -- (or temperatures)
 runCoreTemp :: [String] -> Monitor String
-runCoreTemp _ = do
-    let dir = "/sys/bus/platform/devices"
-        file = "temp1_input"
-        pattern = "coretemp."
-        divisor = 1e3 :: Double
-        failureMessage = "CoreTemp: N/A"
-    checkedDataRetrieval failureMessage dir file pattern (/divisor) show
+runCoreTemp _ = let path = ["/sys/bus/platform/devices/coretemp.", "/temp", "_input"]
+                    lbl  = Just ("_label", read . drop 5)
+                    divisor = 1e3 :: Double
+                    failureMessage = "CoreTemp: N/A"
+                in  checkedDataRetrieval failureMessage path lbl (/divisor) show
 
diff --git a/src/Plugins/Monitors/CpuFreq.hs b/src/Plugins/Monitors/CpuFreq.hs
index 4f01922..dcf75e5 100644
--- a/src/Plugins/Monitors/CpuFreq.hs
+++ b/src/Plugins/Monitors/CpuFreq.hs
@@ -28,16 +28,12 @@ cpuFreqConfig = mkMConfig
                                                               -- replacements
 
 -- |
--- Function retrieves monitor string holding the cpu frequency (or
--- frequencies)
+-- Function retrieves monitor string holding the cpu frequency (or frequencies)
 runCpuFreq :: [String] -> Monitor String
-runCpuFreq _ = do
-    let dir = "/sys/devices/system/cpu"
-        file = "cpufreq/scaling_cur_freq"
-        pattern = "cpu"
-        divisor = 1e6 :: Double
-        failureMessage = "CpuFreq: N/A"
-        fmt x | x < 1     = show (round (x * 1000) :: Integer) ++ "MHz"
-              | otherwise = showDigits 1 x ++ "GHz"
-    checkedDataRetrieval failureMessage dir file pattern (/divisor) fmt
+runCpuFreq _ = let path = ["/sys/devices/system/cpu/cpu", "/cpufreq/scaling_cur_freq"]
+                   divisor = 1e6 :: Double
+                   failureMessage = "CpuFreq: N/A"
+                   fmt x | x < 1     = (show (round (x * 1000) :: Integer)) ++ "MHz"
+                         | otherwise = (show x) ++ "GHz"
+               in  checkedDataRetrieval failureMessage path Nothing (/divisor) fmt