{-# 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
                                            , checkedDataRead)
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 :: forall a.
(Ord a, Num a) =>
[Char]
-> [[[Char]]]
-> Maybe ([Char], [Char] -> Int)
-> (Double -> a)
-> (a -> [Char])
-> Monitor [Char]
checkedDataRetrieval [Char]
msg [[[Char]]]
paths Maybe ([Char], [Char] -> Int)
lbl Double -> a
trans a -> [Char]
fmt =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> Maybe a -> a
fromMaybe [Char]
msg forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe a
listToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes) forall a b. (a -> b) -> a -> b
$
    forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\[[Char]]
p -> forall a.
(Ord a, Num a) =>
[[Char]]
-> Maybe ([Char], [Char] -> Int)
-> (Double -> a)
-> (a -> [Char])
-> ReaderT MConfig IO (Maybe [Char])
retrieveData [[Char]]
p Maybe ([Char], [Char] -> Int)
lbl Double -> a
trans a -> [Char]
fmt) [[[Char]]]
paths

retrieveData :: (Ord a, Num a)
             => [String] -> Maybe (String, String -> Int)
             -> (Double -> a) -> (a -> String) -> Monitor (Maybe String)
retrieveData :: forall a.
(Ord a, Num a) =>
[[Char]]
-> Maybe ([Char], [Char] -> Int)
-> (Double -> a)
-> (a -> [Char])
-> ReaderT MConfig IO (Maybe [Char])
retrieveData [[Char]]
path Maybe ([Char], [Char] -> Int)
lbl Double -> a
trans a -> [Char]
fmt = do
  [[Char]]
pairs <- forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a b. (a, b) -> a
fst) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
             (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([Char], Either Int ([Char], [Char] -> Int))
-> Monitor (Int, [Char])
readFiles forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [[Char]]
-> Maybe ([Char], [Char] -> Int)
-> Monitor [([Char], Either Int ([Char], [Char] -> Int))]
findFilesAndLabel [[Char]]
path Maybe ([Char], [Char] -> Int)
lbl)
  if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
pairs
    then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    else forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (     [[Char]] -> Monitor [Char]
parseTemplate
                    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a. (Num a, Ord a) => (a -> [Char]) -> a -> Monitor [Char]
showWithColors a -> [Char]
fmt forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> a
trans forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => [Char] -> a
read) [[Char]]
pairs
                  )

checkedDataRead :: [[String]] -> Monitor [Double]
checkedDataRead :: [[[Char]]] -> Monitor [Double]
checkedDataRead [[[Char]]]
paths = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {b}. Read b => [[Char]] -> ReaderT MConfig IO [b]
readData [[[Char]]]
paths
  where readData :: [[Char]] -> ReaderT MConfig IO [b]
readData [[Char]]
path = forall a b. (a -> b) -> [a] -> [b]
map (forall a. Read a => [Char] -> a
read forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a b. (a, b) -> a
fst) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                         (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([Char], Either Int ([Char], [Char] -> Int))
-> Monitor (Int, [Char])
readFiles forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [[Char]]
-> Maybe ([Char], [Char] -> Int)
-> Monitor [([Char], Either Int ([Char], [Char] -> Int))]
findFilesAndLabel [[Char]]
path forall a. Maybe a
Nothing)

-- | Represents the different types of path components
data Comp = Fix String
          | Var [String]
          deriving Int -> Comp -> ShowS
[Comp] -> ShowS
Comp -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Comp] -> ShowS
$cshowList :: [Comp] -> ShowS
show :: Comp -> [Char]
$cshow :: Comp -> [Char]
showsPrec :: Int -> Comp -> ShowS
$cshowsPrec :: Int -> Comp -> ShowS
Show

-- | Used to represent parts of file names separated by slashes and spaces
data CompOrSep = Slash
               | Space
               | Comp String
               deriving (CompOrSep -> CompOrSep -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompOrSep -> CompOrSep -> Bool
$c/= :: CompOrSep -> CompOrSep -> Bool
== :: CompOrSep -> CompOrSep -> Bool
$c== :: CompOrSep -> CompOrSep -> Bool
Eq, Int -> CompOrSep -> ShowS
[CompOrSep] -> ShowS
CompOrSep -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [CompOrSep] -> ShowS
$cshowList :: [CompOrSep] -> ShowS
show :: CompOrSep -> [Char]
$cshow :: CompOrSep -> [Char]
showsPrec :: Int -> CompOrSep -> ShowS
$cshowsPrec :: Int -> CompOrSep -> ShowS
Show)

-- | Function to turn a list of of strings into a list of path components
pathComponents :: [String] -> [Comp]
pathComponents :: [[Char]] -> [Comp]
pathComponents = [CompOrSep] -> [Comp]
joinComps forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [[a]] -> [a]
intercalate [CompOrSep
Space] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map [Char] -> [CompOrSep]
splitParts
  where
    splitParts :: [Char] -> [CompOrSep]
