{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ImplicitParams #-}
module Monitor.Configuration.Read
  ( readMonitor
  , notHidden
  , isCheck
  , collectMonitors
  )
  where

import Control.Concurrent

import System.Directory
import System.FilePath
import System.FSNotify

import Monitor.Configuration.Config
import Monitor.DataModel

collectMonitors :: FilePath -> IO [FilePath]
collectMonitors :: FilePath -> IO [FilePath]
collectMonitors FilePath
configDir = do
  [FilePath]
mDatabaseDirs <- FilePath -> IO [FilePath]
listDirectory FilePath
configDir
  [FilePath]
relativePaths <- (FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM FilePath -> IO Bool
doesDirectoryExist
    ((FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
configDir FilePath -> FilePath -> FilePath
</>) ([FilePath] -> [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter FilePath -> Bool
notHidden ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath]
mDatabaseDirs)
  FilePath
currentDir <- IO FilePath
getCurrentDirectory
  [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
currentDir FilePath -> FilePath -> FilePath
</>) [FilePath]
relativePaths

tryReadConfig :: (?mutex :: Mutexes) => FilePath -> MVar () -> String -> IO Settings
tryReadConfig :: FilePath -> MVar () -> FilePath -> IO Settings
tryReadConfig FilePath
dir MVar ()
configChange FilePath
tgvar = do
  MVar () -> IO ()
forall a. MVar a -> IO a
takeMVar MVar ()
configChange
  (?mutex::Mutexes) => FilePath -> MVar () -> FilePath -> IO Settings
FilePath -> MVar () -> FilePath -> IO Settings
readConfig FilePath
dir MVar ()
configChange FilePath
tgvar

readConfig :: (?mutex :: Mutexes) => FilePath -> MVar () -> String -> IO Settings
readConfig :: FilePath -> MVar () -> FilePath -> IO Settings
readConfig FilePath
dir MVar ()
configChange FilePath
tgvar = do
  let configPath :: FilePath
configPath = FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
configName
  Bool
configExists <- FilePath -> IO Bool
doesFileExist FilePath
configPath
  if Bool
configExists
    then do
      Maybe Settings
mSettings <- (?mutex::Mutexes) =>
FilePath -> FilePath -> FilePath -> IO (Maybe Settings)
FilePath -> FilePath -> FilePath -> IO (Maybe Settings)
readSettings FilePath
dir FilePath
tgvar FilePath
configPath
      case Maybe Settings
mSettings of
        Maybe Settings
Nothing -> (?mutex::Mutexes) => FilePath -> MVar () -> FilePath -> IO Settings
FilePath -> MVar () -> FilePath -> IO Settings
tryReadConfig FilePath
dir MVar ()
configChange FilePath
tgvar
        Just Settings
cfg -> Settings -> IO Settings
forall (m :: * -> *) a. Monad m => a -> m a
return Settings
cfg
    else (?mutex::Mutexes) => FilePath -> MVar () -> FilePath -> IO Settings
FilePath -> MVar () -> FilePath -> IO Settings
tryReadConfig FilePath
dir MVar ()
configChange FilePath
tgvar

modifiedCfg :: MVar () -> Event -> IO ()
modifiedCfg :: MVar () -> Event -> IO ()
modifiedCfg MVar ()
mvar Event
_ = MVar () -> () -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar ()
mvar ()

readConfigTillSuccess :: (?mutex :: Mutexes)
                      => WatchManager -> FilePath -> String -> MVar () -> IO Settings
readConfigTillSuccess :: WatchManager -> FilePath -> FilePath -> MVar () -> IO Settings
readConfigTillSuccess WatchManager
cfgManager FilePath
dir FilePath
tgvar MVar ()
configChange = do
  IO ()
removeWatch <- WatchManager
-> FilePath -> ActionPredicate -> (Event -> IO ()) -> IO (IO ())
watchDir WatchManager
cfgManager FilePath
dir (Bool -> ActionPredicate
forall a b. a -> b -> a
const Bool
True)
    (MVar () -> Event -> IO ()
modifiedCfg MVar ()
configChange)
  Settings
cfg <- (?mutex::Mutexes) => FilePath -> MVar () -> FilePath -> IO Settings
FilePath -> MVar () -> FilePath -> IO Settings
readConfig FilePath
dir MVar ()
configChange FilePath
tgvar
  FilePath -> IO ()
forall (m :: * -> *).
(?mutex::Mutexes, MonadIO m) =>
FilePath -> m ()
logMessage (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Successfully read configuration at " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
dir
  IO ()
removeWatch
  Settings -> IO Settings
forall (m :: * -> *) a. Monad m => a -> m a
return Settings
cfg

notHidden :: FilePath -> Bool
notHidden :: FilePath -> Bool
notHidden (Char
'.':FilePath
_) = Bool
False
notHidden FilePath
_ = Bool
True

isCheck :: FilePath -> Bool
isCheck :: FilePath -> Bool
isCheck FilePath
f = FilePath -> Bool
notHidden FilePath
f Bool -> Bool -> Bool
&& Bool -> Bool
not (FilePath -> Bool
representsConfigName FilePath
f) -- && takeExtension f == ".sql"

readInitialData :: FilePath -> IO [FilePath]
readInitialData :: FilePath -> IO [FilePath]
readInitialData FilePath
dir = do
  [FilePath]
contents <- FilePath -> IO [FilePath]
listDirectory FilePath
dir
  [FilePath]
files <- (FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM FilePath -> IO Bool
doesFileExist ([FilePath] -> IO [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> IO [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
dir FilePath -> FilePath -> FilePath
</>) ([FilePath] -> [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter FilePath -> Bool
isCheck ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath]
contents
  [FilePath]
subdirs <- (FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM FilePath -> IO Bool
doesDirectoryExist ([FilePath] -> IO [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> IO [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
dir FilePath -> FilePath -> FilePath
</>) ([FilePath] -> [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter FilePath -> Bool
notHidden ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath]
contents
  [FilePath]
relativePaths <- case [FilePath]
subdirs of
    [] -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath]
files
    [FilePath]
lst -> (FilePath -> IO [FilePath]) -> [FilePath] -> IO [[FilePath]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (FilePath -> IO [FilePath]
readInitialData) [FilePath]
lst
       IO [[FilePath]] -> ([[FilePath]] -> IO [FilePath]) -> IO [FilePath]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[[FilePath]]
nested -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath]
files [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[FilePath]]
nested)
  FilePath
currentDir <- IO FilePath
getCurrentDirectory
  [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
currentDir FilePath -> FilePath -> FilePath
</>) [FilePath]
relativePaths

readMonitor :: (?mutex :: Mutexes) => FilePath -> String -> IO (Settings, [FilePath])
readMonitor :: FilePath -> FilePath -> IO (Settings, [FilePath])
readMonitor FilePath
dir FilePath
tgvar = do
  MVar ()
configReadMVar <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
  Settings
cfg <- (WatchManager -> IO Settings) -> IO Settings
forall a. (WatchManager -> IO a) -> IO a
withManager (\WatchManager
cfgManager -> (?mutex::Mutexes) =>
WatchManager -> FilePath -> FilePath -> MVar () -> IO Settings
WatchManager -> FilePath -> FilePath -> MVar () -> IO Settings
readConfigTillSuccess WatchManager
cfgManager FilePath
dir FilePath
tgvar MVar ()
configReadMVar)
  [FilePath]
checks <- FilePath -> IO [FilePath]
readInitialData FilePath
dir
  (Settings, [FilePath]) -> IO (Settings, [FilePath])
forall (m :: * -> *) a. Monad m => a -> m a
return (Settings
cfg, [FilePath]
checks)