TH.hs

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeApplications #-}

module DownhillTest.TH (thTest) where

import Data.AffineSpace (AffineSpace (..))
import Downhill.Grad (HasGrad (MScalar, Tang))
import Downhill.TH (BVarOptions (..), RecordNamer (..), mkHasGradInstances)
import Test.Tasty (TestTree, testGroup)
import DownhillTest.TestTHOptions (defaultDVarOptions)

{-# ANN module "HLint: ignore Use newtype instead of data" #-}
newtype MyRecord1 = MyRecord1 Float

data MyRecord2 = MyRecord2 Float

mkHasGradInstances
  defaultDVarOptions
  [d|
    instance HasGrad MyRecord1 where
      type MScalar MyRecord1 = Float
    |]

mkHasGradInstances
  defaultDVarOptions
  [d|
    instance HasGrad MyRecord2 where
      type MScalar MyRecord2 = Float
    |]

data MyRecord3 = MyRecord3

mkHasGradInstances
  defaultDVarOptions
  [d|
    instance HasGrad MyRecord3 where
      type MScalar MyRecord3 = ()
    |]

data MyRecord4 a = MyRecord4 a

mkHasGradInstances
  defaultDVarOptions
  [d|
    instance (AffineSpace a, HasGrad a, Diff a ~ Tang a) => HasGrad (MyRecord4 a) where
      type MScalar (MyRecord4 a) = MScalar a
    |]

data MyRecord5 a b = MyRecord5 a b

mkHasGradInstances
  defaultDVarOptions
  [d|
    instance
      ( AffineSpace a,
        AffineSpace b,
        HasGrad a,
        HasGrad b,
        MScalar a ~ MScalar b,
        Diff a ~ Tang a,
        Diff b ~ Tang b
      ) =>
      HasGrad (MyRecord5 a b)
      where
      type MScalar (MyRecord5 a b) = MScalar a
    |]

data MyRecord6 a b = MyRecord6 a b

mkHasGradInstances
  defaultDVarOptions
  [d|
    instance
      ( AffineSpace a,
        HasGrad a,
        MScalar a ~ Float,
        Diff a ~ Tang a
      ) =>
      HasGrad (MyRecord6 a Float)
      where
      type MScalar (MyRecord6 a Float) = Float
    |]

data MyRecord7 a = MyRecord7
  { myField7 :: a
  , myLabel7 :: String
  }

mkHasGradInstances
  defaultDVarOptions {optExcludeFields = ["myLabel7"]}
  [d|
    instance HasGrad a => HasGrad (MyRecord7 a) where
      type MScalar (MyRecord7 a) = MScalar a
    |]

thTest :: TestTree
thTest = testGroup "Template Haskell" [] -- just test if it compiles...