MkGetter.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

module Tests.MkGetter where

import Control.DeepSeq (deepseq)
import Data.Text (Text)
import Language.Haskell.TH.TestUtils (
  QMode (..),
  QState (..),
  loadNames,
  runTestQ,
  runTestQErr,
 )
import Test.Tasty
import Test.Tasty.HUnit
import Text.RawString.QQ (r)

import Data.Aeson.Schema (Object, get, mkGetter, schema)
import TestUtils (json, showSchemaResult)
import TestUtils.DeepSeq ()

type MySchema = [schema| { users: List { name: Text } } |]

mkGetter "User" "getUsers" ''MySchema ".users[]"

test :: TestTree
test =
  runMkGetterQ
    `deepseq` testGroup
      "`mkGetter` helper"
      [ testCase "Type synonym is generated" $
          showSchemaResult @User @?= [r|Object (SchemaObject { "name": Text })|]
      , testCase "Getter function is generated" $
          let users :: [User]
              users = getUsers testData

              getName :: User -> Text
              getName = [get| .name |]
           in map getName users @?= ["Alice", "Bob", "Claire"]
      , testCase "mkGetter expression should be a lambda expression" $
          let msg = runTestQErr qState $ mkGetter "User" "getUsers" ''MySchema "foo.users[]"
           in msg @?= "Getter expression should start with '.': foo.users[]"
      ]
  where
    qState =
      QState
        { mode = MockQ
        , knownNames = []
        , reifyInfo = $(loadNames [''MySchema])
        }

    -- run same mkGetter expression that was spliced, for coverage
    runMkGetterQ = runTestQ qState $ mkGetter "User" "getUsers" ''MySchema ".users[]"

testData :: Object MySchema
testData =
  [json|
  {
    "users": [
      { "name": "Alice" },
      { "name": "Bob" },
      { "name": "Claire" }
    ]
  }
|]