79fc9f1 · typeable/hjsonschema

git.iko.soy/typeable/hjsonschema

on master help sign in

Break tests into local and remote; fix haddock.

79fc9f1Ian Grant Jeffries12 years ago

hjsonschema.cabal+26−4

compare with master

unifiedsplit

@@ -1,5 +1,5 @@

1name: hjsonschema

2−version: 0.1.0.0

2+version: 0.1.1.0

3synopsis: Haskell implementation of JSON Schema v4.

4homepage: https://github.com/seagreen/hjsonschema

5license: MIT

@@ -8,8 +8,10 @@ author: Ian Grant Jeffries

8maintainer: ian@housejeffries.com

9category: Data

10build-type: Simple

11−extra-source-files: README.md

12cabal-version: >=1.10

11cabal-version: >=1.10

12+extra-source-files: README.md

13+ JSON-Schema-Test-Suite/tests/draft4/*.json

14+ tests/Lib.hs

14library

16library

15 hs-source-dirs: src

17 hs-source-dirs: src

@@ -33,10 +35,30 @@ library

33 , vector >= 0.10 && < 0.11

35 , vector >= 0.10 && < 0.11

34 , wreq >= 0.3 && < 0.4

36 , wreq >= 0.3 && < 0.4

36−test-suite official

38+test-suite local

39+ type: exitcode-stdio-1.0

40+ hs-source-dirs: tests

41+ main-is: Local.hs

42+ default-language: Haskell2010

43+ ghc-options: -Wall

44+ default-extensions: OverloadedStrings

45+ build-depends: aeson

46+ , base

47+ , bytestring

48+ , hjsonschema

49+ , unordered-containers

50+ , text

51+ , vector

52+ , directory >= 1.2 && < 1.3

53+ , filepath >= 1.3 && < 1.4

54+ , HUnit >= 1.2 && < 1.3

55+ , test-framework >= 0.8 && < 0.9

56+ , test-framework-hunit >= 0.3 && < 0.4

57+

58+test-suite remote

37 type: exitcode-stdio-1.0

59 type: exitcode-stdio-1.0

38 hs-source-dirs: tests

60 hs-source-dirs: tests

39− main-is: Test.hs

61+ main-is: Remote.hs

40 default-language: Haskell2010

62 default-language: Haskell2010

41 ghc-options: -Wall

63 ghc-options: -Wall

42 default-extensions: OverloadedStrings

64 default-extensions: OverloadedStrings

src/Data/JsonSchema/JsonReference.hs+2−2

@@ -1,7 +1,7 @@

1−module Data.JsonSchema.JsonReference where

2−

3-- | There should be a JSON Reference library for haskell.

1-- | There should be a JSON Reference library for haskell.

3+module Data.JsonSchema.JsonReference where

5import Control.Exception

6import Control.Lens

7import Control.Monad

tests/Test.hs → tests/Lib.hsrenamed+20−18

@@ -1,6 +1,6 @@

1{-# LANGUAGE TemplateHaskell #-}

3−module Main where

3+module Lib where

5import Control.Applicative

6import Control.Monad

@@ -10,22 +10,15 @@ import qualified Data.ByteString.Lazy as LBS

10import Data.Char (toLower)

11import qualified Data.HashMap.Strict as H

12import Data.JsonSchema

13−import Data.List (isSuffixOf)

14import Data.Monoid

13import Data.Monoid

15import Data.Text (Text)

14import Data.Text (Text)

16import qualified Data.Text as T

15import qualified Data.Text as T

17import qualified Data.Vector as V

16import qualified Data.Vector as V

18−import System.Directory (getDirectoryContents)

19import System.FilePath ((</>))

17import System.FilePath ((</>))

20import Test.Framework

18import Test.Framework

21import Test.Framework.Providers.HUnit

19import Test.Framework.Providers.HUnit

22import qualified Test.HUnit as HU

20import qualified Test.HUnit as HU

24−main :: IO ()

25−main = do

26− ts <- readSchemaTests

27− defaultMain (toTest <$> ts)

28−

29data SchemaTest = SchemaTest

22data SchemaTest = SchemaTest

30 { _stDescription :: Text

23 { _stDescription :: Text

31 , _stSchema :: RawSchema

24 , _stSchema :: RawSchema

@@ -48,22 +41,31 @@ instance FromJSON SchemaTest where

48 <*> o .: "schema"

41 <*> o .: "schema"

49 <*> o .: "tests" -- I wish this were "cases"

42 <*> o .: "tests" -- I wish this were "cases"

44+isLocal :: String -> Bool

45+isLocal file = (file /= "definitions.json")

46+ && (file /= "ref.json")

47+ && (file /= "refRemote.json")

48+

51−readSchemaTests :: IO [SchemaTest]

49+readSchemaTests :: String -> [String] -> IO [SchemaTest]

52−readSchemaTests = do

50+readSchemaTests dir jsonFiles = concatMapM fileToCases jsonFiles

53− jsonFiles <- filter (".json" `isSuffixOf`) <$> getDirectoryContents dir

54− fmap concat $ forM jsonFiles $ \file -> do

55− let fullPath = dir </> file

56− jsonBS <- LBS.readFile fullPath

57− case eitherDecode jsonBS of

58− Left err -> fail $ "couldn't parse file '" <> fullPath <> "': " <> err

59− Right schemas -> return $ prependFileName file <$> schemas

60 where

51 where

61− dir = "JSON-Schema-Test-Suite/tests/draft4"

52+ -- Each file contains an array of SchemaTests, not just one.

53+ fileToCases :: String -> IO [SchemaTest]

54+ fileToCases name = do

55+ let fullPath = dir </> name

56+ jsonBS <- LBS.readFile fullPath

57+ case eitherDecode jsonBS of

58+ Left e -> fail $ "couldn't parse file '" <> fullPath <> "': " <> e

59+ Right schemaTests -> return $ prependFileName name <$> schemaTests

60+

62 prependFileName :: String -> SchemaTest -> SchemaTest

61 prependFileName :: String -> SchemaTest -> SchemaTest

63 prependFileName fileName s = s

62 prependFileName fileName s = s

64 { _stDescription = T.pack fileName <> ": " <> _stDescription s

63 { _stDescription = T.pack fileName <> ": " <> _stDescription s

65 }

64 }

66+ concatMapM :: (Monad m) => (a -> m [b]) -> [a] -> m [b]

67+ concatMapM f xs = liftM concat (mapM f xs)

68+

67toTest :: SchemaTest -> Test

69toTest :: SchemaTest -> Test

68toTest st = testGroup groupName (mkCase <$> _stCases st)

70toTest st = testGroup groupName (mkCase <$> _stCases st)

69 where

71 where

tests/Local.hsnew file+18

@@ -0,0 +1,18 @@

1+module Main where

3+import Control.Applicative

4+import Data.List (isSuffixOf)

5+import Lib

6+import System.Directory (getDirectoryContents)

7+import Test.Framework

9+main :: IO ()

10+main = do

11+ files <- filter isLocal . filter (".json" `isSuffixOf`)

12+ <$> getDirectoryContents dir

13+ ts <- readSchemaTests dir files

14+ defaultMain (toTest <$> ts)

15+

16+ where

17+ dir :: String

18+ dir = "JSON-Schema-Test-Suite/tests/draft4"

tests/Remote.hsnew file+18