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
|
{-# 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
|
