AGI (empty) → 1.0

raw patch · 16 files changed

+417/−0 lines, 16 filesdep +basedep +mtldep +parsecbuild-type:Customsetup-changedbinary-added

Dependencies added: base, mtl, parsec

Files

• AGI.cabal +30/−0
• Network/AGI.hs +130/−0
• Setup.hs +5/−0
• debian/changelog +6/−0
• debian/compat +1/−0
• debian/control +45/−0
• debian/copyright +31/−0
• debian/haskell-agi-doc.docs +1/−0
• debian/rules +86/−0
• examples/guessinggame/GuessingGame.hs +69/−0
• examples/guessinggame/sounds/guessing-game-correct.gsm binary
• examples/guessinggame/sounds/guessing-game-higher.gsm binary
• examples/guessinggame/sounds/guessing-game-intro.gsm binary
• examples/guessinggame/sounds/guessing-game-lower.gsm binary
• examples/guessinggame/sounds/guessing-game-yay.gsm +4/−0
• tests/Main.hs +9/−0

@@ -0,0 +1,30 @@+Name:           AGI+Category:	Network+Synopsis:       A library for writing AGI scripts for Asterisk+Description: Asterisk is an open-source Voice over IP server+ (VoIP). Asterisk provides a Asterisk Gateway Interface (AGI), which+ can be used to write external programs that interact with+ Asterisk. It is typically used for creating Interactive Voice+ Response (IVR) systems. +Version:        1.0+License:        BSD3+License-File:	debian/copyright+Author:         Jeremy Shaw+Maintainer:	Jeremy Shaw <jeremy@n-heptane.com>+Homepage:       http://www.n-heptane.com/nhlab/repos/haskell-agi+Build-Depends:  base, parsec, mtl+Exposed-modules:+	Network.AGI +Extra-Source-Files:+	debian/changelog  debian/compat  debian/control  debian/copyright  + 	debian/haskell-agi-doc.docs  debian/rules+	examples/guessinggame/GuessingGame.hs+	examples/guessinggame/sounds/guessing-game-correct.gsm+	examples/guessinggame/sounds/guessing-game-intro.gsm+	examples/guessinggame/sounds/guessing-game-yay.gsm+	examples/guessinggame/sounds/guessing-game-higher.gsm+	examples/guessinggame/sounds/guessing-game-lower.gsm+	tests/Main.hs++-- For more complex build options see:+-- http://www.haskell.org/ghc/docs/latest/html/Cabal/