splitParts [Char]
p | ([Char]
l, Char
_:[Char]
r) <- forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== Char
'/') [Char]
p = [Char] -> CompOrSep
Comp [Char]
l forall a. a -> [a] -> [a]
: CompOrSep
Slash forall a. a -> [a] -> [a]
: [Char] -> [CompOrSep]
splitParts [Char]
r
                 | Bool
otherwise                    = [[Char] -> CompOrSep
Comp [Char]
p]

    joinComps :: [CompOrSep] -> [Comp]
joinComps = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [CompOrSep] -> [CompOrSep] -> [Comp]
joinComps' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> ([a], [a])
partition CompOrSep -> Bool
isComp

    isComp :: CompOrSep -> Bool
isComp (Comp [Char]
_) = Bool
True
    isComp CompOrSep
_        = Bool
False

    fromComp :: CompOrSep -> [Char]
fromComp (Comp [Char]
s) = [Char]
s
    fromComp CompOrSep
_        = forall a. HasCallStack => [Char] -> a
error [Char]
"fromComp applied to value other than (Comp _)"

    joinComps' :: [CompOrSep] -> [CompOrSep] -> [Comp]
joinComps' [CompOrSep]
cs []     = [[Char] -> Comp
Fix forall a b. (a -> b) -> a -> b
$ CompOrSep -> [Char]
fromComp forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [CompOrSep]
cs] -- cs should have only one element here,
                                                      -- but this keeps the pattern matching
                                                      -- exhaustive
    joinComps' [CompOrSep]
cs (CompOrSep
p:[CompOrSep]
ps) = let ([CompOrSep]
ss, [CompOrSep]
ps') = forall a. (a -> Bool) -> [a] -> ([a], [a])
span (forall a. Eq a => a -> a -> Bool
== CompOrSep
p) [CompOrSep]
ps
                               ct :: Int
ct        = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CompOrSep]
ps' Bool -> Bool -> Bool
|| (CompOrSep
p forall a. Eq a => a -> a -> Bool
== CompOrSep
Space) then forall (t :: * -> *) a. Foldable t => t a -> Int
length [CompOrSep]
ss forall a. Num a => a -> a -> a
+ Int
1
                                                                       else forall (t :: * -> *) a. Foldable t => t a -> Int
length [CompOrSep]
ss
                               ([CompOrSep]
ls, [CompOrSep]
rs)  = forall a. Int -> [a] -> ([a], [a])
splitAt (Int
ctforall a. Num a => a -> a -> a
+Int
1) [CompOrSep]
cs
                               c :: Comp
c         = case CompOrSep
p of
                                             CompOrSep
Space -> [[Char]] -> Comp
Var forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map CompOrSep -> [Char]
fromComp [CompOrSep]
ls
                                             CompOrSep
Slash -> [Char] -> Comp
Fix forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"/" forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map CompOrSep -> [Char]
fromComp [CompOrSep]
ls
                                             CompOrSep
_     -> forall a. HasCallStack => [Char] -> a
error [Char]
"Should not happen"
                           in  if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CompOrSep]
ps' then [Comp
c]
                                           else Comp
cforall a. a -> [a] -> [a]
:[CompOrSep] -> [CompOrSep] -> [Comp]
joinComps' [CompOrSep]
rs (forall a. Int -> [a] -> [a]
drop Int
ct [CompOrSep]
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 :: [[Char]]
-> Maybe ([Char], [Char] -> Int)
-> Monitor [([Char], Either Int ([Char], [Char] -> Int))]
findFilesAndLabel [[Char]]
path Maybe ([Char], [Char] -> Int)
lbl  =  forall a. [Maybe a] -> [a]
catMaybes
                   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (     forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {a}.
(a, [Char])
-> ReaderT
     MConfig IO (Maybe ([Char], Either a ([Char], [Char] -> Int)))
addLabel forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
sort
                         forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Comp] -> [Char] -> ReaderT MConfig IO [[Char]]
recFindFiles ([[Char]] -> [Comp]
pathComponents [[Char]]
path) [Char]
"/"
                       )
  where
    addLabel :: (a, [Char])
-> ReaderT
     MConfig IO (Maybe ([Char], Either a ([Char], [Char] -> Int)))
addLabel (a
i, [Char]
f) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just ([Char]
f, forall a b. a -> Either a b
Left a
i))
                            (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall {b} {a}.
[Char]
-> [Char]
-> b
-> ReaderT MConfig IO (Maybe ([Char], Either a ([Char], b)))
justIfExists [Char]
f))
                            Maybe ([Char], [Char] -> Int)
