THSpec.hs

{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module Warlock.THSpec (spec) where

import Test.Hspec
import qualified Witch as W
import Warlock

-- Structural mapping by position
data Foo = FirstCase Int | SecondCase Bool
  deriving (Show, Eq)

data IntOrBool = LeftInt Int | RightBool Bool
  deriving (Show, Eq)

deriveAutomap ByPosition ''Foo ''IntOrBool
deriveAutomap ByPosition ''IntOrBool ''Foo

data Result = Success String | Failure Int
  deriving (Show, Eq)

data HttpResult = OkResponse String | ErrorResponse Int
  deriving (Show, Eq)

deriveAutomapBoth ByPosition ''Result ''HttpResult

data OptionalString = NoneStr | SomeStr String
  deriving (Show, Eq)

data MaybeString = NothingStr | JustStr String
  deriving (Show, Eq)

deriveAutomapBoth ByPosition ''OptionalString ''MaybeString

spec :: Spec
spec = do
  describe "Witch.TH structural mapping" $ do
    it "maps constructors by position, not name" $ do
      let foo1 = FirstCase 42
      let intOrBool1 = from foo1 :: IntOrBool
      intOrBool1 `shouldBe` LeftInt 42

      let foo2 = SecondCase True
      let intOrBool2 = from foo2 :: IntOrBool
      intOrBool2 `shouldBe` RightBool True

    it "works bidirectionally" $ do
      let orig = LeftInt 99
      let foo = from orig :: Foo
      let back = from foo :: IntOrBool
      back `shouldBe` orig

    it "maps by position for different constructor names" $ do
      let result = Success "all good"
      let http = from result :: HttpResult
      http `shouldBe` OkResponse "all good"

      let err = Failure 404
      let httpErr = from err :: HttpResult
      httpErr `shouldBe` ErrorResponse 404

    it "handles zero-argument constructors" $ do
      let none = NoneStr
      let maybe = from none :: MaybeString
      maybe `shouldBe` NothingStr

      let some = SomeStr "value"
      let maybeVal = from some :: MaybeString
      maybeVal `shouldBe` JustStr "value"