@@ -0,0 +1,130 @@+{-# OPTIONS_GHC -fglasgow-exts #-}+module Network.AGI where++import Control.Monad+import Control.Monad.Trans+import Control.Monad.Reader+import Data.Maybe+import Data.Word+import Text.ParserCombinators.Parsec+import System.IO+import System.Posix.Signals++newtype AGI a = AGI { runAGI :: ReaderT [(String, String)] IO a }+    deriving (Monad, MonadIO, Functor)++type EscapeDigits = String+type Command = String+data Timeout =  Timeout Word (Maybe Word) -- ^ timeout, max digits+type ReturnCode = Word++data SoundType = Wav | GSM ++instance Show SoundType where+    show Wav = "wav"+    show GSM  = "gsm"++-- TODO: let user install a custom sipHUP handler (sigHUP is sent when the caller hangs ups)+run :: AGI a -> IO a+run agi =+    do installHandler sigHUP Ignore Nothing+       hSetBuffering stdin LineBuffering+       hSetBuffering stdout LineBuffering+       agiVars <- readAgiVars+       runReaderT (runAGI agi) agiVars++readAgiVars :: IO [(String, String)]+readAgiVars = +    do mAgiVar <- readAgiVar +       case mAgiVar of+	    Nothing -> +		return []+	    Just agiVar ->+		do rest <- readAgiVars+		   return (agiVar:rest)+    where readAgiVar :: IO (Maybe (String, String))+	  readAgiVar =+	      do l <- getLine+		 case l of+		      "" -> return Nothing+		      _ -> let (a,v) = break ((==) ':') l in+				       return (Just (a, dropWhile ((==) ' ') (tail v)))++sendRecv :: Command -> AGI (ReturnCode, String)+sendRecv cmd =+    liftIO $ do putStrLn cmd+                l <- getLine+                let (c,r) = break ((==) ' ') l+	        return (read c, tail r)++parseResult :: CharParser () (Int, Bool)+parseResult =+    do string "result="+       digits <- many1 $ oneOf ('-':['0'..'9'])+       skipMany (char ' ')+       timeout <- parseTimeout+       return (read digits, timeout)++parseTimeout :: CharParser () Bool+parseTimeout =+    do string "(timeout)"+       return True+    <|>+    do return False++answer :: AGI Bool+answer =+    do (code, res) <- sendRecv "ANSWER"+       case res of+            "result=0" -> +		return $ True+	    _ -> +		return $ False++hangUp :: Maybe String -> AGI (ReturnCode, String)+hangUp mChannel =+    sendRecv ("HANGUP" ++ (fromMaybe "" mChannel))++-- TODO: does digit include # and * ?+getData :: FilePath -> Maybe Timeout -> AGI (ReturnCode, (Int, Bool))+getData fp mTimeout =+    let cmd = +	    "GET DATA " ++ fp +++                        case mTimeout of+			  Nothing -> ""+			  Just (Timeout timeout mMaxDigits) ->+			      " " ++ show timeout +++				  case mMaxDigits of+				    Nothing -> ""+				    Just maxDigits -> " " ++ show maxDigits+    in+      do (code, res) <- sendRecv cmd+         case parse parseResult res res of+	   Left e -> +	       return $ (code, ((-1), False))+	   Right (digits,timeout) -> +	       return $ (code, (digits, timeout))++record :: FilePath -> SoundType -> EscapeDigits -> Word -> Bool -> AGI (ReturnCode, String)+record fp st escapeDigits length beep =+    sendRecv $ "RECORD FILE " ++ fp ++ " " ++ show st ++ " " ++ show escapeDigits ++ " " ++ show length ++ (if beep then " beep" else "")+                +-- TODO: does digit include # and * ?+sayNumber :: Int -> EscapeDigits -> AGI (ReturnCode, String)+sayNumber num escapeDigits =+    sendRecv $ "SAY NUMBER " ++ (show num) ++ " " ++ show escapeDigits++-- TODO: what if the users enters DTMF+stream :: FilePath -> EscapeDigits -> AGI (ReturnCode, String)+stream fp ed = 	+    sendRecv $ "STREAM FILE " ++ fp ++ " " ++ show ed++-- TODO: does digit include # and * ?+-- TODO: positive timeouts only+waitForDigit :: Integer -> AGI (Maybe Int)+waitForDigit timeout =+    do (code, res) <- sendRecv $ "WAIT FOR DIGIT " ++ show timeout+       case parse parseResult res res of+         Left e -> return Nothing -- error ?+         Right (ascii, _) -> return (Just (ascii - 48))+                      

@@ -0,0 +1,5 @@+#!/usr/bin/runhaskell++import Distribution.Simple++main = defaultMainWithHooks defaultUserHooks

@@ -0,0 +1,6 @@+haskell-agi (1.0) unstable; urgency=low++  * Initial Debian package.++ -- Jeremy Shaw <jeremy@n-heptane.com>  Sat, 12 May 2007 19:54:42 -0700+

@@ -0,0 +1,1 @@+4

@@ -0,0 +1,45 @@+Source: haskell-agi+Priority: optional+Section: devel+Maintainer: Jeremy Shaw <jeremy@n-heptane.com>+Build-Depends: debhelper (>= 4.0.0), haskell-devscripts (>=0.5.12), ghc6 (>=6.4), ghc6-prof+Build-Depends-Indep: haddock, hugs (>= 98.200503.08)+Standards-Version: 3.7.2.0++Package: libghc6-agi-dev+Section: libdevel+Architecture: any+Depends: ${haskell:Depends}+Description: A Haskell AGI library+ A library for creating applications that can be called from Asterisk+ using the Asterisk Gateway Interface (AGI).+ .+ This package contains the libraries compiled for GHC 6.++Package: libghc6-agi-prof+Section: libdevel+Architecture: any+Depends: ${haskell:Depends}+Description: A Haskell AGI library+ A library for creating applications that can be called from Asterisk+ using the Asterisk Gateway Interface (AGI).+ .+ This package contains the libraries compiled for GHC 6 with profiling+ enabled.++Package: libhugs-agi+Section: libdevel+Architecture: all+Depends: ${haskell:Depends}+Description: A Haskell AGI library+ A library for creating applications that can be called from Asterisk+ using the Asterisk Gateway Interface (AGI).+ .+ This package contains the libraries compiled for Hugs.++Package: haskell-agi-doc+Section: doc+Architecture: all+Description: Documentation for a Haskell AGI library+ A library for creating applications that can be called from Asterisk+ using the Asterisk Gateway Interface (AGI).

@@ -0,0 +1,31 @@+Copyright (c) 2007, Jeremy Shaw++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.++    * The names of contributors may not be used to endorse or promote+      products derived from this software without specific prior+      written permission. ++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"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 THE COPYRIGHT+OWNER OR CONTRIBUTORS 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.

@@ -0,0 +1,1 @@+dist/doc/html

@@ -0,0 +1,86 @@+#!/usr/bin/make -f++# Uncomment this to turn on verbose mode.+#export DH_VERBOSE=1++build: build-stamp+build-stamp:+	dh_testdir++	# Add here commands to compile the package.+	touch build-stamp++clean:+	dh_testdir+	dh_testroot+	rm -f build-stamp++	# Add here commands to clean up after the build process.+	if [ -x setup ] && [ -e .setup-config ] ; then ./setup clean ; fi+	rm -rf setup Setup.hi Setup.ho Setup.o .*config* dist html+	#make clean++	dh_clean ++install: build+	dh_testdir+	dh_testroot+	dh_clean -k +	dh_installdirs -a ++	# Add here commands to install the package into debian/tmp+	dh_haskell -a++build-indep: build-indep-stamp+build-indep-stamp:+	dh_testdir++install-indep: build-indep+	dh_testdir+	dh_testroot+	dh_clean -k+	dh_installdirs -i++	# Add here commands to install the package into debian/tmp+	dh_haskell -i+	./Setup.hs haddock+	#make doc++# Build architecture-independent files here.+binary-indep: build-indep install-indep+	dh_testdir+	dh_testroot+	dh_installchangelogs -i+	dh_installdocs -i+	dh_installexamples -i+	dh_installman -i+	dh_link -i+	dh_strip -i+	dh_compress -i+	dh_fixperms -i+	dh_installdeb -i+	dh_shlibdeps -i+	dh_gencontrol -i+	dh_md5sums -i+	dh_builddeb -i++# Build architecture-dependent files here.+binary-arch: build install+	dh_testdir+	dh_testroot+	dh_installchangelogs -a+	dh_installdocs -a+	dh_installexamples -a+	dh_installman -a+	dh_link -a+	dh_strip -a+	dh_compress -a+	dh_fixperms -a+	dh_installdeb -a+	dh_shlibdeps -a+	dh_gencontrol -a+	dh_md5sums -a+	dh_builddeb -a++binary: binary-indep binary-arch+.PHONY: build clean binary-indep binary-arch binary install build-indep install-indep

@@ -0,0 +1,69 @@+module Main where++-- Standard Haskell Modules++import Control.Monad.Trans+import Data.Maybe+import Data.Word+import System.IO+import System.Random+import System.Posix.Unistd++-- 3rd Party Modules++import Network.AGI++main :: IO ()+main =+       run mainAGI++mainAGI :: AGI ()+mainAGI =+    do answer+       liftIO $ sleep 1+       playGame+       hangUp Nothing+       return ()++playGame :: AGI ()+playGame =+    do secretDigit <- liftIO $ randomRIO (0, 9)+       stream "guessing-game-intro" []+       guess <- waitForDigit (-1)+       play (compare secretDigit) (fromMaybe 0 guess)+       return ()++play oracle guess =+    loop guess+    where+      loop guess =+          case oracle guess of+            LT -> +                do stream "guessing-game-lower" []+                   sayNumber guess []+                   nextGuess <- waitForDigit (-1)+                   loop (fromMaybe guess nextGuess)+            GT ->+                do stream "guessing-game-higher" []+                   sayNumber guess []+                   nextGuess <- waitForDigit (-1)+                   loop (fromMaybe guess nextGuess)+            EQ ->+                do stream "guessing-game-yay" []+                   sayNumber guess []+                   stream "guessing-game-correct" []++{-++Let's play a game! I am think of a number between 0 and 9. Can you+guess what it is? Enter your guess using the number pad on your phone.++Sorry, the number I am thinking of is higher than++Sorry, the number I am thinking of is less than++Yay! ++is the number I was thinking of! How did you know?++-}

binary file changed (absent → 5511 bytes)

binary file changed (absent → 5709 bytes)

binary file changed (absent → 15939 bytes)

binary file changed (absent → 5148 bytes)

@@ -0,0 +1,4 @@+֞“aÑPA´½:”\%6o6õ–¡øì’9$^ »Ñ²cÛk–Ú€é3æ(ï!¶œ®ºƒZu¥…Âc„ÂI2W{Ò[ü²Éb¿øŠjá«$͢ﭫk*jŸWg$
ñhÛÔÄþM…‰ìžHƒ}Hû™š}(—+3ÔãyÈÆW•8â֑{ÿSµª¾âQ#ò±Šór+ðÜs‹&_)¸ÜqsÎ“×T?d¥ŽÙæH¥i2täm̜›°8—M«kÑs8ݸ8ÝיCÿœ^ïڔÖâ¹+ÖiŽáYtÇ\NJàP¹²OOٞK+\STµÍ§'{ÕÄÓéÆæQ…#¸ºŸŸÖ»©Ô¸Ø còZÕJVq¹h6¯M)雵¥I©du²qjy,Ž×!”vJuÔ£Öáu­t#XªÁSY›:ÁÄÁ•B¥v!ÕÖâ•fç³´:µŠîsl"—›SŒt°Å/笴55×¥$Á²×\űhuRÔ.:S›rÁku9ÌéT3ku9ÒÖÞ¥Yäëò>¤-Êåw‘‰\’·QÑê̊J-Qò)†nÇZÖa”©cy­OMiáMQQ­h‰ùE£±ôªSR+8uKÁÕ£µ*R¥2×g&I9}ƒdé¯U2¦äéµ'©1E½š\Õbµ²S«®šêQó„×1wSVä˜ÙíÅ!YŽ×….
8IYu֝úˇqÈßM¦·[Š–ö›]0íCRç‹Q[œ
ɓֆ7é0%nÈB¶_Ï
Б>taÏ·ôr“óñ0ԝî†ÓÖ_v6ÛepÂVgKÉ17y‰(çg’ô܍֥io[SN9?ÕÝ~»ŸˆÝŽ:¤mqËDÍ8Ýó#vQTr®<ïP;ÔÞ§z#éQaÎ%4ë0%/ØÓ{PÖüiÇ}-wÃy—4Óß·yÚ/¦ãvQ+ðÐ'Lêțƒj™Æ.bbÅPU‘¦çӟ¯²‡,UK³“Í+H”–Ñ%H…Úø{m6ä°ÉÔ\—rbÕ+æ§I¼†Î)áu“a‘.N”©TÝÛm)"tÉ/ÕÛOv›•êA{©ýáKøUFëf™Jt6Ù0å	p7kÀ՛Vºb›-2ìOJ4é'aVÊ&íJéŽó ì¢ìNø…Ôœv¹âðËPm/ñ#¡)¹+ÕLÆ¢«`%n_	­)Ô$wÌÕ[nµZ§		˜v+ÂRëÄ£mßa[jä¬jí‚Té'lͰ՚^ùá[Ç7¡ÊN¦Q%²°	̪ÉXãiж¬æ^ÃÄ¥7ÕZf}Z\ÆnZNqXÇï­'¦¨y[¶”¨†ûcŒ&œÖM½È—G¿œ6·¤†?[.6혥¹á‰+#܅O\q3؝Dz®¥ÊÌÄG©$¬.­%[°ÅØÝp$ëê¦Ù,eFÅÙ`îXÃó§
4Ó¢ÄK´o £î¤¸ïvH#¬å¹-jIØál–&à㊴ک˜Á•TÝ^´Ÿ“'j ƒ™k:(Öœt¦Ý؂ºº¸­®Â×%9ôèÃHÛñϒb¼­mëÝÖ_sê#žÂ;¦}Úuèè¾…øü¢¢¢[­É–Â'MRB

@@ -0,0 +1,9 @@+module Main where++import Test.HUnit++test1 = TestCase (assertEqual "1==1" True (1==1))++tests = TestList [test1]++main = runTestTT tests