{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}
module Twitch.Rule where
import Prelude hiding (FilePath)
import Control.Monad ( void )
import System.FilePath ( FilePath, isRelative, (</>) )
import System.FilePath.Glob ( simplify, match, tryCompileWith, compDefault )
import Data.String ( IsString(..) )
import Data.Default ( Default(..) )
import Control.Arrow ( ArrowChoice(left) )
type Name = String
type PatternText = String
type RuleAction = FilePath -> IO ()
data Rule = Rule
{ name :: String
, pattern :: PatternText
, add :: RuleAction
, modify :: RuleAction
, delete :: RuleAction
}
instance Default Rule where
def = Rule
{ name = ""
, pattern = ""
, add = def
, modify = def
, delete = def
}
instance IsString Rule where
fromString x = def { pattern = x, name = x}
infixl 8 |+, |%, |-, |>, |#
(|+), (|%), (|-), (|>) :: Rule -> (FilePath -> IO a) -> Rule
x |+ f = x { add = void . f }
x |% f = x { modify = void . f }
x |- f = x { delete = void . f }
x |> f = x |+ f |% f
(|#) :: Rule -> String -> Rule
r |# p = r { name = p }
addF, modifyF, deleteF, addModifyF :: (FilePath -> IO a) -> Rule -> Rule
addF = flip (|+)
modifyF = flip (|%)
deleteF = flip (|-)
addModifyF = flip (|>)
nameF :: String -> Rule -> Rule
nameF = flip (|#)
data RuleIssue
= PatternCompliationFailed PatternText String
deriving (Show, Eq)
makeAbsolutePath :: FilePath -> FilePath -> FilePath
makeAbsolutePath currentDir path =
if isRelative path then
currentDir </> path
else
path
makeAbsolute :: FilePath -> Rule -> Rule
makeAbsolute currentDir rule
= rule { pattern = makeAbsolutePath currentDir $ pattern rule }
compilePattern :: PatternText
-> Either RuleIssue (FilePath -> Bool)
compilePattern pat = left (PatternCompliationFailed pat) $ do
tryCompileWith compDefault pat >>= return . match . simplify