packages feed

Yogurt-Standalone (empty) → 0.4

raw patch · 6 files changed

+292/−0 lines, 6 filesdep +Yogurtdep +basedep +containerssetup-changed

Dependencies added: Yogurt, base, containers, hint, mtl, network, old-locale, process, regex-posix, syb, time

Files

+ Examples/Minimal.hs view
@@ -0,0 +1,9 @@+module Minimal where++import Network.Yogurt++newmoon :: Session+newmoon = session+  { hostName   = "eclipse.cs.pdx.edu"+  , portNumber = 7680+  }
+ Examples/NewMoon.hs view
@@ -0,0 +1,71 @@+module NewMoon where++import Network.Yogurt+import System.Cmd+import Data.Char++newmoon :: Session+newmoon = session+  { hostName   = "eclipse.cs.pdx.edu"+  , portNumber = 7680+  , mudProgram = \reload -> do+      -- The reload argument allows reloading this Haskell file during a session.+      -- Let's make a command for it so we can call it while playing.+      mkCommand "reload" reload+      installHooks      +  }++installHooks :: Mud ()+installHooks = do+  -- Logs are stored in a timestamped file in the local directory.+  startLogging "NewMoon"++  -- Log in automatically.+  mkTriggerOnce "^Enter your name:" $ do+    sendln "username"+    sendln "password"++  -- Sound system bell whenever you receive a tell.+  mkTrigger "^[^ ]+ tells you: " bell++  -- Send a carriage return every 5 minutes to keep the connection alive.+  -- Most MUDs don't like this...+  mkTimer (5 * 60 * 1000) (sendln "")++  -- Enable calling system commands during a session.+  mkCommand "system" $ do+    group 1 >>= liftIO . system+    return ()++  -- | Split commands in two on semicolons.+  mkPrioHook 100 Remote ";" $ do+    before >>= matchMoreOn  . (++ "\n")+    after  >>= matchMoreOn'++  -- Enable speedwalks, e.g. "5w" expands to "w;w;w;w;w"+  mkHook Remote "^[0-9]+[neswud]$" $ do+    (n, dir) <- fmap (span isDigit) (group 0)+    sequence $ replicate (read n) (sendln dir)+  +  -- A very simple alias: make "fb" expand to "cast fireball"+  mkAlias "fb" "cast fireball"+  +  -- Create a command to teleport to a specific place.+  mkCommand "tp" $ do+    -- Find out where to go.+    dest <- group 1+    if all isSpace dest+      then do+        echoln "Teleport to where?"+      else do+        sendln "cast teleport"+  +        -- Wait for the spell to get ready...+        mkTriggerOnce "^You feel ready to teleport now" $ do+          sendln ("teleport to" ++ dest)+        return ()+  +  -- Show all currently install hooks whenever "hooks" is entered.+  mkCommand "hooks" (allHooks >>= echo . unlines . map show)++  return ()
+ LICENSE view
@@ -0,0 +1,24 @@+Copyright (c) 2008, Martijn van Steenbergen+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:+    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.+    * Redistributions in binary form must reproduce the above copyright+      notice, this list of conditions and the following disclaimer in the+      documentation and/or other materials provided with the distribution.+    * Neither the name of the author nor the+      names of his contributors may be used to endorse or promote products+      derived from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY+EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL <copyright holder> BE LIABLE FOR ANY+DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND+ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,3 @@+import Distribution.Simple++main = defaultMain
+ Yogurt-Standalone.cabal view
@@ -0,0 +1,34 @@+Name:           Yogurt-Standalone+Version:        0.4+Synopsis:       A functional MUD client+Description:   	Yogurt is a functional MUD client featuring prioritized, regex-based hooks, variables, timers, logging, dynamic loading of Yogurt scripts and more. For example programs, please see Yogurt's home page.+                .+                This is the standalone executable built on top of the Yogurt library. Invoke @yogurt@ on a Haskell file that defines one or more sessions to have it load that module and connect to the specified MUD. See module @Network.Yogurt.Session@ in package Yogurt for more details.+++Author:         Martijn van Steenbergen+Maintainer:     martijn@van.steenbergen.nl+Stability:      Experimental+Copyright:      Some Rights Reserved (CC) 2008-2009 Martijn van Steenbergen+Homepage:       http://code.google.com/p/yogurt-mud/+++Cabal-Version:  >= 1.2+License:        BSD3+License-file:   LICENSE+Category:       Network+Build-type:     Simple+Extra-Source-Files: Examples/Minimal.hs, Examples/NewMoon.hs+++Executable yogurt+  Main-Is:            YogurtExec.hs+  GHC-Options:        -threaded+  Build-Depends:      mtl, regex-posix, containers, time, old-locale, Yogurt, network, process, hint+  Extra-Libraries:    readline++  if impl(ghc >= 6.10) {+        Build-Depends:  base >= 4, base < 5, syb+  } else {+        Build-Depends:  base >= 3, base < 4+  }
+ YogurtExec.hs view
@@ -0,0 +1,151 @@+import Network.Yogurt+import Network.Yogurt.Readline++import System.Exit+import System.Environment+import System.Console.GetOpt+import System.IO+import Data.List+import Data.Function+import Data.Version+import Control.Monad+import Control.Monad.Trans+import qualified Paths_Yogurt_Standalone as P++import Language.Haskell.Interpreter++options :: [OptDescr (IO ())]+options =+  [ Option "v" ["version"] (NoArg (printVersion >> exitSuccess)) "print version and exit"+  , Option "h" ["help"]    (NoArg (printHelp    >> exitSuccess)) "print help and exit"+  ]++main :: IO ()+main = do+  (flags, otherArgs, errs) <- getOpt RequireOrder options `liftM` getArgs+  let flatErrs = filter (not . null) $ concatMap (lines . indent) errs++  unless (null flatErrs) $ do+    errLn $ "Illegal arguments:"+    err   $ unlines flatErrs+    errLn $ "Try yogurt --help for help."+    exitFailure++  sequence_ flags+  case otherArgs of+    [moduleName] ->+      loadSession moduleName pickDefaultSession+    [moduleName, sessionName] ->+      loadSession moduleName (pickSession sessionName)+    _ ->+      printUsage >> exitFailure++-- moduleName -> available session names -> session name to load+type PickSession = String -> [String] -> IO String++pickDefaultSession :: PickSession+pickDefaultSession moduleName sessionNames = do+  case sessionNames of+    [] -> do+      errLn $ "Module " ++ moduleName ++ " defines no sessions."+      exitFailure+    [sessionName] -> do+      return sessionName+    _ -> do+      errLn $ "Module " ++ moduleName ++ " defines several sessions: " ++ intercalate ", " sessionNames+      errLn $ "Use \"yogurt " ++ moduleName ++ " <session>\" to pick a specific session."+      exitFailure++pickSession :: String -> PickSession+pickSession sessionName moduleName sessionNames = do+  if sessionName `elem` sessionNames+    then return sessionName+    else do+      errLn $ "Module " ++ moduleName ++ " defines no session called \"" ++ sessionName ++ "\"."+      exitFailure++indent :: String -> String+indent = unlines . map ("  " ++ ) . lines++loadSession :: String -> PickSession -> IO ()+loadSession moduleName pick = do+  errLn $ "Loading module " ++ moduleName ++ "..."+  mSessions <- loadPlugin moduleName+  case mSessions of+    Left e -> do+      errLn (pretty e)+      exitFailure+    Right sessions -> do+      sessionName <- pick moduleName (map fst sessions)+      let Just session = lookup sessionName sessions+      let doReload = reload moduleName sessionName+      connect (hostName session) (portNumber session) (mudProgram session doReload)++printUsage :: IO ()+printUsage = do+  errLn $ "Usage: yogurt <module> [<session>]"+  errLn $ "   or: yogurt --help"++printVersion :: IO ()+printVersion = do+  errLn $ "Yogurt version " ++ showVersion P.version+  errLn $ "Using version " ++ showVersion version ++ " of the Yogurt library"+  errLn $ "Some Rights Reserved (CC) 2008-2009 Martijn van Steenbergen"+  errLn $ "http://martijn.van.steenbergen.nl/projects/yogurt/"++printHelp :: IO ()+printHelp = do+  printVersion+  errLn $ ""+  errLn $ "Usage: yogurt <module> [<session>]"+  errLn $ ""+  err   $ usageInfo "Available options:" options++err :: String -> IO ()+err = hPutStr stderr++errLn :: String -> IO ()+errLn = hPutStrLn stderr++pretty :: InterpreterError -> String+pretty e = case e of+  UnknownError s -> s+  WontCompile ss -> intercalate "\n\n" (map errMsg ss)+  NotAllowed s -> s+  GhcException s -> s++reload :: String -> String -> Mud ()+reload moduleName sessionName = fix $ \loop -> do+  echoln $ "Loading module " ++ moduleName ++ "..."+  mSessions <- lift $ loadPlugin moduleName+  case mSessions of+    Left e -> echoln (pretty e)+    Right sessions -> do+      case lookup sessionName sessions of+        Nothing -> do+          echoln $ "Module " ++ moduleName +++                      " no longer contains a session called \"" ++ sessionName ++ "\"."+        Just session -> do+          mapM_ rmHook =<< allHooks+          mudProgram session loop+          echoln "Done."++-- | Given a module name, yields all sessions and their names defined in that module.+loadPlugin :: String -> IO (Either InterpreterError [(String, Session)])+loadPlugin mn = runInterpreter $ do+  let moduleName = case elemIndices '.' mn of+        []  -> mn+        is  -> take (last is) mn+  loadModules [moduleName]+  loadedModuleNames <- getLoadedModules+  if not (moduleName `elem` loadedModuleNames)+    then do+      fail "The module's name must match the filename."+    else do+      setImports ["Network.Yogurt.Session", moduleName]+      symbols <- map name `liftM` getModuleExports moduleName+      typedSymbols <- mapM (\s -> (,) `liftM` return s `ap` typeOf s) symbols+      let sessionNames = [ n | (n, t) <- typedSymbols, t == "Session" ]+      forM sessionNames $ \sn -> do+        session <- interpret sn (as :: Session)+        return (sn, session)