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

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

checkedDataRead :: [[String]] -> Monitor [Double]
checkedDataRead :: [[String]] -> Monitor [Double]
checkedDataRead [[String]]
paths = [[Double]] -> [Double]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Double]] -> [Double])
-> ReaderT MConfig IO [[Double]] -> Monitor [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([String] -> Monitor [Double])
-> [[String]] -> ReaderT MConfig IO [[Double]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [String] -> Monitor [Double]
forall b. Read b => [String] -> ReaderT MConfig IO [b]
readData [[String]]
paths
  where readData :: [String] -> ReaderT MConfig IO [b]
readData [String]
path = ((Int, String) -> b) -> [(Int, String)] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (String -> b
forall a. Read a => String -> a
read (String -> b) -> ((Int, String) -> String) -> (Int, String) -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, String) -> String
forall a b. (a, b) -> b
snd) ([(Int, String)] -> [b])
-> ([(Int, String)] -> [(Int, String)]) -> [(Int, String)] -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, String) -> (Int, String) -> Ordering)
-> [(Int, String)] -> [(Int, String)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int -> Int -> Ordering)
-> ((Int, String) -> Int)
-> (Int, String)
-> (Int, String)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Int, String) -> Int
forall a b. (a, b) -> a
fst) ([(Int, String)] -> [b])
-> ReaderT MConfig IO [(Int, String)] -> ReaderT MConfig IO [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                         (((String, Either Int (String, String -> Int))
 -> ReaderT MConfig IO (Int, String))
-> [(String, Either Int (String, String -> Int))]
-> ReaderT MConfig IO [(Int, String)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (String, Either Int (String, String -> Int))
-> ReaderT MConfig IO (Int, String)
readFiles ([(String, Either Int (String, String -> Int))]
 -> ReaderT MConfig IO [(Int, String)])
-> ReaderT
     MConfig IO [(String, Either Int (String, String -> Int))]
-> ReaderT MConfig IO [(Int, String)]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [String]
-> Maybe (String, String -> Int)
-> ReaderT
     MConfig IO [(String, Either Int (String, String -> Int))]
findFilesAndLabel [String]
path Maybe (String, String -> Int)
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 -> String
(Int -> Comp -> ShowS)
-> (Comp -> String) -> ([Comp] -> ShowS) -> Show Comp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Comp] -> ShowS
$cshowList :: [Comp] -> ShowS
show :: Comp -> String
$cshow :: Comp -> String
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
(CompOrSep -> CompOrSep -> Bool)
-> (CompOrSep -> CompOrSep -> Bool) -> Eq CompOrSep
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 -> String
(Int -> CompOrSep -> ShowS)
-> (CompOrSep -> String)
-> ([CompOrSep] -> ShowS)
-> Show CompOrSep
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompOrSep] -> ShowS
$cshowList :: [CompOrSep] -> ShowS
show :: CompOrSep -> String
$cshow :: CompOrSep -> String
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 :: [String] -> [Comp]
pathComponents = [CompOrSep] -> [Comp]
joinComps ([CompOrSep] -> [Comp])
-> ([String] -> [CompOrSep]) -> [String] -> [Comp]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [CompOrSep] -> [CompOrSep]
forall a. Int -> [a] -> [a]
drop Int
2 ([CompOrSep] -> [CompOrSep])
-> ([String] -> [CompOrSep]) -> [String] -> [CompOrSep]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CompOrSep] -> [[CompOrSep]] -> [CompOrSep]
forall a. [a] -> [[a]] -> [a]
intercalate [CompOrSep
Space] ([[CompOrSep]] -> [CompOrSep])
-> ([String] -> [[CompOrSep]]) -> [String] -> [CompOrSep]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> [CompOrSep]) -> [String] -> [[CompOrSep]]
forall a b. (a -> b) -> [a] -> [b]
map String -> [CompOrSep]
splitParts
  where
    splitParts :: String -> [CompOrSep]
splitParts String
p | (String
l, Char
_:String
r) <- (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') String
p = String -> CompOrSep
Comp String
l CompOrSep -> [CompOrSep] -> [CompOrSep]
forall a. a -> [a] -> [a]
: CompOrSep
Slash CompOrSep -> [CompOrSep] -> [CompOrSep]
forall a. a -> [a] -> [a]
: String -> [CompOrSep]
splitParts String
r
                 | Bool
otherwise                    = [String -> CompOrSep
Comp String
p]

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

    isComp :: CompOrSep -> Bool
isComp (Comp String
_) = Bool
True
    isComp CompOrSep
_        = Bool
False

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

    joinComps' :: [CompOrSep] -> [CompOrSep] -> [Comp]
joinComps' [CompOrSep]
cs []     = [String -> Comp
Fix (String -> Comp) -> String -> Comp
forall a b. (a -> b) -> a -> b
$ CompOrSep -> String
fromComp (CompOrSep -> String) -> CompOrSep -> String
forall a b. (a -> b) -> a -> b
$ [CompOrSep] -> CompOrSep
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') = (CompOrSep -> Bool) -> [CompOrSep] -> ([CompOrSep], [CompOrSep])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (CompOrSep -> CompOrSep -> Bool
forall a. Eq a => a -> a -> Bool
== CompOrSep
p) [CompOrSep]
ps
                               ct :: Int
ct        = if [CompOrSep] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CompOrSep]
ps' Bool -> Bool -> Bool
|| (CompOrSep
p CompOrSep -> CompOrSep -> Bool
forall a. Eq a => a -> a -> Bool
== CompOrSep
Space) then [CompOrSep] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [CompOrSep]
ss Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                                                                       else [CompOrSep] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [CompOrSep]
ss
                               ([CompOrSep]
ls, [CompOrSep]
rs)  = Int -> [CompOrSep] -> ([CompOrSep], [CompOrSep])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int
ctInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [CompOrSep]
cs
                               c :: Comp
