Updates to build with stack and upstream changes
I figured this would be harder considering I haven't touched it in far too long. Didn't take much work at all to get it built and running again, and all tests (such as they are) pass. + stack didn't like the exe and test exe both using Main.hs + filled out other-modules in .cabal at stack's suggestion + EitherT is now ExceptT + pipes-concurrency deprecated `Unbounded` in favor of `unbounded` + tasty's wrapper of HSpec is now in IO + misc minor hLint changesmaster
parent
f8b361dc5b
commit
a4e724ebff
|
@ -1,3 +1,4 @@
|
|||
cabal.sandbox.config
|
||||
.cabal-sandbox/
|
||||
.stack-work/
|
||||
dist/
|
||||
|
|
|
@ -17,9 +17,18 @@ cabal-version: >=1.10
|
|||
|
||||
executable pipes-irc-server
|
||||
main-is: Main.hs
|
||||
other-modules: Pipes.IRC.Message.Parse
|
||||
other-modules: Pipes.IRC.Message
|
||||
, Pipes.IRC.Message.Parse
|
||||
, Pipes.IRC.Message.Render
|
||||
, Pipes.IRC.Message.Types
|
||||
, Pipes.IRC.Server
|
||||
, Pipes.IRC.Server.Channel
|
||||
, Pipes.IRC.Server.EventHandler
|
||||
, Pipes.IRC.Server.IrcMonad
|
||||
, Pipes.IRC.Server.Log
|
||||
, Pipes.IRC.Server.Server
|
||||
, Pipes.IRC.Server.User
|
||||
, Pipes.IRC.Server.Util
|
||||
, Pipes.IRC.Server.Types
|
||||
, Pipes.IRC.Server.MessageHandler
|
||||
-- other-extensions:
|
||||
|
@ -49,7 +58,17 @@ executable pipes-irc-server
|
|||
|
||||
test-suite tests
|
||||
type: exitcode-stdio-1.0
|
||||
main-is: Main.hs
|
||||
other-modules: Pipes.IRC.Message
|
||||
, Pipes.IRC.Message.Parse
|
||||
, Pipes.IRC.Message.Render
|
||||
, Pipes.IRC.Message.Types
|
||||
, Pipes.IRC.Server.Channel
|
||||
, Pipes.IRC.Server.Server
|
||||
, Pipes.IRC.Server.Types
|
||||
, Pipes.IRC.Server.User
|
||||
, Pipes.IRC.Server.Util
|
||||
, ParseTests
|
||||
main-is: Test.hs
|
||||
build-depends: base
|
||||
, mtl
|
||||
, containers
|
||||
|
|
|
@ -174,7 +174,7 @@ listenHandler srv (lsock, _) =
|
|||
|
||||
(hName, _) <- getNameInfo [] True False caddr
|
||||
|
||||
(writeEnd, readEnd) <- spawn Unbounded
|
||||
(writeEnd, readEnd) <- spawn unbounded
|
||||
curTime <- getCurrentTime
|
||||
|
||||
logLine $ BS.pack $
|
||||
|
|
|
@ -182,17 +182,17 @@ doQuit qmsg = do
|
|||
-- * Command validation utilities
|
||||
|
||||
type ErrParam = (IrcReply, [IrcParam])
|
||||
type IrcMonadErr = EitherT ErrParam IrcMonad
|
||||
type IrcMonadErr = ExceptT ErrParam IrcMonad
|
||||
|
||||
tellErr :: Either (IrcReply, [IrcParam]) a -> IrcMonad ()
|
||||
tellErr (Left (r, ps)) = void $ tellNumeric r ps
|
||||
tellErr _ = return ()
|
||||
|
||||
runValidation :: IrcMonadErr () -> IrcMonad ()
|
||||
runValidation = tellErr <=< runEitherT
|
||||
runValidation = tellErr <=< runExceptT
|
||||
|
||||
ensure :: Bool -> IrcReply -> [IrcParam] -> IrcMonadErr ()
|
||||
ensure p r ps = unless p $ left (r, ps)
|
||||
ensure p r ps = unless p $ throwE (r, ps)
|
||||
|
||||
ensureUse :: IrcMonad (Maybe a) -> ErrParam -> IrcMonadErr a
|
||||
ensureUse u e = lift u >>= hoistEither . note e
|
||||
|
|
|
@ -128,7 +128,7 @@ handleJOIN msg@IrcMessage{..} = runValidation $ do
|
|||
["0"] -> do cs <- useUserChans nn
|
||||
doPart msg{command=Left PART} (S.elems cs) Nothing
|
||||
-- No passwords were supplied
|
||||
cs:[] -> doJoin msg $ zipParams (parseParamList cs) []
|
||||
[cs] -> doJoin msg $ zipParams (parseParamList cs) []
|
||||
-- Some number of passwords were supplied
|
||||
cs:ks:_ -> doJoin msg $ zipParams (parseParamList cs) (parseParamList ks)
|
||||
|
||||
|
@ -136,7 +136,7 @@ handlePART :: IrcMessage -> IrcMonad ()
|
|||
handlePART msg@IrcMessage{..} = runValidation $ do
|
||||
checkParamLength "PART" params 1
|
||||
lift $ case params of
|
||||
cs:[] -> doPart msg (parseParamList cs) Nothing
|
||||
[cs] -> doPart msg (parseParamList cs) Nothing
|
||||
cs:pm:_ -> doPart msg (parseParamList cs) (Just pm)
|
||||
|
||||
doJoin :: IrcMessage -> [(ChanKey, Maybe PassKey)] -> IrcMonad ()
|
||||
|
@ -173,7 +173,7 @@ handlePRIVMSG :: IrcMessage -> IrcMonad ()
|
|||
handlePRIVMSG msg@IrcMessage{..} = do
|
||||
case params of
|
||||
[] -> tellNumeric err_norecipient []
|
||||
_:[] -> tellNumeric err_notexttosend []
|
||||
[_] -> tellNumeric err_notexttosend []
|
||||
rsp:_:_ -> let rs = parseParamList rsp
|
||||
in findReceivers rs >>= fwdMsg msg
|
||||
return ()
|
||||
|
|
|
@ -0,0 +1,35 @@
|
|||
# For more information, see: http://docs.haskellstack.org/en/stable/yaml_configuration.html
|
||||
|
||||
# Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2)
|
||||
resolver: lts-5.0
|
||||
|
||||
# Local packages, usually specified by relative directory name
|
||||
packages:
|
||||
- '.'
|
||||
|
||||
# Packages to be pulled from upstream that are not in the resolver (e.g., acme-missiles-0.3)
|
||||
extra-deps: []
|
||||
|
||||
# Override default flag values for local packages and extra-deps
|
||||
flags: {}
|
||||
|
||||
# Extra package databases containing global packages
|
||||
extra-package-dbs: []
|
||||
|
||||
# Control whether we use the GHC we find on the path
|
||||
# system-ghc: true
|
||||
|
||||
# Require a specific version of stack, using version ranges
|
||||
# require-stack-version: -any # Default
|
||||
# require-stack-version: >= 1.0.0
|
||||
|
||||
# Override the architecture used by stack, especially useful on Windows
|
||||
# arch: i386
|
||||
# arch: x86_64
|
||||
|
||||
# Extra directories used by stack for building
|
||||
# extra-include-dirs: [/path/to/dir]
|
||||
# extra-lib-dirs: [/path/to/dir]
|
||||
|
||||
# Allow a newer minor version of GHC than the snapshot specifies
|
||||
# compiler-check: newer-minor
|
|
@ -2,21 +2,15 @@
|
|||
|
||||
module ParseTests where
|
||||
|
||||
import Test.Tasty
|
||||
import Test.Tasty.Hspec as HS
|
||||
|
||||
import Data.Attoparsec.ByteString.Char8 as P
|
||||
import Data.ByteString.Char8 as C8
|
||||
import Data.List
|
||||
import Data.Ord
|
||||
|
||||
import Pipes.IRC.Message.Parse
|
||||
import Pipes.IRC.Message.Render
|
||||
import Pipes.IRC.Message.Types
|
||||
|
||||
msgParseSpec :: Spec
|
||||
msgParseSpec = do
|
||||
|
||||
msgParseSpec =
|
||||
describe "Parsing" $ do
|
||||
|
||||
describe "parseMsgOrLine" $ do
|
||||
|
|
|
@ -6,11 +6,8 @@ import Test.Tasty
|
|||
import Test.Tasty.Hspec as HS
|
||||
import Test.Tasty.QuickCheck as QC
|
||||
|
||||
import Control.Applicative
|
||||
|
||||
import qualified Data.ByteString.Char8 as C8
|
||||
import Data.List
|
||||
import Data.Monoid
|
||||
|
||||
import ParseTests
|
||||
|
||||
|
@ -20,18 +17,25 @@ import Pipes.IRC.Server.Types
|
|||
import Pipes.IRC.Server.User
|
||||
|
||||
main :: IO ()
|
||||
main = defaultMain tests
|
||||
main = do
|
||||
ts <- tests
|
||||
defaultMain ts
|
||||
|
||||
tests :: TestTree
|
||||
tests = testGroup "Tests" [specs, userProperties, chanProperties]
|
||||
tests :: IO TestTree
|
||||
tests = do
|
||||
sps <- specs
|
||||
return $ testGroup "Tests" [sps, userProperties, chanProperties]
|
||||
|
||||
-- Hspec Tests
|
||||
|
||||
specs :: TestTree
|
||||
specs = testGroup "Specifications"
|
||||
[ HS.testCase "Message Parsing" msgParseSpec
|
||||
-- , HS.testCase "Message Rendering" msgRenderSpec
|
||||
]
|
||||
specs :: IO TestTree
|
||||
specs = do
|
||||
mps <- HS.testSpec "Message Parsing" msgParseSpec
|
||||
-- mrs <- HS.testCase "Message Rendering" msgRenderSpec
|
||||
return $ testGroup "Specifications"
|
||||
[ mps
|
||||
-- , mrs
|
||||
]
|
||||
|
||||
-- QuickCheck and SmallCheck properties
|
||||
{-
|
Loading…
Reference in New Issue