constraints-0.10: tests/GH55Spec.hs

{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}

#if __GLASGOW_HASKELL__ >= 800
{-# LANGUAGE TypeApplications #-}
#endif

module GH55Spec (main, spec) where

import Test.Hspec

#if __GLASGOW_HASKELL__ >= 800
import Data.Constraint
import Data.Constraint.Nat
import GHC.TypeLits

newtype GF (n :: Nat) = GF Integer deriving (Eq, Show)

instance KnownNat n => Num (GF n) where
  xf@(GF a) + GF b = GF $ (a+b) `mod` (natVal xf)
  xf@(GF a) - GF b = GF $ (a-b) `mod` (natVal xf)
  xf@(GF a) * GF b = GF $ (a*b) `mod` (natVal xf)
  abs = id
  signum xf@(GF a) | a==0 = xf
                   | otherwise = GF 1
  fromInteger = GF

x :: GF 5
x = GF 3

y :: GF 5
y = GF 4

foo :: (KnownNat m, KnownNat n) => GF m -> GF n -> GF (Lcm m n)
foo m@(GF a) n@(GF b) = GF $ (a*b) `mod` (lcm (natVal m) (natVal n))

bar :: (KnownNat m) => GF m -> GF m -> GF m
bar (a :: GF m) b = foo a b - foo b a \\ Sub @() (lcmIsIdempotent @m) \\ lcmNat @m @m

z :: GF 5
z = bar x y

spec :: Spec
spec = describe "GH #53" $
         it "should normalize Lcm m m" $
           z `shouldBe` (GF 0 :: GF (Lcm 5 5))
#else
spec :: Spec
spec = return ()
#endif

main :: IO ()
main = hspec spec