module Twitch.InternalRule where
import Filesystem.Path
import Data.Time.Clock
import System.FSNotify ( Event (..)
, WatchConfig
, watchDir
, startManagerConf
, WatchManager
, defaultConfig
)
import Data.Default
import Control.Monad
import Data.Monoid
import qualified Data.Text as T
import Data.Text (Text)
import Prelude hiding (FilePath)
import Twitch.Rule (Rule, RuleIssue)
import qualified Twitch.Rule as Rule
type Action = FilePath -> UTCTime -> IO ()
type FileTest = FilePath -> UTCTime -> Bool
data InternalRule = InternalRule
{ name :: Text
, 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 {..}
= T.unpack $ "Rule { name = "
<> name
<> " }"
toInternalRule :: FilePath -> Rule -> Either RuleIssue InternalRule
toInternalRule currentDir rule = do
test <- Rule.compilePattern currentDir $ Rule.pattern 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
filePath :: Event -> FilePath
filePath = \case
Added x _ -> x
Modified x _ -> x
Removed x _ -> x
time :: Event -> UTCTime
time = \case
Added _ x -> x
Modified _ x -> x
Removed _ x -> x
fireRule :: Event -> InternalRule -> IO ()
fireRule event rule = case event of
Added file time -> modify rule file time
Modified file time -> add rule file time
Removed file time -> delete rule file time
testAndFireRule :: Config -> Event -> InternalRule -> IO ()
testAndFireRule Config {..} event rule = do
let shouldFire = fileTest rule (filePath event) (time event)
when shouldFire $ do
logger $ IRuleFired event rule
fireRule event rule
setupRuleForDir :: Config -> WatchManager -> [InternalRule] -> FilePath -> IO ()
setupRuleForDir config@(Config {..}) man rules dirPath = do
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