module Network.Yogurt.Utils (
module Network.Yogurt.Mud,
mkTrigger, mkTriggerOnce,
mkAlias, mkArgAlias, mkCommand,
mkTimerOnce,
receive, sendln, echo, echoln, echorln, bell,
Logger, startLogging, stopLogging,
matchMore, matchMoreOn, matchMoreOn',
system
) where
import Network.Yogurt.Mud
import qualified System.Cmd as Cmd
import System.IO.Unsafe
import Data.Time.Format (formatTime)
import System.Locale (defaultTimeLocale)
import Data.Time.LocalTime (getZonedTime)
mkTrigger :: Pattern -> Mud a -> Mud Hook
mkTrigger pat act = mkHook Local pat (matchedLine >>= echo >> act)
mkTriggerOnce :: Pattern -> Mud a -> Mud Hook
mkTriggerOnce pat act = mdo
hook <- mkTrigger pat (act >> rmHook hook)
return hook
mkAlias :: String -> String -> Mud Hook
mkAlias pat subst = mkHook Remote ("^" ++ pat ++ "($| .*$)") $ do
suffix <- group 1
echorln (subst ++ suffix)
mkArgAlias :: String -> ([String] -> String) -> Mud Hook
mkArgAlias pat f = mkHook Remote ("^" ++ pat ++ "($| .*$)") $ do
args <- fmap words (group 1)
echorln (f args)
mkCommand :: String -> Mud a -> Mud Hook
mkCommand pat = mkHook Remote ("^" ++ pat ++ "($| .*$)")
mkTimerOnce :: Interval -> Mud a -> Mud Timer
mkTimerOnce interval act = mdo
t <- mkTimer interval (act >> rmTimer t)
return t
receive :: String -> Mud ()
receive = trigger Local
sendln :: String -> Mud ()
sendln m = trigger Remote (m ++ "\n")
echo :: String -> Mud ()
echo = io Local
echoln :: String -> Mud ()
echoln m = echo (m ++ "\n")
echorln :: String -> Mud ()
echorln m = io Remote (m ++ "\n")
bell :: Mud ()
bell = echo "\BEL"
type Logger = (Hook, Hook)
startLogging :: String -> Mud Logger
startLogging name = do
let suffix = unsafePerformIO $
fmap (formatTime defaultTimeLocale "-%Y%m%d-%H%M.log") getZonedTime
let filename = name ++ suffix
let record dest = mkPrioHook 100 dest "^" $ do
line <- matchedLine
runIO (appendFile filename line)
matchMore
r <- record Remote
l <- record Local
return (r, l)
stopLogging :: Logger -> Mud ()
stopLogging (r, l) = do
rmHook r
rmHook l
matchMore :: Mud ()
matchMore = matchedLine >>= matchMoreOn
matchMoreOn :: String -> Mud ()
matchMoreOn message = do
h <- triggeredHook
triggerJust (> h) (hDestination h) message
matchMoreOn' :: String -> Mud ()
matchMoreOn' message = do
h <- triggeredHook
triggerJust (>= h) (hDestination h) message
system :: String -> Mud ()
system = runIO . Cmd.system