module Twitch.Rule where
import Prelude hiding (FilePath)
import Control.Monad ( void )
import Filesystem.Path ( FilePath )
import Filesystem.Path.CurrentOS ( encodeString )
import System.FilePath.Glob ( simplify, match, tryCompileWith, compDefault )
import Data.Monoid ( (<>) )
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
compilePattern :: FilePath
-> PatternText
-> Either RuleIssue (FilePath -> Bool)
compilePattern currentDir pat = left (PatternCompliationFailed pat) $ do
let absolutePattern = encodeString currentDir <> "/" <> pat
p <- tryCompileWith compDefault absolutePattern
let test = match $ simplify p
return $ \x -> test $ encodeString x