1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
|
{-# LANGUAGE PatternGuards, CPP #-}
-----------------------------------------------------------------------------
-- |
-- Module : Plugins.Monitors.CoreCommon
-- Copyright : (c) Juraj Hercek
-- License : BSD-style (see LICENSE)
--
-- Maintainer : Juraj Hercek <juhe_haskell@hck.sk>
-- Stability : unstable
-- Portability : unportable
--
-- The common part for cpu core monitors (e.g. cpufreq, coretemp)
--
-----------------------------------------------------------------------------
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.Directory
#ifdef GHC6
import Control.Monad.Reader
instance (Monad f, Applicative f) => Applicative (ReaderT r f) where
pure a = ReaderT $ const (pure a)
f <*> a = ReaderT $ \r ->
((runReaderT f r) <*> (runReaderT a r))
#endif
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
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
|
