version 0.2.0.1HEAD0.2.0.1master

8 files changed, 118 insertions, 72 deletions

diff --git a/C-structs.cabal b/C-structs.cabal
index 0123156..67a5018 100644
--- a/C-structs.cabal
+++ b/C-structs.cabal
@@ -1,11 +1,11 @@
 Name: C-structs
-Version: 0.1.0.1
+Version: 0.2.0.1
 Cabal-Version: >= 1.10
 License: MIT
 License-file: LICENSE
 Author: Simon Plakolb
 Copyright: (c) 2020 Simon Plakolb
-Homepage: https://github.com/pinselimo/cstructs-in-haskell
+Homepage: https://github.com/pinselimo/cstructs-in-haskell#readme
 Synopsis: C-Structs implementation for Haskell
 Description:
     C-structs lets you create correct C structs in Haskell.
@@ -61,11 +61,11 @@ Test-Suite unit-tests
         C-structs,
         base         >= 3.0 && < 5.0,
         HUnit        >= 1.2 && < 1.7,
-        QuickCheck   >= 2.3 && < 2.15,
+        QuickCheck   >= 2.10 && < 2.15,
         template-haskell >= 2.2 && < 2.17,
         test-framework  >= 0.4.1 && < 0.9,
         test-framework-hunit >= 0.2.6 && < 0.4,
-        test-framework-quickcheck2 >= 0.2.8 && < 0.4
+        test-framework-quickcheck2 >= 0.3.0.4 && < 0.4
 
 Test-Suite doctest
     type: exitcode-stdio-1.0
diff --git a/CHANGELOG.md b/CHANGELOG.md
index ae744cf..67c4611 100755
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,2 +1,6 @@
+v0.2.0.1: Remove re-exports of Foreign.C.Storable and Foreign.C.Ptr members
+
+v0.1.0.2: Better Haddock and a fixed C-test template for GHC < 8.0
+
 v0.1.0.1: Added thorough testing and structs with up to four fields
 
