structs 0.1.1 → 0.1.2
raw patch · 6 files changed
+357/−44 lines, 6 filesdep +QuickCheckdep +tastydep +tasty-hunitdep −hlintdep ~template-haskell
Dependencies added: QuickCheck, tasty, tasty-hunit, tasty-quickcheck
Dependencies removed: hlint
Dependency ranges changed: template-haskell
Files
- CHANGELOG.markdown +3/−0
- README.markdown +150/−1
- src/Data/Struct/TH.hs +2/−1
- structs.cabal +18/−19
- tests/hlint.hs +0/−23
- tests/unit.hs +184/−0
CHANGELOG.markdown view
@@ -1,3 +1,6 @@+## 0.1.2 [2019.05.02]+* Add a unit test suite.+ ## 0.1.1 * Add a library dependency in the `doctests` test suite
README.markdown view
@@ -12,7 +12,156 @@ This means the `Internal` modules are very much internal. Some documentation is available at-[http://ekmett.github.io/structs/Data-Struct.html](http://ekmett.github.io/structs/Data-Struct.html).+[http://ekmett.github.io/structs/Data-Struct.html](http://ekmett.github.io/structs/Data-Struct.html)+++Examples+--------++## Non-recursive data types+++We use the template haskell helper `makeStruct` to automatically convert+a Haskell `data` definition to a `Struct`.+++As an example, we create a type that mimics a tuple of integers.++```hs+makeStruct [d|+ data TupleInts a s = TupleInts+ { tupleLeft, tupleRight :: a+ }+ |]+```+This declaration uses `makeStruct`, which will generate a bunch of+helper functions for us to use.+++Notice the extra type parameter `s` in `TupleInts a s`. This is used to+carry around state information by `structs`, and so is mandatory.+++```hs+-- Create a new tuple of ints.+mkTupleInts :: PrimMonad m => Int -> Int -> m (TupleInts a (PrimState m))+mkTupleInts a b = st newTupleInts a b+```++`newTupleInts` is a function that was auto-generated by `makeStructs`, whose+parameters are all the fields, which returns a `TupleInts` within a+`PrimMonad` context. Notice the use of `PrimState m` for the state+type parameter of `TupleInts`, which is used to carry the state around.+++```hs+-- set the left element of the tuple+setTupleLeft :: PrimMonad m => TupleInts a (PrimState m) -> a -> m ()+setTupleLeft tup val = setField tupleLeft tup val++-- get the left element of the tuple+getTupleLeft :: PrimMonad m => TupleInts a (PrimState m) -> m a+getTupleLeft tup = getField tupleLeft tup+```+++The Template Haskell generates `tupleLeft, tupleRight :: Field (TupleInts a) a`, which+can be used to get and set fields with `getField, setField`. The type signature+indicates that `tupleLeft, tupleRight` extract an `a` from a `TupleInts a`.+++## Recursive data types++We identify recursive members of a struct with `Slot`s. These are like++```hs+makeStruct [d|+ data LinkedList a s = LinkedList+ { val :: a,+ next :: !(LinkedList a s) }+ |]+```++for this definition, `makeStruct` auto-generates+`next :: Slot (LinkedList a s) (LinkedList a s)`.+Similar to the case of `Field`, the type tells us that `next` extracts+a `LinkedList a s` from a `LinkedList a s`+++```+-- Make an empty linked list+mkEmptyLinkedList :: LinkedList a s+mkEmptyLinkedList = Nil+```++`Nil` is a special value which can be assigned to any `Struct`.+++```hs+-- Make a linked list node with a value+mkLinkedListNode :: PrimMonad m => a -> m (LinkedList a (PrimState m))+mkLinkedListNode a = newLinkedList a Nil+```+Once again, `newLinkedList` is auto-generated by `makeStruct` which we+use to initialize the linked list.++```+-- 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+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+```++The rest is straightforward uses of `get`, `set`, `getField`, and `setField` to+manipulate the linked list as usual.+++FAQ+---++1. Why can fields not be strict? (compiler error)+2. How do I free memory once `alloc`d?+ Contact Information -------------------
src/Data/Struct/TH.hs view
@@ -128,7 +128,8 @@ unapplyType :: Type -> Name -> Q Type unapplyType (AppT f (VarT x)) y | x == y = return f-unapplyType _ _ = fail "Unable to match state type of slot"+unapplyType t n =+ fail $ "Unable to match state type of slot: " ++ show t ++ " | expected: " ++ nameBase n ------------------------------------------------------------------------ -- Code generation
structs.cabal view
@@ -1,8 +1,8 @@ name: structs category: Data-version: 0.1.1+version: 0.1.2 license: BSD3-cabal-version: >= 1.22+cabal-version: 1.22 license-file: LICENSE author: Edward A. Kmett maintainer: Edward A. Kmett <ekmett@gmail.com>@@ -11,7 +11,11 @@ bug-reports: http://github.com/ekmett/structs/issues copyright: Copyright (C) 2015-2017 Edward A. Kmett build-type: Custom-tested-with: GHC == 8.0.2, GHC == 8.2.1+tested-with: GHC == 8.0.2+ , GHC == 8.2.2+ , GHC == 8.4.4+ , GHC == 8.6.5+ , GHC == 8.8.1 synopsis: Strict GC'd imperative object-oriented programming with cheap pointers. description: This project is an experiment with a small GC'd strict mutable imperative universe with cheap pointers inside of the GHC runtime system.@@ -37,16 +41,11 @@ default: True manual: True --- You can disable the doctests test suite with -f-test-doctests-flag test-hlint- default: True- manual: True- library build-depends: base >= 4.9 && < 5, deepseq,- template-haskell >= 2.11 && < 2.13,+ template-haskell >= 2.11 && < 2.15, ghc-prim, primitive @@ -85,16 +84,16 @@ parallel, structs -test-suite hlint+test-suite unit type: exitcode-stdio-1.0- main-is: hlint.hs- ghc-options: -w -threaded -rtsopts -with-rtsopts=-N+ main-is: unit.hs hs-source-dirs: tests default-language: Haskell2010-- if !flag(test-hlint)- buildable: False- else- build-depends:- base,- hlint >= 1.7+ build-depends:+ structs,+ base,+ QuickCheck,+ tasty,+ tasty-quickcheck,+ tasty-hunit,+ primitive
− tests/hlint.hs
@@ -1,23 +0,0 @@--------------------------------------------------------------------------------- |--- Module : Main (hlint)--- Copyright : (C) 2013-2015 Edward Kmett--- License : BSD-style (see the file LICENSE)--- Maintainer : Edward Kmett <ekmett@gmail.com>--- Stability : provisional--- Portability : portable------ This module runs HLint on the lens source tree.-------------------------------------------------------------------------------module Main where--import Control.Monad-import Language.Haskell.HLint-import System.Environment-import System.Exit--main :: IO ()-main = do- args <- getArgs- hints <- hlint $ ["src", "--cpp-define=HLINT", "--cpp-ansi"] ++ args- unless (null hints) exitFailure
+ tests/unit.hs view
@@ -0,0 +1,184 @@+{-# 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)++ ]