summaryrefslogtreecommitdiffhomepage
path: root/src/Plugins/Monitors/CoreCommon.hs
blob: eb3e17ffa2e1a3b6ab6c687c887a89d1a8e0f5b7 (plain)
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