module Twitch.InternalRule where
import System.FilePath ( FilePath )
import Data.Time.Clock ( UTCTime )
import System.FSNotify
( Event(..)
, WatchConfig
, WatchManager
, defaultConfig
, eventPath
, eventTime
, startManagerConf
, watchDir
)
import Data.Default ( Default(..) )
import Control.Monad ( when, void, forM_ )
import Data.Monoid
import Twitch.Rule ( Rule, RuleIssue )
import Prelude hiding (FilePath)
import qualified Twitch.Rule as Rule
type Action = FilePath -> UTCTime -> IO ()
type FileTest = FilePath -> UTCTime -> Bool
data InternalRule = InternalRule
{ name :: String
, fileTest :: FileTest
, modify :: Action
, add :: Action
, delete :: Action
}
instance Default InternalRule where
def = InternalRule
{ name = mempty
, fileTest = \_ _ -> False
, modify = def
, add = def
, delete = def
}
instance Show InternalRule where
show InternalRule {..}
= "Rule { name = "
<> name
<> " }"
toInternalRule :: FilePath -> Rule -> Either RuleIssue InternalRule
toInternalRule currentDir rule = do
test <- Rule.compilePattern $ Rule.pattern $ Rule.makeAbsolute currentDir rule
return InternalRule
{ name = Rule.name rule
, fileTest = \x _ -> test x
, add = \x _ -> Rule.add rule x
, modify = \x _ -> Rule.modify rule x
, delete = \x _ -> Rule.delete rule x
}
data Config = Config
{ logger :: Issue -> IO ()
, dirs :: [FilePath]
, watchConfig :: WatchConfig
}
instance Show Config where
show Config {..}
= "Config { dirsToWatch = "
++ show dirs
++ "}"
instance Default Config where
def = Config
{ logger = def
, dirs = def
, watchConfig = defaultConfig
}
data Issue
= IEvent Event
| IRuleFired Event InternalRule
deriving Show
fireRule :: Event -> InternalRule -> IO ()
fireRule event rule = case event of
Added file tyme -> modify rule file tyme
Modified file tyme -> add rule file tyme
Removed file tyme -> delete rule file tyme
testAndFireRule :: Config -> Event -> InternalRule -> IO ()
testAndFireRule Config {..} event rule = do
let shouldFire = fileTest rule (eventPath event) (eventTime event)
when shouldFire $ do
logger $ IRuleFired event rule
fireRule event rule
setupRuleForDir :: Config -> WatchManager -> [InternalRule] -> FilePath -> IO ()
setupRuleForDir config@(Config {..}) man rules dirPath =
void $ watchDir man dirPath (const True) $ \event -> do
logger $ IEvent event
forM_ rules $ testAndFireRule config event
setupRules :: Config -> [InternalRule] -> IO WatchManager
setupRules config@(Config {..}) rules = do
man <- startManagerConf watchConfig
forM_ dirs $ setupRuleForDir config man rules
return man