lbl

    justIfExists :: [Char]
-> [Char]
-> b
-> ReaderT MConfig IO (Maybe ([Char], Either a ([Char], b)))
justIfExists [Char]
f [Char]
s b
t = let f' :: [Char]
f' = forall a. Int -> [a] -> [a]
take (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
f forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
s) [Char]
f forall a. [a] -> [a] -> [a]
++ [Char]
s
                         in  forall a. a -> a -> Bool -> a
ifthen (forall a. a -> Maybe a
Just ([Char]
f, forall a b. b -> Either a b
Right ([Char]
f', b
t))) forall a. Maybe a
Nothing forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IO a -> Monitor a
io ([Char] -> IO Bool
doesFileExist [Char]
f')

    recFindFiles :: [Comp] -> [Char] -> ReaderT MConfig IO [[Char]]
recFindFiles [] [Char]
d  =  forall a. a -> a -> Bool -> a
ifthen [[Char]
d] []
                      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IO a -> Monitor a
io (if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
d then forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False else [Char] -> IO Bool
doesFileExist [Char]
d)
    recFindFiles [Comp]
ps [Char]
d  =  forall a. a -> a -> Bool -> a
ifthen ([Comp] -> [Char] -> ReaderT MConfig IO [[Char]]
recFindFiles' [Comp]
ps [Char]
d) (forall (m :: * -> *) a. Monad m => a -> m a
return [])
                      forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. IO a -> Monitor a
io (if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
d then forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True else [Char] -> IO Bool
doesDirectoryExist [Char]
d)

    recFindFiles' :: [Comp] -> [Char] -> ReaderT MConfig IO [[Char]]
recFindFiles' []         [Char]
_  =  forall a. HasCallStack => [Char] -> a
error [Char]
"Should not happen"
    recFindFiles' (Fix [Char]
p:[Comp]
ps) [Char]
d  =  [Comp] -> [Char] -> ReaderT MConfig IO [[Char]]
recFindFiles [Comp]
ps ([Char]
d forall a. [a] -> [a] -> [a]
++ [Char]
"/" forall a. [a] -> [a] -> [a]
++ [Char]
p)
    recFindFiles' (Var [[Char]]
p:[Comp]
ps) [Char]
d  =  forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                               forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([Comp] -> [Char] -> ReaderT MConfig IO [[Char]]
recFindFiles [Comp]
ps
                                           forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\[Char]
f -> [Char]
d forall a. [a] -> [a] -> [a]
++ [Char]
"/" forall a. [a] -> [a] -> [a]
++ [Char]
f))
                                      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter ([[Char]] -> [Char] -> Bool
matchesVar [[Char]]
p))
                                     forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. IO a -> Monitor a
io ([Char] -> IO [[Char]]
getDirectoryContents [Char]
d)
                                   )

    matchesVar :: [[Char]] -> [Char] -> Bool
matchesVar []     [Char]
_  = Bool
False
    matchesVar [[Char]
v]    [Char]
f  = [Char]
v forall a. Eq a => a -> a -> Bool
== [Char]
f
    matchesVar ([Char]
v:[[Char]]
vs) [Char]
f  = let f' :: [Char]
f'  = forall a. Int -> [a] -> [a]
drop (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
v) [Char]
f
                               f'' :: [Char]
f'' = forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isDigit [Char]
f'
                           in  forall (t :: * -> *). Foldable t => t Bool -> Bool
and [ [Char]
v forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
f
                                   , Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
f')
                                   , Char -> Bool
isDigit (forall a. [a] -> a
head [Char]
f')
                                   , [[Char]] -> [Char] -> Bool
matchesVar [[Char]]
vs [Char]
f''
                                   ]

-- | Function to read the contents of the given file(s)
readFiles :: (String, Either Int (String, String -> Int))
          -> Monitor (Int, String)
readFiles :: ([Char], Either Int ([Char], [Char] -> Int))
-> Monitor (Int, [Char])
readFiles ([Char]
fval, Either Int ([Char], [Char] -> Int)
flbl) = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. Monad m => a -> m a
return (\([Char]
f, [Char] -> Int
ex) -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Char] -> Int
ex
                                                            forall a b. (a -> b) -> a -> b
$ forall a. IO a -> Monitor a
io forall a b. (a -> b) -> a -> b
$ [Char] -> IO [Char]
readFile [Char]
f) Either Int ([Char], [Char] -> Int)
flbl
                             forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. IO a -> Monitor a
io ([Char] -> IO [Char]
readFile [Char]
fval)

-- | Function that captures if-then-else
ifthen :: a -> a -> Bool -> a
ifthen :: forall a. a -> a -> Bool -> a
ifthen a
thn a
els Bool
cnd = if Bool
cnd then a
thn else a
els