traverse-code-0.1.1: test/TraverseCodeTest.hs

-- {-# options -ddump-ds #-}
{-# language TemplateHaskell #-}
module Main (module Main) where

import Language.Haskell.TH.TraverseCode
import qualified Data.Functor.Product as FP
import Data.Functor.Sum
import qualified Data.Sequence as S
import Generics.Linear
import Data.Primitive.SmallArray
import GHC.Exts (fromList)
import Test.Tasty.HUnit
import Test.Tasty

arry0 :: SmallArray a
arry0 = $$(sequenceCode (fromList []))

arry1 :: a -> SmallArray a
arry1 a = $$(sequenceCode (fromList [ [||a||]]))

arry2 :: a -> a -> SmallArray a
arry2 a b = $$(sequenceCode (fromList [[||a||], [||b||]]))

hah :: Maybe a -> MP1 m Maybe a
hah Nothing = $$(sequenceCode (MP1 Nothing))
hah (Just x) = $$(sequenceCode (MP1 (Just [||x||])))

ho :: a -> a -> MP1 m [] a
ho x y = $$(sequenceCode (MP1 [ [||x||], [||y||] ]))

boom :: a -> (Int, a)
boom a = $$(sequenceCode (12, [|| a ||]))

zorp :: Bool -> a -> Either Int a
zorp False a = $$(sequenceCode (Left 4))
zorp True a = $$(sequenceCode (Right [||a||]))

goo :: a -> a -> Maybe a -> FP.Product [] Maybe a
goo x1 x2 Nothing = $$(sequenceCode (FP.Pair [ [||x1||], [||x2||] ] Nothing))
goo x1 x2 (Just y) = $$(sequenceCode (FP.Pair [ [||x1||], [||x2||] ] (Just [||y||])))

emptySeq :: S.Seq a
emptySeq = $$(sequenceCode (S.fromList []))

single :: a -> S.Seq a
single a = $$(sequenceCode (S.fromList [ [||a||] ]))

double :: a -> a -> S.Seq a
double a b = $$(sequenceCode (S.fromList [ [||a||], [||b||] ]))

triple :: a -> a -> a -> S.Seq a
triple a b c = $$(sequenceCode (S.fromList [ [||a||], [||b||], [||c||] ]))

seq10 :: a -> a -> a -> a -> a ->
         a -> a -> a -> a -> a -> S.Seq a
seq10 a b c d e  f g h i j = $$(traverseCode id (S.fromList
   [ [||a||], [||b||], [||c||], [||d||], [||e||], [||f||], [||g||], [||h||],[||i||],[||j||] ]))

seq11 :: a -> a -> a -> a -> a ->
         a -> a -> a -> a -> a -> a -> S.Seq a
seq11 a b c d e  f g h i j k = $$(traverseCode id $ S.reverse (S.fromList
   [ [||a||], [||b||], [||c||], [||d||], [||e||], [||f||], [||g||], [||h||],[||i||],[||j||],[||k||] ]))

main :: IO ()
main = defaultMain $ testGroup "properties" [
  testCase "ary" $ do
    (emptySmallArray :: SmallArray Int) @=? arry0
    fromList [10 :: Int] @=? arry1 10
    fromList [20, 30] @=? arry2 20 30
  ]