c         = case CompOrSep
p of
                                             CompOrSep
Space -> [String] -> Comp
Var ([String] -> Comp) -> [String] -> Comp
forall a b. (a -> b) -> a -> b
$ (CompOrSep -> String) -> [CompOrSep] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map CompOrSep -> String
fromComp [CompOrSep]
ls
                                             CompOrSep
Slash -> String -> Comp
Fix (String -> Comp) -> String -> Comp
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"/" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (CompOrSep -> String) -> [CompOrSep] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map CompOrSep -> String
fromComp [CompOrSep]
ls
                                             CompOrSep
_     -> String -> Comp
forall a. HasCallStack => String -> a
error String
"Should not happen"
                           in  if [CompOrSep] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CompOrSep]
ps' then [Comp
c]
                                           else Comp
cComp -> [Comp] -> [Comp]
forall a. a -> [a] -> [a]
:[CompOrSep] -> [CompOrSep] -> [Comp]
joinComps' [CompOrSep]
rs (Int -> [CompOrSep] -> [CompOrSep]
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 :: [String]
-> Maybe (String, String -> Int)
-> ReaderT
     MConfig IO [(String, Either Int (String, String -> Int))]
findFilesAndLabel [String]
path Maybe (String, String -> Int)
lbl  =  [Maybe (String, Either Int (String, String -> Int))]
-> [(String, Either Int (String, String -> Int))]
forall a. [Maybe a] -> [a]
catMaybes
                   ([Maybe (String, Either Int (String, String -> Int))]
 -> [(String, Either Int (String, String -> Int))])
-> ReaderT
     MConfig IO [Maybe (String, Either Int (String, String -> Int))]
-> ReaderT
     MConfig IO [(String, Either Int (String, String -> Int))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (     ((Int, String)
 -> ReaderT
      MConfig IO (Maybe (String, Either Int (String, String -> Int))))
-> [(Int, String)]
-> ReaderT
     MConfig IO [Maybe (String, Either Int (String, String -> Int))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Int, String)
-> ReaderT
     MConfig IO (Maybe (String, Either Int (String, String -> Int)))
forall a.
(a, String)
-> ReaderT
     MConfig IO (Maybe (String, Either a (String, String -> Int)))
addLabel ([(Int, String)]
 -> ReaderT
      MConfig IO [Maybe (String, Either Int (String, String -> Int))])
-> ([String] -> [(Int, String)])
-> [String]
-> ReaderT
     MConfig IO [Maybe (String, Either Int (String, String -> Int))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [String] -> [(Int, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([String] -> [(Int, String)])
-> ([String] -> [String]) -> [String] -> [(Int, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. Ord a => [a] -> [a]
sort
                         ([String]
 -> ReaderT
      MConfig IO [Maybe (String, Either Int (String, String -> Int))])
-> ReaderT MConfig IO [String]
-> ReaderT
     MConfig IO [Maybe (String, Either Int (String, String -> Int))]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Comp] -> String -> ReaderT MConfig IO [String]
recFindFiles ([String] -> [Comp]
pathComponents [String]
path) String
"/"
                       )
  where
    addLabel :: (a, String)
-> ReaderT
     MConfig IO (Maybe (String, Either a (String, String -> Int)))
addLabel (a
i, String
f) = ReaderT
  MConfig IO (Maybe (String, Either a (String, String -> Int)))
-> ((String, String -> Int)
    -> ReaderT
         MConfig IO (Maybe (String, Either a (String, String -> Int))))
-> Maybe (String, String -> Int)
-> ReaderT
     MConfig IO (Maybe (String, Either a (String, String -> Int)))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe (String, Either a (String, String -> Int))
-> ReaderT
     MConfig IO (Maybe (String, Either a (String, String -> Int)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (String, Either a (String, String -> Int))
 -> ReaderT
      MConfig IO (Maybe (String, Either a (String, String -> Int))))
-> Maybe (String, Either a (String, String -> Int))
-> ReaderT
     MConfig IO (Maybe (String, Either a (String, String -> Int)))
forall a b. (a -> b) -> a -> b
$ (String, Either a (String, String -> Int))
-> Maybe (String, Either a (String, String -> Int))
forall a. a -> Maybe a
Just (String
f, a -> Either a (String, String -> Int)
forall a b. a -> Either a b
Left a
i))
                            ((String
 -> (String -> Int)
 -> ReaderT
      MConfig IO (Maybe (String, Either a (String, String -> Int))))
-> (String, String -> Int)
-> ReaderT
     MConfig IO (Maybe (String, Either a (String, String -> Int)))
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (String
-> String
-> (String -> Int)
-> ReaderT
     MConfig IO (Maybe (String, Either a (String, String -> Int)))
forall b a.
String
-> String
-> b
-> ReaderT MConfig IO (Maybe (String, Either a (String, b)))
justIfExists String
f))
                            Maybe (String, String -> Int)
lbl

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

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

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

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

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

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