records-edsl-0.1.0: tests/spec.hs

{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE UndecidableInstances #-}

import Data.Aeson (FromJSON (..), ToJSON (..))
import Data.Aeson qualified as JSON
import Data.OpenApi qualified as O
import Data.Text (Text)
import Data.Time
import Data.Time.Clock
import Data.Time.Clock.POSIX
import Optics
import Records.EDSL
import Relude
import Test.Hspec
import Witch

declareSchemaRecords
  (deriveJSON <> deriveToSchema <> deriveHasFields <> deriveEq <> deriveShow <> deriveGeneric <> deriveLabelOptics)
  """
  record Person {
    name :: Text,
    nickname :: Maybe Text,
    age :: Int,
    dob :: Maybe UTCTime via Maybe LenientTimestamp,
  }

  record Config --field-prefix=cfg {
    host :: Text,
    port :: Int,
  }

  record Point --no-field-prefix {
    x :: Int,
    y :: Int,
  }
  """

--------------------------------------------------------------------------------
-- Example type for a field: timestamps which accept either POSIX time or
-- UTC time strings in their FromJSON instance

newtype LenientTimestamp = LenientTimestamp POSIXTime
  deriving stock (Show, Generic, Eq, Ord)
  deriving newtype (NFData, Fractional, RealFrac, Real, Num)

instance O.ToSchema LenientTimestamp where
  declareNamedSchema _ = do
    utctime <- O.declareSchemaRef (Proxy :: Proxy UTCTime)
    posixtime <- O.declareSchemaRef (Proxy :: Proxy POSIXTime)
    pure . O.NamedSchema (Just "LenientTimestamp") $ mempty & #oneOf ?~ [utctime, posixtime]

instance FromJSON LenientTimestamp where
  parseJSON (JSON.Number n) = (into :: POSIXTime -> LenientTimestamp) <$> parseJSON (JSON.Number n)
  parseJSON (JSON.String n) = (into :: UTCTime -> LenientTimestamp) <$> parseJSON (JSON.String n)
  parseJSON _ = fail "POSIXTime must be valid time in seconds or ISO8601 string"

instance ToJSON LenientTimestamp where toJSON (LenientTimestamp p) = JSON.Number (fromInteger (round p :: Integer))
instance From POSIXTime LenientTimestamp where from = coerce
instance From LenientTimestamp POSIXTime where from = coerce
instance From UTCTime LenientTimestamp where from = LenientTimestamp . utcTimeToPOSIXSeconds
instance From LenientTimestamp UTCTime where from (LenientTimestamp t) = posixSecondsToUTCTime t

--------------------------------------------------------------------------------

person =
  Person
    { personName = "Personn"
    , personNickname = Nothing
    , personAge = 10
    , personDob = Just (into personDobPosixTime)
    }

personDobPosixTime =
  into @POSIXTime
    (UTCTime (YearMonthDay 2026 5 11) (timeOfDayToTime (TimeOfDay 5 50 0)))

cfg = Config {cfgHost = "hello", cfgPort = 8080}
point = Point {x = 0, y = 54}

main :: IO ()
main = hspec do
  describe "JSON" do
    it "ToJSON" do
      JSON.toJSON person
        `shouldBe` JSON.Object
          [ ("name", JSON.toJSON person.name)
          , ("age", JSON.toJSON person.age)
          , ("dob", JSON.toJSON (LenientTimestamp personDobPosixTime))
          ]
    it "ToJSON/null field set" do
      JSON.toJSON (person & #nickname ?~ "Person")
        `shouldBe` JSON.Object
          [ ("name", JSON.toJSON person.name)
          , ("nickname", JSON.String "Person")
          , ("age", JSON.toJSON person.age)
          , ("dob", JSON.toJSON (LenientTimestamp personDobPosixTime))
          ]
    it "ToJSON/null via field unset" do
      JSON.toJSON (person & #dob .~ Nothing)
        `shouldBe` JSON.Object
          [ ("name", JSON.toJSON person.name)
          , ("age", JSON.toJSON person.age)
          ]
    it "roundtrips" do
      JSON.decode (JSON.encode person) `shouldBe` Just person

  it "getField" do
    person.name `shouldBe` personName person
    person.nickname `shouldBe` personNickname person
    person.age `shouldBe` personAge person
    person.dob `shouldBe` personDob person