EnumTH.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}

module Tests.EnumTH where

import Data.Aeson (decode, encode)
import Data.Char (toLower, toUpper)
import Test.Tasty
import Test.Tasty.HUnit
import Test.Tasty.QuickCheck

import Data.Aeson.Schema.TH (genFromJSONEnum, genToJSONEnum, mkEnum)

mkEnum "State" ["OPEN", "CLOSED"]

data Color = Red | LightBlue | Yellow | DarkGreen | Black | JustABitOffWhite
  deriving (Show, Eq, Enum)

genFromJSONEnum ''Color
genToJSONEnum ''Color

{- Tests -}

test :: TestTree
test = testGroup "Enum TH helpers"
  [ testMkEnum
  , testGenJSONEnum
  ]

testMkEnum :: TestTree
testMkEnum = testGroup "mkEnum"
  [ testProperty "mkEnum decode is case insensitive" $ do
      (val, enumVal) <- elements
        [ ("OPEN", OPEN)
        , ("CLOSED", CLOSED)
        ]
      casedVal <- randomlyCased val
      return $ decode (encode casedVal) === Just enumVal
  , testCase "mkEnum encode keeps case of constructor" $ do
      encode OPEN @?= "\"OPEN\""
      encode CLOSED @?= "\"CLOSED\""
  , testProperty "mkEnum: (fromJust . decode . encode) === id" $ do
      enumVal <- elements [OPEN, CLOSED]
      return $ (decode . encode) enumVal === Just enumVal
  ]

testGenJSONEnum :: TestTree
testGenJSONEnum = testGroup "gen{To,From}JSONEnum"
  [ testProperty "genFromJSONEnum decode is case insensitive" $ do
      (val, enumVal) <- elements
        [ ("Red", Red)
        , ("LightBlue", LightBlue)
        , ("Yellow", Yellow)
        , ("DarkGreen", DarkGreen)
        , ("Black", Black)
        , ("JustABitOffWhite", JustABitOffWhite)
        ]
      casedVal <- randomlyCased val
      return $ decode (encode casedVal) === Just enumVal
  , testCase "genToJSONEnum encode keeps case of constructor" $ do
      encode Red @?= "\"Red\""
      encode LightBlue @?= "\"LightBlue\""
      encode Yellow @?= "\"Yellow\""
      encode DarkGreen @?= "\"DarkGreen\""
      encode Black @?= "\"Black\""
      encode JustABitOffWhite @?= "\"JustABitOffWhite\""
  , testProperty "genFromJSONEnum + genToJSONEnum: (fromJust . decode . encode) === id" $ do
      enumVal <- elements
        [ Red
        , LightBlue
        , Yellow
        , DarkGreen
        , Black
        , JustABitOffWhite
        ]
      return $ (decode . encode) enumVal === Just enumVal
  ]

randomlyCased :: String -> Gen String
randomlyCased s = do
  caseFuncs <- infiniteListOf $ elements [toLower, toUpper]
  return $ zipWith ($) caseFuncs s