diff options
Diffstat (limited to 'external/semver/src/quickcheck/Semver.hsc')
-rw-r--r-- | external/semver/src/quickcheck/Semver.hsc | 87 |
1 files changed, 87 insertions, 0 deletions
diff --git a/external/semver/src/quickcheck/Semver.hsc b/external/semver/src/quickcheck/Semver.hsc new file mode 100644 index 0000000..c96eb00 --- /dev/null +++ b/external/semver/src/quickcheck/Semver.hsc @@ -0,0 +1,87 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +module Semver where + +#include "semantic_version_ffi.h" + +import Foreign hiding (unsafePerformIO) +import Foreign.C.String +import Foreign.Storable +import System.IO.Unsafe (unsafePerformIO) + +data Semver = Semver + { vMajor :: #{type unsigned int} + , vMinor :: #{type unsigned int} + , vPatch :: #{type unsigned int} + , vPrerelease :: String + , vBuild :: String + } deriving (Eq, Show) + +-- don't bother with the strings for now + +instance Storable Semver where + sizeOf _ = #{size semver_t} + alignment _ = alignment (undefined :: Word32) + + peek ptr = do + r1 <- #{peek semver_t, major} ptr + r2 <- #{peek semver_t, minor} ptr + r3 <- #{peek semver_t, patch} ptr + return (Semver r1 r2 r3 "" "") + + poke ptr (Semver r1 r2 r3 _ _) = do + #{poke semver_t, major} ptr r1 + #{poke semver_t, minor} ptr r2 + #{poke semver_t, patch} ptr r3 + +-- c functions + +foreign import ccall "semantic_version_ffi.h satisfies" + c_satisfies :: Ptr Semver -> Ptr Semver -> IO Int +foreign import ccall "semantic_version_ffi.h lessThan" + c_lessThan :: Ptr Semver -> Ptr Semver -> IO Int +foreign import ccall "semantic_version_ffi.h nextMajor" + c_nextMajor :: Ptr Semver -> Ptr Semver -> IO () +foreign import ccall "semantic_version_ffi.h nextMinor" + c_nextMinor :: Ptr Semver -> Ptr Semver -> IO () +foreign import ccall "semantic_version_ffi.h nextPatch" + c_nextPatch :: Ptr Semver -> Ptr Semver -> IO () + +-- haskell wrappers + +satisfies :: Semver -> Semver -> Bool +satisfies a b = + unsafePerformIO $ + alloca $ \a_ptr -> + alloca $ \b_ptr -> do + poke a_ptr a + poke b_ptr b + r <- c_satisfies a_ptr b_ptr + return $ if (r == 1) then True else False + +lessThan :: Semver -> Semver -> Bool +lessThan a b = + unsafePerformIO $ + alloca $ \a_ptr -> + alloca $ \b_ptr -> do + poke a_ptr a + poke b_ptr b + r <- c_lessThan a_ptr b_ptr + return $ if (r == 1) then True else False + +nextFunc :: (Ptr Semver -> Ptr Semver -> IO ()) -> Semver -> Semver +nextFunc f a = + unsafePerformIO $ + alloca $ \a_ptr -> + alloca $ \b_ptr -> do + poke a_ptr a + f a_ptr b_ptr + peek b_ptr + +nextMajor :: Semver -> Semver +nextMajor = nextFunc c_nextMajor + +nextMinor :: Semver -> Semver +nextMinor = nextFunc c_nextMinor + +nextPatch :: Semver -> Semver +nextPatch = nextFunc c_nextPatch |