diff --git a/AGI.cabal b/AGI.cabal --- a/AGI.cabal +++ b/AGI.cabal @@ -7,15 +7,15 @@ can be used to write external programs that interact with Asterisk. It is typically used for creating Interactive Voice Response (IVR) systems. -Version: 1.2.2 +Version: 1.3 License: BSD3 License-File: LICENSE Author: Jeremy Shaw -Maintainer: Jeremy Shaw -Homepage: http://www.n-heptane.com/nhlab/repos/haskell-agi +Maintainer: SeeReason Partners +Homepage: http://src.seereason.com/haskell-agi Extra-Source-Files: debian/changelog debian/compat debian/control debian/copyright - debian/haskell-agi-doc.postinst debian/haskell-agi-doc.postrm debian/rules + debian/rules examples/guessinggame/GuessingGame.hs examples/guessinggame/sounds/guessing-game-correct.gsm examples/guessinggame/sounds/guessing-game-intro.gsm @@ -24,16 +24,16 @@ examples/guessinggame/sounds/guessing-game-lower.gsm tests/Main.hs build-type: Simple -cabal-version: >= 1.2 +cabal-version: >= 1.6 flag small_base description: Choose the new smaller, split-up base package. library - build-depends: parsec, mtl + build-depends: parsec, mtl, syb if flag(small_base) - build-depends: base >= 3, random, unix, network + build-depends: base >= 3 && <5, random, unix, network else build-depends: base < 3, network @@ -42,3 +42,7 @@ -- For more complex build options see: -- http://www.haskell.org/ghc/docs/latest/html/Cabal/ + +source-repository head + type: darcs + location: http://src.seereason.com/haskell-agi diff --git a/Network/AGI.hs b/Network/AGI.hs --- a/Network/AGI.hs +++ b/Network/AGI.hs @@ -1,5 +1,5 @@ {-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable #-} -module Network.AGI +module Network.AGI ( Digit(..) , ppDigit , ppEscapeDigits @@ -42,9 +42,11 @@ , agiOutH :: Handle } -newtype AGI a = AGI { runAGI :: ReaderT AGIEnv IO a } - deriving (Monad, MonadIO, Functor, MonadError IOError, MonadReader AGIEnv) +newtype AGIT m a = AGI { runAGIT :: ReaderT AGIEnv m a } + deriving (Monad, MonadIO, Functor, {- MonadError IOError, -} MonadReader AGIEnv) +type AGI = AGIT IO + -- |DTMF digits data Digit = Pound @@ -105,9 +107,9 @@ -- Example: -- -- @ main = run yourAGI Ignore @ -run :: AGI a -> Handler -> IO a +run :: (MonadIO m) => AGIT m a -> Handler -> m a run agi hupHandler = - do installHandler sigHUP hupHandler Nothing + do liftIO $ installHandler sigHUP hupHandler Nothing runInternal agi stdin stdout -- |Top-level for long running AGI scripts. @@ -121,6 +123,7 @@ -- some concurrency control for shared data. -- -- TODO: support a hang-up handler +-- TODO: ability to listen on a specific IP address fastAGI :: Maybe PortID -> (HostName -> PortNumber -> AGI a) -> IO () fastAGI portId agi = do installHandler sigPIPE Ignore Nothing @@ -137,12 +140,12 @@ -- FastAGI support. -- -- TODO: support general method of handling extra arguments (query_string vs command-line arguments) -runInternal :: AGI a -> Handle -> Handle -> IO a +runInternal :: (MonadIO m) => AGIT m a -> Handle -> Handle -> m a runInternal agi inh outh = - do vars <- readAgiVars inh - hSetBuffering inh LineBuffering - hSetBuffering outh LineBuffering - runReaderT (runAGI agi) (AGIEnv vars inh outh) + do vars <- liftIO $ readAgiVars inh + liftIO $ hSetBuffering inh LineBuffering + liftIO $ hSetBuffering outh LineBuffering + runReaderT (runAGIT agi) (AGIEnv vars inh outh) readAgiVars :: Handle -> IO [(String, String)] readAgiVars inh = @@ -164,7 +167,7 @@ -- |send an AGI Command, and return the Response -- -- this function provides the low-level send/receive functionality. -sendRecv :: Command -> AGI String +sendRecv :: (MonadIO m) => Command -> AGIT m String sendRecv cmd = do inh <- liftM agiInH $ ask outh <- liftM agiOutH $ ask @@ -181,11 +184,10 @@ success: 200 result=0 -} -- |'answer' channel if not already in answer state -answer :: AGI Bool -- ^ True on success, False on failure +answer :: (MonadIO m) => AGIT m Bool -- ^ True on success, False on failure answer = do res <- sendRecv "ANSWER" - parseResult (pResult >> pSuccessFailure) res - + return $ parseResult (pResult >> pSuccessFailure) res {- Usage: HANGUP [] @@ -198,11 +200,12 @@ success: 200 result=1 -} -- |hangUp the specified channel -hangUp :: Maybe String -- ^ channel to hangup, or current channel if not specified - -> AGI Bool +hangUp :: (MonadIO m) + => Maybe String -- ^ channel to hangup, or current channel if not specified + -> AGIT m Bool hangUp mChannel = do res <- sendRecv ("HANGUP" ++ (maybe "" (' ' :) mChannel)) - parseResult (pResult >> ((char '1' >> return True) <|> (string "-1" >> return False))) res + return $ parseResult (pResult >> ((char '1' >> return True) <|> (string "-1" >> return False))) res {- Usage: GET DATA [timeout] [max digits] @@ -220,10 +223,11 @@ -- |play a file and return and digits pressed -- -- See also: 'streamFile' -getData :: FilePath -- ^ file to stream +getData :: (MonadIO m) + => FilePath -- ^ file to stream -> Maybe Integer -- ^ timout in ms after keypress (default: 2000 ms) -> Maybe Integer -- ^ max - -> AGI (Maybe ([Digit], Bool)) -- ^ Nothing on failure, Just (digits, timeout) on success + -> AGIT m (Maybe ([Digit], Bool)) -- ^ Nothing on failure, Just (digits, timeout) on success getData fp mTimeout mMaxDigits = let cmd = "GET DATA " ++ fp ++ @@ -235,7 +239,7 @@ in do res <- sendRecv cmd - parseResult p res + return $ parseResult p res where p = do pResult (try pFail >> return Nothing) <|> (pDigitsWithTimeout >>= return . Just) @@ -266,21 +270,22 @@ deriving (Eq, Show, Data, Typeable) -- |record channel to a file -record :: FilePath -- ^ record to this file +record :: (MonadIO m) + => FilePath -- ^ record to this file -> SoundType -- ^ |GSM \| WAV| -> [Digit] -- ^ stop recording if one of these digits is entered -> Maybe Integer -- ^ maximum record time in milliseconds, -1 for no timeout -> Maybe Integer -- ^ offset samples -> Bool -- ^ beep to indicate recording has begun -> Maybe Integer -- ^ stop recording if this many seconds of silence passes - -> AGI (RecordResult, Integer) -- ^ exit condition, endpos=offset + -> AGIT m (RecordResult, Integer) -- ^ exit condition, endpos=offset record fp soundType escapeDigits length offset beep silence = do res <- sendRecv $ ("RECORD FILE " ++ fp ++ " " ++ show soundType ++ " " ++ ppEscapeDigits escapeDigits ++ " " ++ (maybe "-1" show length) ++ (maybe "" (\o -> ' ': show o) offset) ++ (if beep then " beep" else "") ++ (maybe "" (\s -> " s=" ++ show s) silence)) - parseResult p res + return $ parseResult p res p = pResult >> (pFailureToWrite <|> pFailureOnWaitFor <|> pHangUp <|> pInterrupted <|> pTimeout <|> pRandomError) where @@ -292,7 +297,7 @@ ep <- pEndPos return (FailureOnWaitFor, ep) pHangUp = - do try (string "0 (hangup)") + do try (string "0 (hangup)" <|> string "-1 (hangup)") pSpace ep <- pEndPos return (HangUp, ep) @@ -335,12 +340,13 @@ -} -- |say the given digit string -sayDigits :: [Digit] -- ^ digits to say +sayDigits :: (MonadIO m) + => [Digit] -- ^ digits to say -> [Digit] -- ^ digits which can stop playback - -> AGI (Maybe (Maybe Digit)) -- ^ Nothing on error, Just Nothing on success. Just (Just ) if interrupted. + -> AGIT m (Maybe (Maybe Digit)) -- ^ Nothing on error, Just Nothing on success. Just (Just ) if interrupted. sayDigits digits escapeDigits = do res <- sendRecv $ "SAY DIGITS " ++ map ppDigit digits ++ " " ++ ppEscapeDigits escapeDigits - parseResult p res + return $ parseResult p res where p = do pResult (string "-1" >> return Nothing) <|> (string "0" >> return (Just Nothing)) <|> (pAsciiDigit >>= return . Just . Just) @@ -364,12 +370,13 @@ is the ascii code for the digit pressed. -} -- | 'sayNumber' says the specified number -sayNumber :: Integer -- ^ number to say +sayNumber :: (MonadIO m) + => Integer -- ^ number to say -> [Digit] -- ^ return early if any of these digits are received - -> AGI (Maybe (Maybe Digit)) -- ^ Nothing on failure, Just Nothing on success, Just (Just ) if key is pressed + -> AGIT m (Maybe (Maybe Digit)) -- ^ Nothing on failure, Just Nothing on success, Just (Just ) if key is pressed sayNumber number escapeDigits = do res <- sendRecv ("SAY NUMBER " ++ show number ++ " " ++ ppEscapeDigits escapeDigits) - parseResult p res + return $ parseResult p res where p = do pResult (string "-1" >> return Nothing) <|> (string "0" >> return (Just Nothing)) <|> (pAsciiDigit >>= return . Just . Just) @@ -402,13 +409,14 @@ -- |playback the specified file, can be interupted by the given digits. -- -- See also: 'getData' -streamFile :: FilePath -- ^ file to stream +streamFile :: (MonadIO m) + => FilePath -- ^ file to stream -> [Digit] -- ^ escape digits -> Maybe Integer -- ^ sample offset - -> AGI (Either Integer (Maybe Digit, Integer)) -- ^ On failure: Left . On success: Right (Maybe Digit, ) + -> AGIT m (Either Integer (Maybe Digit, Integer)) -- ^ On failure: Left . On success: Right (Maybe Digit, ) streamFile filePath escapeDigits mSampleOffset = do res <- sendRecv $ "STREAM FILE " ++ filePath ++ " " ++ ppEscapeDigits escapeDigits ++ (maybe "" (\so -> ' ' : show so) mSampleOffset) - parseResult p res + return $ parseResult p res where p = do pResult @@ -450,11 +458,12 @@ -- |wait for channel to receive a DTMF digit. -- -- See also: 'getData' for multiple digits -waitForDigit :: Integer -- ^ timeout in milliseconds, -1 to block indefinitely - -> AGI (Maybe (Maybe Digit)) -- ^ |Nothing| on error, |Just Nothing| on timeout, |Just (Just )| on success +waitForDigit :: (MonadIO m) + => Integer -- ^ timeout in milliseconds, -1 to block indefinitely + -> AGIT m (Maybe (Maybe Digit)) -- ^ |Nothing| on error, |Just Nothing| on timeout, |Just (Just )| on success waitForDigit timeout = do res <- sendRecv $ "WAIT FOR DIGIT " ++ show timeout - parseResult p res + return $ parseResult p res where p = do pResult (string "-1" >> return Nothing) <|> (string "0" >> return (Just Nothing)) <|> (pAsciiDigit >>= return . Just . Just) @@ -463,8 +472,8 @@ -- * Result Parsers parseResult p res = case parse p res res of - (Left e) -> throwError (userError (show e)) - (Right r) -> return $ r + (Left e) -> error (show e) -- throwError (userError (show e)) + (Right r) -> r -- |parse 0 as True, -1 as failure pSuccessFailure :: CharParser () Bool diff --git a/debian/changelog b/debian/changelog --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,21 @@ +haskell-agi (1.2.4) unstable; urgency=low + + * Make AGI a monad transformer + + -- Jeremy Shaw Sat, 05 Dec 2009 20:24:56 -0600 + +haskell-agi (1.2.3) unstable; urgency=low + + * Debianization generated by cabal-debian + + -- Jeremy Shaw Fri, 04 Dec 2009 22:56:19 -0600 + +haskell-agi (1.2.2.1) unstable; urgency=low + + * haskell-agi-doc -> libghc6-agi-doc due to haddock 2.x + + -- Jeremy Shaw Sun, 21 Sep 2008 17:10:26 -0700 + haskell-agi (1.2.2) unstable; urgency=low * Fix bug in getData when specifying maxDigits or timeout diff --git a/debian/compat b/debian/compat --- a/debian/compat +++ b/debian/compat @@ -1,1 +1,1 @@ -5 +7 diff --git a/debian/control b/debian/control --- a/debian/control +++ b/debian/control @@ -1,67 +1,73 @@ Source: haskell-agi Priority: optional Section: misc -Maintainer: Jeremy Shaw -Build-Depends: debhelper (>= 5.0), - haskell-devscripts-cdbs, - cabal-debian, +Maintainer: Jeremy Shaw +Build-Depends: debhelper (>= 7.0), + haskell-devscripts (>= 0.6.15+nmu7), + hscolour, + cdbs, ghc6 (>= 6.8), - ghc6-doc, - haddock (>= 2.1.0), ghc6-prof, - libghc6-parsec-prof, - libghc6-parsec-doc, libghc6-mtl-prof, - libghc6-mtl-doc, - libghc6-network-prof, - libghc6-network-doc -Standards-Version: 3.7.2.2 + libghc6-network-prof, + libghc6-parsec2-prof +Build-Depends-Indep: ghc6-doc, + haddock, + libghc6-mtl-doc, + libghc6-network-doc, + libghc6-parsec2-doc +Standards-Version: 3.8.1 Homepage: http://www.n-heptane.com/nhlab/repos/haskell-agi Package: libghc6-agi-dev Architecture: any -Section: libdevel -Depends: ${haskell:Depends} +Section: haskell +Depends: ${haskell:Depends}, + ${misc:Depends} Description: A library for writing AGI scripts for Asterisk - Asterisk is an open-source Voice over IP server (VoIP). - Asterisk provides an 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. - . + Asterisk is an open-source Voice over IP server (VoIP). + Asterisk provides an 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. + . Author: Jeremy Shaw Upstream-Maintainer: Jeremy Shaw - . - This package contains the normal library files. + . + This package contains the normal library files. Package: libghc6-agi-prof Architecture: any -Section: libdevel -Depends: ${haskell:Depends} +Section: haskell +Depends: ${haskell:Depends}, + ${misc:Depends}, + libghc6-agi-dev Description: A library for writing AGI scripts for Asterisk - Asterisk is an open-source Voice over IP server (VoIP). - Asterisk provides an 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. - . + Asterisk is an open-source Voice over IP server (VoIP). + Asterisk provides an 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. + . Author: Jeremy Shaw Upstream-Maintainer: Jeremy Shaw - . - This package contains the libraries compiled with profiling enabled. + . + This package contains the libraries compiled with profiling enabled. Package: haskell-agi-doc Architecture: all -Section: libdevel -Depends: ${haskell:Depends} +Section: doc +Depends: ${haskell:Depends}, + ${misc:Depends}, + ghc6-doc Description: A library for writing AGI scripts for Asterisk - Asterisk is an open-source Voice over IP server (VoIP). - Asterisk provides an 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. - . + Asterisk is an open-source Voice over IP server (VoIP). + Asterisk provides an 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. + . Author: Jeremy Shaw Upstream-Maintainer: Jeremy Shaw - . - This package contains the documentation files. + . + This package contains the documentation files. diff --git a/debian/haskell-agi-doc.postinst b/debian/haskell-agi-doc.postinst deleted file mode 100644 --- a/debian/haskell-agi-doc.postinst +++ /dev/null @@ -1,39 +0,0 @@ -#! /bin/sh -# Generic doc postinst script for Haskell cabal libraries v9 by Ian Lynagh. -# -set -e - -# summary of how this script can be called: -# * `configure' -# * `abort-upgrade' -# * `abort-remove' `in-favour' -# -# * `abort-deconfigure' `in-favour' -# `removing' -# -# for details, see /usr/doc/packaging-manual/ -# -# quoting from the policy: -# Any necessary prompting should almost always be confined to the -# post-installation script, and should be protected with a conditional -# so that unnecessary prompting doesn't happen if a package's -# installation fails and the `postinst' is called with `abort-upgrade', -# `abort-remove' or `abort-deconfigure'. - -case "$1" in - configure|abort-upgrade|abort-remove|abort-deconfigure) - cd /usr/share/doc/ghc6-doc/libraries - /usr/lib/ghc6-doc/gen_contents_index - ;; - *) - echo "postinst called with unknown argument \`$1'" >&2 - exit 0 - ;; -esac - -# dh_installdeb will replace this with shell code automatically -# generated by other debhelper scripts. - -#DEBHELPER# - -exit 0 diff --git a/debian/haskell-agi-doc.postrm b/debian/haskell-agi-doc.postrm deleted file mode 100644 --- a/debian/haskell-agi-doc.postrm +++ /dev/null @@ -1,21 +0,0 @@ -#! /bin/sh -# Generic doc postrm script for Haskell cabal libraries v9 by Ian Lynagh. - -set -e - -DIR=/usr/share/doc/ghc6-doc/libraries -GEN=/usr/lib/ghc6-doc/gen_contents_index - -case "$1" in - *) - [ -d $DIR ] && [ -e $GEN ] && cd $DIR && $GEN - ;; -esac - -# dh_installdeb will replace this with shell code automatically -# generated by other debhelper scripts. - -#DEBHELPER# - -exit 0 - diff --git a/debian/rules b/debian/rules --- a/debian/rules +++ b/debian/rules @@ -1,2 +1,7 @@ #!/usr/bin/make -f -include /usr/share/haskell-devscripts/hlibrary.mk +include /usr/share/cdbs/1/rules/debhelper.mk +include /usr/share/cdbs/1/class/hlibrary.mk + +# How to install an extra file into the documentation package +#binary-fixup/libghc6-AGI-doc:: +# echo "Some informative text" > debian/libghc6-AGI-doc/usr/share/doc/libghc6-AGI-doc/AnExtraDocFile diff --git a/examples/guessinggame/GuessingGame.hs b/examples/guessinggame/GuessingGame.hs --- a/examples/guessinggame/GuessingGame.hs +++ b/examples/guessinggame/GuessingGame.hs @@ -2,6 +2,7 @@ -- Standard Haskell Modules +import Control.Concurrent import Control.Monad.Trans import Data.Maybe import Data.Word @@ -15,12 +16,12 @@ main :: IO () main = - run mainAGI Ignore + run mainAGI (undefined) -- Ignore mainAGI :: AGI () mainAGI = do answer - liftIO $ sleep 1 + liftIO $ (threadDelay (1 * 10^6)) playGame hangUp Nothing return ()