Revision a4f35477 test/hs/Test/Ganeti/JSON.hs

b/test/hs/Test/Ganeti/JSON.hs
28 28 

  		





  29
  29
  
    
module Test.Ganeti.JSON (testJSON) where


  		





  30
  30
  
    

  		





  
  31
  
    
import Data.List


  		





  31
  32
  
    
import Test.QuickCheck


  		





  32
  33
  
    

  		





  33
  34
  
    
import qualified Text.JSON as J


  		





  ......




  53
  54
  
    
    BasicTypes.Bad _ -> passTest


  		





  54
  55
  
    
    BasicTypes.Ok result -> failTest $ "Unexpected parse, got " ++ show result


  		





  55
  56
  
    

  		





  
  57
  
    
arrayMaybeToJson :: (J.JSON a) => [Maybe a] -> String -> JSON.JSRecord


  		





  
  58
  
    
arrayMaybeToJson xs k = [(k, J.JSArray $ map sh xs)]


  		





  
  59
  
    
  where


  		





  
  60
  
    
    sh x = case x of


  		





  
  61
  
    
      Just v -> J.showJSON v


  		





  
  62
  
    
      Nothing -> J.JSNull


  		





  
  63
  
    

  		





  
  64
  
    
prop_arrayMaybeFromObj :: String -> [Maybe Int] -> String -> Property


  		





  
  65
  
    
prop_arrayMaybeFromObj t xs k =


  		





  
  66
  
    
  case JSON.tryArrayMaybeFromObj t (arrayMaybeToJson xs k) k of


  		





  
  67
  
    
    BasicTypes.Ok xs' -> xs' ==? xs


  		





  
  68
  
    
    BasicTypes.Bad e -> failTest $ "Parsing failing, got: " ++ show e


  		





  
  69
  
    

  		





  
  70
  
    
prop_arrayMaybeFromObjFail :: String -> String -> Property


  		





  
  71
  
    
prop_arrayMaybeFromObjFail t k =


  		





  
  72
  
    
  case JSON.tryArrayMaybeFromObj t [] k of


  		





  
  73
  
    
    BasicTypes.Ok r -> fail $


  		





  
  74
  
    
                       "Unexpected result, got: " ++ show (r::[Maybe Int])


  		





  
  75
  
    
    BasicTypes.Bad e -> conjoin [ Data.List.isInfixOf t e ==? True


  		





  
  76
  
    
                                , Data.List.isInfixOf k e ==? True


  		





  
  77
  
    
                                ]


  		





  
  78
  
    

  		





  56
  79
  
    
testSuite "JSON"


  		





  57
  80
  
    
          [ 'prop_toArray


  		





  58
  81
  
    
          , 'prop_toArrayFail


  		





  
  82
  
    
          , 'prop_arrayMaybeFromObj


  		





  
  83
  
    
          , 'prop_arrayMaybeFromObjFail


  		





  59
  84
  
    
          ]


  		












Also available in:
  Unified diff