hjcase (empty) → 0.1.0.0

raw patch · 5 files changed

+126/−0 lines, 5 filesdep +HUnitdep +aesondep +basesetup-changed

Dependencies added: HUnit, aeson, base, bytestring, test-framework, test-framework-hunit, text, unordered-containers, vector

Files

• MIT-LICENSE.txt +20/−0
• README.md +3/−0
• Setup.hs +2/−0
• hjcase.cabal +33/−0
• src/Data/Jcase.hs +68/−0

@@ -0,0 +1,20 @@+The MIT License (MIT)+Copyright (c) 2015 Ian Grant Jeffries++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,+DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR+OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE+OR OTHER DEALINGS IN THE SOFTWARE.

@@ -0,0 +1,3 @@+# Summary++[Jcase](https://github.com/seagreen/Jcase) library for Haskell.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,33 @@+name:                   hjcase+version:                0.1.0.0+synopsis:               Jcase library for Haskell+homepage:               https://github.com/seagreen/hjcase+license:                MIT+license-file:           MIT-LICENSE.txt+author:                 Ian Grant Jeffries+maintainer:             ian@housejeffries.com+category:               Data+build-type:             Simple+cabal-version:          >=1.10+extra-source-files:     README.md++library+  hs-source-dirs:       src+  exposed-modules:      Data.Jcase+  default-language:     Haskell2010+  default-extensions:   OverloadedStrings+  other-extensions:     TemplateHaskell+  ghc-options:          -Wall+  build-depends:        aeson                >= 0.8  && < 0.9+                      , base                 >= 4.7  && < 4.8+                      , bytestring           >= 0.10 && < 0.11+                      , HUnit                >= 1.2  && < 1.3+                      , test-framework       >= 0.8  && < 0.9+                      , test-framework-hunit >= 0.3  && < 0.4+                      , text                 >= 1.2  && < 1.3+                      , unordered-containers >= 0.2  && < 0.3+                      , vector               >= 0.10 && < 0.11++source-repository head+  type:               git+  location:           git://github.com/seagreen/hjcase.git

@@ -0,0 +1,68 @@+{-# LANGUAGE TemplateHaskell #-}++module Data.Jcase where++import           Control.Monad+import           Data.Aeson+import           Data.Aeson.TH+import qualified Data.ByteString.Lazy           as B+import           Data.Char                      (toLower)+import           Data.Foldable+import           Data.Maybe+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+  { _jcDescription :: Maybe Text+  , _jcData        :: Maybe Value+  , _jcAssertions  :: Vector JcaseAssertion+  } deriving (Eq, Show)++data JcaseAssertion = JcaseAssertion+  { _description :: Maybe Text+  , _input       :: Value+  , _output      :: Value+  } 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)+  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)++stdinJcase :: (Maybe Value -> Value -> Value) -> IO ()+stdinJcase 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"+  where+    g :: Maybe Value -> JcaseAssertion -> IO ()+    g maybeData ja = do+      let actual = f maybeData (_input ja)+      unless (actual == _output ja) $ error (msg ja actual)++    msg :: JcaseAssertion -> Value -> String+    msg ja v =+      let desc = T.unpack $ fromMaybe "" (_description ja)+      in unlines $ (if null desc then [] else [desc]) <>+        [ "expected: " <> show (_output ja)+        , "but got: "  <> show v+        ]++$(deriveFromJSON defaultOptions { fieldLabelModifier = map toLower . drop 3 } ''Jcase)+$(deriveFromJSON defaultOptions { fieldLabelModifier = drop 1 } ''JcaseAssertion)