hjcase 0.1.0.0 → 0.2.0.0

raw patch · 2 files changed

+64/−34 lines, 2 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• hjcase.cabal +1/−1
• src/Data/Jcase.hs +63/−33

@@ -1,5 +1,5 @@ name:                   hjcase-version:                0.1.0.0+version:                0.2.0.0 synopsis:               Jcase library for Haskell homepage:               https://github.com/seagreen/hjcase license:                MIT

@@ -1,4 +1,5 @@ {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE ScopedTypeVariables #-}  module Data.Jcase where @@ -12,57 +13,86 @@ import           Data.Monoid import           Data.Text                      (Text) import qualified Data.Text                      as T-import qualified Data.Text.IO                   as TIO import           Data.Vector                    (Vector) import           Test.Framework                 (Test) import           Test.Framework.Providers.HUnit (testCase) import qualified Test.HUnit                     as HU -data Jcase = Jcase+data Jsuite a = Jsuite+  { _jsDescription :: Maybe Text+  , _jsCases       :: Vector a+  } deriving (Eq, Show)++data Jcase a b = Jcase   { _jcDescription :: Maybe Text-  , _jcData        :: Maybe Value-  , _jcAssertions  :: Vector JcaseAssertion+  , _jcContext     :: Maybe a+  , _jcAssertions  :: Vector b   } deriving (Eq, Show) -data JcaseAssertion = JcaseAssertion-  { _description :: Maybe Text-  , _input       :: Value-  , _output      :: Value+data Jassertion a b = Jassertion+  { _jaInput  :: a+  , _jaOutput :: b   } deriving (Eq, Show) -jcaseToHUnit :: (Maybe Value -> Value -> Value) -> Jcase -> Test-jcaseToHUnit f jc = do-  let desc = T.unpack $ fromMaybe "" (_jcDescription jc)-  testCase desc (traverse_ g $ _jcAssertions jc)+hUnitJsuite+  :: (FromJSON a, FromJSON b, FromJSON c, Eq a, Eq b, Show a, Show b)+  => (Maybe c -> a -> b)+  -> Jsuite (Jcase c (Jassertion a b))+  -> Test+hUnitJsuite f js = do+  let desc = T.unpack $ fromMaybe "" (_jsDescription js)+  testCase desc (traverse_ g $ _jsCases js)   where-    g :: JcaseAssertion -> HU.Assertion-    g ja = do-      let str = T.unpack $ fromMaybe "" (_description ja)-      HU.assertEqual str-        (_output ja) $-        f (_jcData jc) (_input ja)+    -- g :: Jcase c (Jassertion a b) -> HU.Assertion+    g jc = do+      let str = T.unpack $ fromMaybe "" (_jcDescription jc)+      traverse_+        (\ja -> HU.assertEqual str (_jaOutput ja) $ f (_jcContext jc) (_jaInput ja))+        (_jcAssertions jc) -stdinJcase :: (Maybe Value -> Value -> Value) -> IO ()-stdinJcase f = do+hUnitSimple+  :: (FromJSON a, FromJSON b, Eq a, Eq b, Show a, Show b)+  => (a -> b)+  -> Jsuite (Jcase (Maybe Value) (Jassertion a b))+  -> Test+hUnitSimple f js = hUnitJsuite (const f) js++stdinJsuite+  :: (FromJSON a, FromJSON b, FromJSON c, Eq a, Eq b, Show a, Show b)+  => (Maybe c -> a -> b)+  -> IO ()+stdinJsuite f = do   b <- B.getContents   case eitherDecode b of-    Left e   -> error e-    Right jc -> do-      traverse_ (g $ _jcData jc) (_jcAssertions jc)-      TIO.putStrLn "Success"+    Left e                                            -> error e+    Right (js :: (Jsuite (Jcase c (Jassertion a b)))) -> traverse_ g (_jsCases js) >> putStrLn "Success"   where-    g :: Maybe Value -> JcaseAssertion -> IO ()-    g maybeData ja = do-      let actual = f maybeData (_input ja)-      unless (actual == _output ja) $ error (msg ja actual)+    -- g :: Jcase c (Jassertion a b) -> IO ()+    g jc = traverse_ (k jc) $ _jcAssertions jc -    msg :: JcaseAssertion -> Value -> String-    msg ja v =-      let desc = T.unpack $ fromMaybe "" (_description ja)+    -- k :: Jcase c (Jassertion a b) -> Jassertion a b -> IO ()+    k jc ja = do+      let actual = f (_jcContext jc) (_jaInput ja)+      when (actual /= (_jaOutput ja)) $ error (msg jc ja actual)++    -- msg :: (Show a, Show b) => Jcase c (Jassertion a b) -> Jassertion a b -> a -> String+    msg jc ja v =+      let desc = T.unpack $ fromMaybe "" (_jcDescription jc)       in unlines $ (if null desc then [] else [desc]) <>-        [ "expected: " <> show (_output ja)+        [ "expected: " <> show (_jaOutput ja)         , "but got: "  <> show v         ] +stdinSimple+  :: (FromJSON a, FromJSON b, Eq a, Eq b, Show a, Show b)+  => (a -> b)+  -> IO ()+stdinSimple f = stdinJsuite g+  where+    g c =+      let _ = c :: Maybe Value+      in f++$(deriveFromJSON defaultOptions { fieldLabelModifier = map toLower . drop 3 } ''Jsuite) $(deriveFromJSON defaultOptions { fieldLabelModifier = map toLower . drop 3 } ''Jcase)-$(deriveFromJSON defaultOptions { fieldLabelModifier = drop 1 } ''JcaseAssertion)+$(deriveFromJSON defaultOptions { fieldLabelModifier = map toLower . drop 3 } ''Jassertion)