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