C-structs 0.1.0.1 → 0.2.0.1

raw patch · 8 files changed

+118/−72 lines, 8 filesdep ~QuickCheckdep ~test-framework-quickcheck2PVP ok

version bump matches the API change (PVP)

Dependency ranges changed: QuickCheck, test-framework-quickcheck2

API changes (from Hackage documentation)

Files

• C-structs.cabal +4/−4
• CHANGELOG.md +4/−0
• README.md +11/−2
• src/Foreign/C/Structs.hs +35/−39
• src/Foreign/C/Structs/Templates.hs +53/−16
• src/Foreign/C/Structs/Types.hs +1/−1
• src/Foreign/C/Structs/Utils.hs +9/−9
• test/Templates.hs +1/−1

@@ -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 @@         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

@@ -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 

@@ -7,7 +7,6 @@  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 @@ 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 ```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 

@@ -7,6 +7,30 @@ 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 @@     , 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.--} 

@@ -35,25 +35,32 @@ -- 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 @@           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 @@ #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 @@  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 @@  -- 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

@@ -16,7 +16,7 @@ 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@.

@@ -18,22 +18,22 @@  -- | 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

@@ -5,7 +5,7 @@ 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)