ConstructorTransformSpec.hs

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

import Test.Hspec
import qualified Witch as W
import Warlock

-- Enum versioning with suffix
data StatusV1
  = Pending
  | InProgress
  | Completed
  | Failed
  deriving (Show, Eq)

data StatusV2
  = PendingV2
  | InProgressV2
  | CompletedV2
  | FailedV2
  deriving (Show, Eq)

deriveAutomap
  ( ByName $ defaultConfig `withConstructorMap` addSuffix "V2" )
  ''StatusV1
  ''StatusV2

deriveAutomap
  ( ByName $ defaultConfig `withConstructorMap` stripSuffix "V2" )
  ''StatusV2
  ''StatusV1

-- Prefix transformation
data Color
  = Red
  | Green
  | Blue
  deriving (Show, Eq)

data ColorCode
  = CodeRed
  | CodeGreen
  | CodeBlue
  deriving (Show, Eq)

deriveAutomap
  ( ByName $ defaultConfig `withConstructorMap` Transform ("Code" ++) )
  ''Color
  ''ColorCode

deriveAutomap
  ( ByName $ defaultConfig `withConstructorMap` Transform (drop 4) )
  ''ColorCode
  ''Color

spec :: Spec
spec = do
  describe "Constructor name transformation" $ do
    it "appends version suffix to constructor names" $ do
      W.from Pending `shouldBe` (PendingV2 :: StatusV2)
      W.from InProgress `shouldBe` (InProgressV2 :: StatusV2)
      W.from Completed `shouldBe` (CompletedV2 :: StatusV2)
      W.from Failed `shouldBe` (FailedV2 :: StatusV2)

    it "strips version suffix from constructor names" $ do
      W.from PendingV2 `shouldBe` (Pending :: StatusV1)
      W.from InProgressV2 `shouldBe` (InProgress :: StatusV1)
      W.from CompletedV2 `shouldBe` (Completed :: StatusV1)

    it "prepends prefix to constructor names" $ do
      W.from Red `shouldBe` (CodeRed :: ColorCode)
      W.from Green `shouldBe` (CodeGreen :: ColorCode)
      W.from Blue `shouldBe` (CodeBlue :: ColorCode)

    it "strips prefix from constructor names" $ do
      W.from CodeRed `shouldBe` (Red :: Color)
      W.from CodeGreen `shouldBe` (Green :: Color)
      W.from CodeBlue `shouldBe` (Blue :: Color)

    it "works bidirectionally" $ do
      let orig = InProgress
      let v2 = W.from orig :: StatusV2
      let back = W.from v2 :: StatusV1
      back `shouldBe` orig