diff --git a/map-syntax.cabal b/map-syntax.cabal --- a/map-syntax.cabal +++ b/map-syntax.cabal @@ -1,5 +1,5 @@ name: map-syntax -version: 0.2 +version: 0.2.0.1 synopsis: Syntax sugar for defining maps description: Haskell's canonical list of tuples syntax for defining maps is not very @@ -9,7 +9,7 @@ license: BSD3 license-file: LICENSE author: Doug Beardsley -maintainer: Doug Beardsley +maintainer: mightybyte@gmail.com build-type: Simple cabal-version: >= 1.10 category: Data Structures @@ -35,12 +35,10 @@ mtl >= 2.0 && < 2.3 if impl(ghc >= 6.12.0) - ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2 + ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -fno-warn-unused-do-bind else - ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2 - - ghc-prof-options: -prof -auto-all + ghc-options: -Wall -fwarn-tabs -funbox-strict-fields source-repository head @@ -55,17 +53,14 @@ , Data.Map.Syntax.Util , Data.Map.Syntax.Tests default-language: Haskell2010 - ghc-options: -fhpc - ghc-options: -Wall -fwarn-tabs -fhpc -O2 - build-depends: + ghc-options: -Wall -fwarn-tabs + build-depends: base >= 4 && < 5, containers >= 0.3 && < 0.6, deepseq >= 1.3 && < 2, HUnit >= 1.2 && < 2, mtl >= 2.0 && < 2.3, QuickCheck >= 2.3.0.2 && < 3, - test-framework >= 0.8.0.3 && < 0.9, - test-framework-hunit >= 0.2.7 && < 0.4, - test-framework-quickcheck2 >= 0.2.12.1 && < 0.4, - transformers >= 0.3 && < 0.5 + hspec >= 2.2.3 && < 2.3, + transformers >= 0.3 && < 0.6 diff --git a/src/Data/Map/Syntax.hs b/src/Data/Map/Syntax.hs --- a/src/Data/Map/Syntax.hs +++ b/src/Data/Map/Syntax.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} @@ -46,10 +47,13 @@ ------------------------------------------------------------------------------ -import Control.Applicative import Control.Monad.State import qualified Data.Map as M + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative import Data.Monoid +#endif ------------------------------------------------------------------------------ diff --git a/test/Data/Map/Syntax/Tests.hs b/test/Data/Map/Syntax/Tests.hs --- a/test/Data/Map/Syntax/Tests.hs +++ b/test/Data/Map/Syntax/Tests.hs @@ -8,9 +8,8 @@ import Data.Function (on) import qualified Data.Map as M import Data.Monoid (mempty, mappend) -import Test.Framework (Test) -import Test.Framework.Providers.HUnit (testCase) -import Test.Framework.Providers.QuickCheck2 (testProperty) +import Test.Hspec +import Test.Hspec.QuickCheck import Test.HUnit (assertEqual) import Data.Map.Syntax @@ -21,24 +20,22 @@ ------------------------------------------------------------------------------ -- |Simple tests for not-nested maps -insTests :: [Test] -insTests = - [testCase "Insert overwrite" overDup - ,testCase "Insert over fail" failDup - ,testCase "Reject duplicate" skipDup - ,testCase "Trying dupFunc" dupFunc - ,testProperty "Insert overwrite from list" prop_syntaxMatchesNubOver - ,testProperty "Insert conditional from list" prop_syntaxMatchesNubCond - ,testProperty "Insert error on dup from list" prop_syntaxMatchesNubErr] +insTests :: Spec +insTests = do + it "Insert overwrite" overDup + it "Insert over fail" failDup + it "Reject duplicate" skipDup + it "Trying dupFunc" dupFunc + prop "Insert overwrite from list" prop_syntaxMatchesNubOver + prop "Insert conditional from list" prop_syntaxMatchesNubCond + prop "Insert error on dup from list" prop_syntaxMatchesNubErr -monoidLaws :: [Test] -monoidLaws = - [testProperty "Left identity" prop_leftId - ,testProperty "Right identity" prop_rightId - ,testProperty "Associativity" prop_assoc - ] +monoidLaws :: Spec +monoidLaws = do + prop "Left identity" prop_leftId + prop "Right identity" prop_rightId + prop "Associativity" prop_assoc - ------------------------------------------------------------------------------ -- |Simple tests of ##, #!, #? overDup :: IO () @@ -81,7 +78,7 @@ prop_syntaxMatchesNubCond :: [(String,Int)] -> Bool prop_syntaxMatchesNubCond pairs = Right nubMap == (runMap mSyntax) - where mSyntax = mapM_ (\(k,v) -> (k #? v)) pairs + where mSyntax = mapM_ (\(k,v) -> (k #? v)) pairs nubMap = M.fromList . L.nubBy ((==) `on` fst) $ pairs prop_syntaxMatchesNubErr :: [(String,Int)] -> Bool @@ -98,17 +95,17 @@ ------------------------------------------------------------------------------ -- |Tests for #! when do blocks are nested -nestingTests :: [Test] -nestingTests = - [testCase "Nested error dups" nestedErr - ,testCase "Nested error dups mapK" nestedErrMapK - ,testCase "Nester error dups mapV" nestedErrMapV - ,testCase "Nested overwrite dups" nestedOver - ,testCase "Nested overwrite dups mapK" nestedOverMapK - ,testCase "Nested overwrite dups mapV" nestedOverMapV - ,testCase "Nested ignore dups mixed" nestedIgnoreMix - ,testCase "Nested complex pass" nestedComplex - ,testCase "Nested complex error" nestedComplexErr] +nestingTests :: Spec +nestingTests = do + it "Nested error dups" nestedErr + it "Nested error dups mapK" nestedErrMapK + it "Nester error dups mapV" nestedErrMapV + it "Nested overwrite dups" nestedOver + it "Nested overwrite dups mapK" nestedOverMapK + it "Nested overwrite dups mapV" nestedOverMapV + it "Nested ignore dups mixed" nestedIgnoreMix + it "Nested complex pass" nestedComplex + it "Nested complex error" nestedComplexErr nestedErr :: IO () @@ -177,11 +174,11 @@ (runMap $ do mapK succ . mapK succ $ mkMapABC (##) mapK succ . mapK succ . mapK succ . mapV pred $ - mkMapAEF (#?) + mkMapAEF (#?) mapK succ ((mapV (const 1000) $ mkMapABC (##)) >> - mkMapAEF (#?)) - mkMapDEF (##) - mapK pred $ mkMapABC (#?) + mkMapAEF (#?)) + mkMapDEF (##) + mapK pred $ mkMapABC (#?) ) nestedComplexErr :: IO () @@ -191,11 +188,11 @@ (runMap $ do mapK succ . mapK succ $ mkMapABC (##) mapK succ . mapK succ . mapK succ . mapV pred $ - mkMapAEF (#?) + mkMapAEF (#?) mapK succ ((mapV (const 1000) $ mkMapABC (##)) >> mkMapAEF (#?)) mapK pred $ mkMapABC (#!) - mkMapDEF (##) + mkMapDEF (##) mapK pred $ mkMapABC (#?) ) @@ -220,3 +217,4 @@ where a = unArbSyntax a' b = unArbSyntax b' c = unArbSyntax c' + diff --git a/test/TestSuite.hs b/test/TestSuite.hs --- a/test/TestSuite.hs +++ b/test/TestSuite.hs @@ -3,17 +3,13 @@ module Main where ------------------------------------------------------------------------------ -import Test.Framework (defaultMain, testGroup, Test) +import Test.Hspec import Data.Map.Syntax.Tests ------------------------------------------------------------------------------ -tests :: [Test] -tests = [testGroup "Simple insertion testing" insTests - ,testGroup "Monoid laws" monoidLaws - ,testGroup "Nested block insertion testing" nestingTests] - - ------------------------------------------------------------------------------- main :: IO () -main = defaultMain tests +main = hspec $ do + describe "simple insertions" insTests + describe "monoid laws" monoidLaws + describe "nested block insertions" nestingTests