{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}
module Twitch.Internal where
import System.FilePath ( FilePath )
import Control.Monad.Trans.State as State
( State, put, modify, execState, get )
import qualified Twitch.Rule as Rule
( addF, modifyF, deleteF, nameF )
import Twitch.Rule ( Rule )
import Data.String ( IsString(..) )
import Control.Applicative
import Data.Monoid
import Data.Semigroup as S
import Prelude hiding (FilePath)
newtype DepM a = DepM { unDepM :: State [Rule] a}
deriving ( Functor
, Applicative
, Monad
)
instance S.Semigroup (DepM a) where
x <> y = x >> y
instance Monoid a => Monoid (DepM a) where
mempty = return mempty
mappend = (<>)
type Dep = DepM ()
instance IsString Dep where
fromString = addRule . fromString
runDep :: Dep -> [Rule]
runDep = runDepWithState mempty
runDepWithState :: [Rule] -> Dep -> [Rule]
runDepWithState xs = flip execState xs . unDepM
addRule :: Rule -> Dep
addRule r = DepM $ State.modify (r :)
modHeadRule :: Dep -> (Rule -> Rule) -> Dep
modHeadRule (DepM dep) f = DepM $ do
dep
get >>= \res -> case res of
x:xs -> put $ f x : xs
r -> put r
infixl 8 |+, |%, |-, |>, |#
(|+), (|%), (|-), (|>) :: Dep -> (FilePath -> IO a) -> Dep
x |+ f = modHeadRule x $ Rule.addF f
x |% f = modHeadRule x $ Rule.modifyF f
x |- f = modHeadRule x $ Rule.deleteF f
x |> f = x |+ f |% f
(|#) :: Dep -> String -> Dep
r |# p = modHeadRule r $ Rule.nameF p
add, modify, delete, addModify :: (FilePath -> IO a) -> Dep -> Dep
add = flip (|+)
modify = flip (|%)
delete = flip (|-)
addModify = flip (|>)
name :: String -> Dep -> Dep
name = flip (|#)