structs-0.1.3: tests/unit.hs

{-# LANGUAGE CPP #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
import Test.Tasty
import Test.Tasty.QuickCheck as QC
import Test.QuickCheck.Modifiers (NonEmptyList (..))
import Test.Tasty.HUnit

import Data.List
import Data.Ord

import Control.Exception
import Control.Monad
import Control.Monad.Primitive
import Control.Monad.ST
import Data.Struct.Internal
import Data.Struct.TH


-- Simple use of makeStruct
makeStruct [d|
  data TupleInts a s  = TupleInts
    { tupleLeft, tupleRight :: a
    }
    |]

-- Create a new tuple of ints
mkTupleInts a b = st (newTupleInts a b)

setTupleLeft :: PrimMonad m => TupleInts a (PrimState m) -> a -> m ()
setTupleLeft tup val = setField tupleLeft tup val

getTupleLeft :: PrimMonad m => TupleInts a (PrimState m) -> m a
getTupleLeft tup = getField tupleLeft tup


-- Questions on API:
-- How does Nil work

-- makeStruct of a data type with pointers.

makeStruct [d|
  data LinkedList a s  = LinkedList
    { val :: a,
       next :: !(LinkedList a s) }
    |]

-- Make an empty linked list
mkEmptyLinkedList ::  LinkedList a s
mkEmptyLinkedList = Nil

-- Make a linked list node with a value
mkLinkedListNode :: PrimMonad m => a -> m (LinkedList a (PrimState m))
mkLinkedListNode a = newLinkedList a Nil

-- Append a node to a linked list.
appendLinkedList :: PrimMonad m =>
  LinkedList x (PrimState m)
  -> x
  -> m (LinkedList x (PrimState m))
appendLinkedList xs x = do
  isend <- isNil <$> (get next xs)
  if isend
     then do
       nodex <- mkLinkedListNode x
       set next xs nodex
       return xs
      else do
        xs' <- get next xs
        appendLinkedList xs' x

-- Retreive the nth value from the linked list.
nthLinkedList :: PrimMonad m => Int -> LinkedList a (PrimState m) -> m a
nthLinkedList 0 xs = getField val xs
nthLinkedList i xs = get next xs >>= nthLinkedList (i - 1)

-- Convert a haskell list to a linked list
listToLinkedList :: PrimMonad m => [a] -> m (LinkedList a (PrimState m))
listToLinkedList [] = return mkEmptyLinkedList
listToLinkedList (x:xs) = do
  head <- mkLinkedListNode x
  rest <- listToLinkedList xs
  set next head rest

  return head


-- TODO: setup ViewPatterns  to check when something is nil
-- concat xs ys ==  xs := xs ++ ys
concatLinkedList :: PrimMonad m =>
      LinkedList a (PrimState m)
  -> LinkedList a (PrimState m)
  -> m ()
concatLinkedList xs ys =
  if isNil xs
     then error "head of list is undefined"
     else do
       isend <- isNil <$> (get next xs)
       if isend
           then set next xs ys
           else get next xs >>= \xs' -> concatLinkedList xs' ys


-- datatype with UNPACKED
makeStruct [d| data Vec3 s  = Vec3 { x, y, z :: {-# UNPACK #-} !Int  } |]

-- Test bench
-- ==========
main = defaultMain tests

tests :: TestTree
tests = testGroup "Tests" [properties, unitTests]

properties :: TestTree
properties = testGroup "Properties" [qcProps]


-- Return if a list equal to some linked list representation.
listEqLinkedList :: PrimMonad m => Eq a => [a] -> LinkedList a (PrimState m) -> m Bool
listEqLinkedList [] l = return $ isNil l
listEqLinkedList (x:xs) l = do
  xval <- getField val l
  if xval == x
     then do
       l' <- get next l
       listEqLinkedList xs l'
    else return False


qcProps = testGroup "(checked by QuickCheck)"
  [ QC.testProperty @([Int] -> Bool) "list to linked list" $
    \xs -> runST $ do
      lxs <- listToLinkedList xs
      listEqLinkedList xs lxs

  , QC.testProperty @(NonEmptyList Int -> Bool) "Indexing linked lists" $
    \xs -> runST $ do
        lxs <- listToLinkedList (getNonEmpty xs)

        -- TODO: missing Foldable instance for NonEmptyList
        xsAtIx <- sequenceA [nthLinkedList ix lxs | ix <- [0.. length (getNonEmpty xs) - 1]]
        return $ xsAtIx  == getNonEmpty xs

        -- return $ getNonEmpty lxs == xsAtIx

  , QC.testProperty @(NonEmptyList Int -> [Int] -> Bool) "Appending linked lists" $
    \xs ys -> runST $ do
      lxs <- listToLinkedList (getNonEmpty xs)
      lys <- listToLinkedList ys

      -- this mutates lxs
      concatLinkedList lxs lys

      listEqLinkedList ((getNonEmpty xs) ++ ys) lxs
  ]



-- Try out the `Precomposable` system
nextnext :: Slot (LinkedList a) (LinkedList a)
nextnext = next # next

nextnextval :: Field (LinkedList a) a
nextnextval = nextnext # val


unitTests = testGroup "Unit tests"
  [ testCase "create and get value from tuple" $
      runST $ do
        c <- mkTupleInts 10 20
        val <- getTupleLeft  c
        return (val @?= 10)
  , testCase "set and get value from tuple" $ runST $ do
        c <- mkTupleInts 10 20
        setTupleLeft c 30
        val <- getTupleLeft c
        return (val @?= 30)
  , testCase "pull the values out of a linked list using nextnextval" $ runST $ do
      xs <- listToLinkedList [1, 2, 3]
      nnv <- getField nextnextval xs
      return (nnv @?= 3)

  ]