diff --git a/README.md b/README.md
index 9822a3a..25c0630 100755
--- a/README.md
+++ b/README.md
@@ -7,7 +7,6 @@ Pythas provides an interface to import Haskell modules.
 
 Note: As of GHC 8.10 structs cannot be passed by value, [only by reference](https://wiki.haskell.org/Foreign_Function_Interface#Foreign_types).
 
-
 ## Usage
 
 You can use these types as a classic ```hackage``` package.
@@ -107,6 +106,16 @@ data Struct8 = Struct8
 instance Storable Struct8 ...
 ~~~
 
+### Accessors
+
+The naming scheme of the accessor functions follows the names of the ordinal numbers. This can be inconvenient in a Template Haskell context. For these situations ```Foreign.C.Structs``` exposes the ```acs``` function:
+
+~~~haskell
+$(acs 8 2)
+~~~
+
+This expression will be spliced into a function taking a ```Struct8``` and extracting its second field.
+
 ## Testing
 
 Identity properties are tested with QuickCheck to ensure that peek and poke are reversible.
@@ -114,7 +123,7 @@ The result of ```sizeOf``` is dependent on the order of types. Its correctness c
 The ```alignment``` function is trivial and only tested implicitly through ```sizeOf```.
 
 Imports from C are tested in ```CTest.hs``` and together with the identity tests form the guarantee that also exports to C are consistent.
-All tests are performed for all available GHC versions through [haskell-ci](https://github.com/haskell-CI/haskell-ci) to ensure maximum compatibility.
+All tests are performed for all available GHC/CABAL/Stack versions through the [Stack CI script](https://docs.haskellstack.org/en/stable/travis_ci/) on both Linux and OSX to ensure maximum compatibility.
 
 ## License
 
diff --git a/src/Foreign/C/Structs.hs b/src/Foreign/C/Structs.hs
index d1c4044..279df4f 100644
--- a/src/Foreign/C/Structs.hs
+++ b/src/Foreign/C/Structs.hs
@@ -7,6 +7,30 @@ Maintainer      : s.plakolb@gmail.com
 Stability       : beta
 
 The @Foreign.C.Structs@ module allows you to construct C structs of arbitrary @Storable@ types.
+It also defined them as instances of the Storable type-class. You can thus create pointers
+to an instance of such a struct and interface with another language.
+
+Currently up to six records are supported. Each number of records needs its own type.
+The types are named after the number of records they support: 'Struct2', 'Struct3' .. @StructN@
+
+If a Struct type with more fields is required, it can be created using Template Haskell and the 'structT' function:
+
+> structT 8 -- creates a Struct with 8 fields
+
+Field access is provided threefold:
+
+ * Record syntax
+
+> 2nd :: Struct2 a b -> b
+
+ * Pattern matching
+
+> (Struct2 a b)
+
+ * Template Haskell 'acs' function.
+
+> $(acs 2 2) :: Struct2 a b -> b
+
 -}
 module Foreign.C.Structs (
       Struct2(..)
@@ -18,52 +42,24 @@ module Foreign.C.Structs (
     , acs
     -- Exports for Template Haskell usage
     , next, sizeof, fmax
-    -- Reexports for Template Haskell
-    , Storable, peek, poke, sizeOf, alignment, castPtr
     ) where
+
 import Foreign.C.Structs.Types (
-     Struct2(..)
-    ,Struct3(..)
-    ,Struct4(..)
-    ,Struct5(..)
-    ,Struct6(..)
+      Struct2(..)
+    , Struct3(..)
+    , Struct4(..)
+    , Struct5(..)
+    , Struct6(..)
     )
 
 import Foreign.C.Structs.Templates (
-     structT
-    ,acs
+      structT
+    , acs
     )
 
-import Foreign.Storable (
-     Storable, peek, poke, sizeOf, alignment
-    )
-import Foreign.Ptr (
-     castPtr
-    )
 import Foreign.C.Structs.Utils (
-     next
-    ,sizeof
-    ,fmax
+      next
+    , sizeof
+    , fmax
     )
 
-{- |
-C-Structs
----------
-
-The @Foreign.C.Structs@ module allows you to construct C structs of arbitrary @Storable@ types.
-It also defined them as instances of the Storable type-class. You can thus create pointers
-to an instance of such a struct and interface with another language.
-
-Currently up to six records are supported. Each number of records needs its own type.
-The types are named after the number of records they support: 'Struct2', 'Struct3' .. @StructN@
-
-If a Struct type with more fields is required, it can be created using Template Haskell and the 'structT' function:
-
-> structT 8 -- creates a Struct with 8 fields
-
-Field access is provided threefold:
- * Record syntax
- * Pattern matching
- * Template Haskell 'acs' function.
--}
-
diff --git a/src/Foreign/C/Structs/Templates.hs b/src/Foreign/C/Structs/Templates.hs
index 1814ae0..26d915d 100644
--- a/src/Foreign/C/Structs/Templates.hs
+++ b/src/Foreign/C/Structs/Templates.hs
@@ -35,25 +35,32 @@ structT = return . zipWith ($) [structTypeT, storableInstanceT] . repeat
 --
 acs :: Int -> Int -> ExpQ
 acs big_n small_n = [| \struct -> $(caseE [| struct |] [m]) |]
-    where m :: MatchQ
+    where
+          m :: MatchQ
           m = match pat (normalB $ varE $ vrs !! (small_n-1)) []
+
           pat :: PatQ
           pat = conP str $ map varP $ take big_n vrs
+
           str = mkName $ "Struct" ++ show big_n
+
           vrs = fieldnames ""
 
 -- Templating functions
 
 structTypeT :: Int -> Dec
 #if __GLASGOW_HASKELL__ < 800
-structTypeT nfields = DataD [] (sTypeN nfields) tyVars [constructor] deriv''
+structTypeT nfields = DataD [] (structType nfields) tyVars [constructor] deriv''
 #elif __GLASGOW_HASKELL__ < 802
-structTypeT nfields = DataD [] (sTypeN nfields) tyVars Nothing [constructor] deriv'
+structTypeT nfields = DataD [] (structType nfields) tyVars Nothing [constructor] deriv'
 #else
-structTypeT nfields = DataD [] (sTypeN nfields) tyVars Nothing [constructor] [deriv]
+structTypeT nfields = DataD [] (structType nfields) tyVars Nothing [constructor] [deriv]
 #endif
-    where tyVars    = map PlainTV $ take nfields $ fieldnames ""
-          constructor = RecC (sTypeN nfields) $ take nfields records
+    where
+          tyVars    = map PlainTV $ take nfields $ fieldnames ""
+
+          constructor = RecC (structType nfields) $ take nfields records
+
           records     = zipWith defRec (getters nfields) (fieldnames "")
 #if __GLASGOW_HASKELL__ < 800
           defRec n t  = (,,) n NotStrict (VarT t)
@@ -61,6 +68,7 @@ structTypeT nfields = DataD [] (sTypeN nfields) tyVars Nothing [constructor] [de
           defRec n t  = (,,) n (Bang NoSourceUnpackedness NoSourceStrictness) (VarT t)
 #endif
           deriv'' = [''Show, ''Eq]
+
           deriv' = map ConT deriv''
 #if __GLASGOW_HASKELL__ > 800
           deriv = DerivClause Nothing deriv'
@@ -72,14 +80,16 @@ storableInstanceT nfields = InstanceD cxt tp decs
 #else
 storableInstanceT nfields = InstanceD Nothing cxt tp decs
 #endif
-    where vars = take nfields $ fieldnames ""
+    where
+          vars = take nfields $ fieldnames ""
+
           storable = AppT $ ConT ''Storable
 #if __GLASGOW_HASKELL__ < 710
           cxt  = map (\v -> ClassP ''Storable [VarT v]) vars
 #else
           cxt  = map (storable . VarT) vars
 #endif
-          tp   = storable $ foldl AppT (ConT $ sTypeN nfields) $ map VarT vars
+          tp   = storable $ foldl AppT (ConT $ structType nfields) $ map VarT vars
 
           decs = [ sizeOfT nfields
                  , alignmentT nfields
@@ -91,52 +101,71 @@ storableInstanceT nfields = InstanceD Nothing cxt tp decs
 
 sizeOfT :: Int -> Dec
 sizeOfT nfields = FunD 'sizeOf [clause]
-    where clause = Clause [VarP struct] (NormalB body) wheres
+    where
+          clause = Clause [VarP struct] (NormalB body) wheres
+
           body = AppE (AppE (VarE 'sizeof) $ alignments "a") (sizes "s")
+
           alignments = ListE . take nfields . map VarE . fieldnames
+
           sizes = ListE . take nfields . map VarE . fieldnames
+
           wheres = vals 'alignment nfields "a" ++ vals 'sizeOf nfields "s"
 
 alignmentT :: Int -> Dec
 alignmentT nfields = FunD 'alignment [clause]
-     where clause = Clause [VarP struct] (NormalB body) wheres
+    where
+           clause = Clause [VarP struct] (NormalB body) wheres
+
            body = AppE (VarE 'fmax) (ListE $ take nfields $ map VarE $ fieldnames "")
+
            wheres = vals 'alignment nfields ""
 
 peekT :: Int -> Dec
 peekT nfields = FunD 'peek [clause]
     where
           vars = take nfields $ fieldnames ""
+
           ptrs = tail $ take nfields $ fieldnames "_ptr"
+
           clause = Clause [VarP ptr] (NormalB body) []
 
           body = DoE $ initial ++ concat gotos ++ final
+
           initial = [ BindS (VarP $ head vars) (AppE (VarE 'peek) castPtr')
                     , BindS (VarP $ head ptrs) (AppE (AppE (VarE 'next) $ VarE ptr) $ VarE $ head vars)
-                  ]
+                    ]
+
+
           gotos = zipWith3 goto (tail vars) ptrs (tail ptrs)
+
           goto n p next_p = [bindVar' p n, bindPtr' next_p p (VarE n)]
 
           final = [ bindVar' (last ptrs) (last vars)
-                  , NoBindS $ AppE (VarE 'return) $ foldl AppE (ConE (sTypeN nfields)) (map VarE vars)
-                ]
+                  , NoBindS $ AppE (VarE 'return) $ foldl AppE (ConE (structType nfields)) (map VarE vars)
+                  ]
 
 pokeT :: Int -> Dec
 pokeT nfields = FunD 'poke [clause]
     where
           vars = take nfields $ fieldnames ""
+
           ptrs = tail $ take nfields $ fieldnames "_ptr"
+
           clause = Clause patterns (NormalB body) []
 
-          patterns = [VarP ptr, ConP (sTypeN nfields) (map VarP vars)]
+          patterns = [VarP ptr, ConP (structType nfields) (map VarP vars)]
+
           body = DoE $ [init_poke, init_next] ++ concat gotos ++ [final]
 
           init_poke = NoBindS
                     $ AppE cast_poke_ptr (VarE $ head vars)
                     where  cast_poke_ptr = AppE (VarE 'poke) castPtr'
+
           init_next = bindPtr' (head ptrs) ptr (VarE $ head vars)
 
           gotos = zipWith3 goto (tail vars) ptrs $ tail ptrs
+
           goto n p next_p = [pokeVar' p var, bindPtr' next_p p var]
                 where var = VarE n
 
@@ -144,25 +173,33 @@ pokeT nfields = FunD 'poke [clause]
 
 -- Helpers and Constants
 
-sTypeN n = mkName ("Struct" ++ show n)
+structType n = mkName ("Struct" ++ show n)
+
 struct   = mkName "struct"
+
 ptr      = mkName "ptr"
+
 castPtr' = AppE (VarE 'castPtr) (VarE ptr)
 
 fieldnames :: String -> [Name]
 fieldnames s = map (mkName . (:s)) ['a'..'z']
+
 getters    :: Int -> [Name]
 getters n = map (mkName . (("s" ++ show n) ++))
           $  ["1st","2nd","3rd"]
           ++ [show n ++ "th" | n <- [4..]]
 
 vals f n s = take n $ zipWith val (fieldnames s) (getters n)
-    where val v getter = ValD (VarP v) (NormalB $ body getter) []
+    where
+          val v getter = ValD (VarP v) (NormalB $ body getter) []
+
           body getter  = AppE (VarE f) $ AppE (VarE getter) $ VarE struct
 
 bindVar' ptr var = BindS (VarP var) (AppE (VarE 'peek) $ VarE ptr)
+
 pokeVar' ptr var = NoBindS
        $ AppE (AppE (VarE 'poke) $ VarE ptr) var
+
 bindPtr' np pp var = BindS (VarP np)
        $ AppE next_ptr var
        where next_ptr = AppE (VarE 'next) $ VarE pp
diff --git a/src/Foreign/C/Structs/Types.hs b/src/Foreign/C/Structs/Types.hs
index ea7d664..f81bf41 100644
--- a/src/Foreign/C/Structs/Types.hs
+++ b/src/Foreign/C/Structs/Types.hs
@@ -16,7 +16,7 @@ module Foreign.C.Structs.Types (
 import Foreign.Storable (Storable, peek, poke, alignment, sizeOf)
 import Foreign.Ptr (Ptr, castPtr)
 
-import Foreign.C.Structs.Utils
+import Foreign.C.Structs.Utils (next, fmax, sizeof)
 import Foreign.C.Structs.Templates (structT)
 
 -- | A 'Struct2' can hold two records of any 'Storable' types @a@ and @b@.
diff --git a/src/Foreign/C/Structs/Utils.hs b/src/Foreign/C/Structs/Utils.hs
index e5e19a0..7f28de2 100644
--- a/src/Foreign/C/Structs/Utils.hs
+++ b/src/Foreign/C/Structs/Utils.hs
@@ -18,22 +18,22 @@ import Foreign.Ptr (Ptr, plusPtr, alignPtr)
 
 -- | Due to alignment constraints the size of C structs is dependent on the order of fields and their respectible sizes. The function 'sizeof' can calculate the resulting size given a list of all 'alignments' and 'sizes'.
 sizeof :: [Int] -> [Int] -> Int
-sizeof alignments sizes = sizeof' 0 alignments sizes
+sizeof as@(_:alignments) (s:sizes) = sizeof' s alignments sizes
     where
-          sizeof' 0 (a:as) (s:ss) = sizeof' s as ss
-          sizeof' s [] [] = s `pad` foldr max 0 alignments
+          sizeof' s [] [] = s `pad` fmax as
           sizeof' x (a:as) (s:ss) = let
-                            s' = x+s
-                            in sizeof' (s' `pad` a) as ss
+                               s' = x+s
+                               in sizeof' (s' `pad` a) as ss
 
-pad x a
-  | x `mod` a == 0 = x
-  | otherwise      = pad (x+1) a
+          pad x a
+              | x `mod` a == 0 = x
+              | otherwise      = pad (x+1) a
 
 -- | Jumps to the next pointer location in the struct.
 next :: (Storable a, Storable b, Storable c) => Ptr a -> b -> IO (Ptr c)
 next ptr x = alloca $ next' ptr x
-    where next' :: (Storable a, Storable b, Storable c) => Ptr a -> b -> Ptr c -> IO (Ptr c)
+    where
+          next' :: (Storable a, Storable b, Storable c) => Ptr a -> b -> Ptr c -> IO (Ptr c)
           next' ptr x ptr_x = do
                 let ptr_y = plusPtr ptr $ sizeOf x
                 y <- peek ptr_x
diff --git a/test/Templates.hs b/test/Templates.hs
index c180422..635161e 100644
--- a/test/Templates.hs
+++ b/test/Templates.hs
@@ -5,7 +5,7 @@ import Language.Haskell.TH
 import Language.Haskell.TH.Syntax (Lift)
 import Foreign.Ptr (Ptr)
 import Foreign.Marshal.Alloc (free)
-import Foreign.Storable (peek)
+import Foreign.Storable (peek, sizeOf)
 import Test.HUnit ((@?=))
 import Test.Framework.Providers.HUnit (testCase)