{- This Source Code Form is subject to the terms of the Mozilla Public License,
   v. 2.0. If a copy of the MPL was not distributed with this file, You can
   obtain one at https://mozilla.org/MPL/2.0/. -}

{-# LANGUAGE OverloadedStrings #-}
module Language.GraphQL.ClassSpec
    ( spec
    ) where

import Data.Text (Text)
import Data.Time (UTCTime(..))
import Data.Time.Calendar.OrdinalDate (fromOrdinalDate)
import qualified Language.GraphQL.Type as Type
import Language.GraphQL.Class (FromGraphQL(..), ToGraphQL(..))
import Test.Hspec (Spec, describe, it, shouldBe)

spec :: Spec
spec = do
    describe "ToGraphQL" $ do
        it "converts integers" $
            toGraphQL (5 :: Int) `shouldBe` Type.Int 5

        it "converts text" $
            toGraphQL ("String" :: Text) `shouldBe` Type.String "String"

        it "converts booleans" $
            toGraphQL True `shouldBe` Type.Boolean True

        it "converts Nothing to Null" $
            toGraphQL (Nothing :: Maybe Int) `shouldBe` Type.Null

        it "converts singleton lists" $
            toGraphQL [True] `shouldBe` Type.List [Type.Boolean True]

        it "converts UTCTime" $
            let given = UTCTime
                    { utctDay = fromOrdinalDate 2023 5
                    , utctDayTime = 90
                    }
                actual = toGraphQL given
                expected = Type.String "2023-01-05T00:01:30Z"
             in actual `shouldBe` expected

    describe "FromGraphQL" $ do
        it "converts integers" $
            fromGraphQL (Type.Int 5) `shouldBe` Just (5 :: Int)

        it "converts text" $
            fromGraphQL (Type.String "String") `shouldBe` Just ("String" :: Text)

        it "converts booleans" $
            fromGraphQL (Type.Boolean True) `shouldBe` Just True

        it "converts Null to Nothing" $
            fromGraphQL Type.Null `shouldBe` Just (Nothing :: Maybe Int)

        it "converts singleton lists" $
            fromGraphQL (Type.List [Type.Boolean True]) `shouldBe` Just [True]

        it "converts UTCTime" $
            let given = Type.String "2023-01-05T00:01:30Z"
                expected = Just $ UTCTime
                    { utctDay = fromOrdinalDate 2023 5
                    , utctDayTime = 90
                    }
                actual = fromGraphQL given
             in actual `shouldBe` expected