ccast (empty) → 0.1.0.0
raw patch · 6 files changed
+256/−0 lines, 6 filesdep +basedep +template-haskellsetup-changed
Dependencies added: base, template-haskell
Files
- ChangeLog.md +5/−0
- LICENSE +30/−0
- Setup.hs +2/−0
- ccast.cabal +28/−0
- src/Bit64Only.hs +65/−0
- src/CCast.hs +126/−0
+ ChangeLog.md view
@@ -0,0 +1,5 @@+# Revision history for ccast++## 0.1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2018, chessai++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of chessai nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ ccast.cabal view
@@ -0,0 +1,28 @@+name: ccast+version: 0.1.0.0+synopsis: typesafe c-style casts; useful for FFI+description:+ Type-safe C-style casts between numeric types, especially+ those in Foreign.C.Types.+homepage: https://github.com/chessai/ccast+license: BSD3+license-file: LICENSE+author: chessai+maintainer: chessai1996@gmail.com+copyright: 2018 (c) chessai+category: Data+build-type: Simple+extra-source-files: ChangeLog.md+cabal-version: >=1.10++source-repository head+ type: git+ location: git://github.com/chessai/ccast.git++library+ exposed-modules: CCast+ other-modules: Bit64Only + build-depends: base >= 4.7 && < 5.0+ , template-haskell >= 2.9 + hs-source-dirs: src+ default-language: Haskell2010
+ src/Bit64Only.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}++{-# OPTIONS_HADDOCK hide #-}++-- | Make something fail to compile on certain architectures.+module Bit64Only+ ( refine+ , refineTH+ , Refined(..)+ , Architecture(..)+ , intToArchitecture+ , Predicate(..)+ , MustBe64+ ) where++import Data.Function++import qualified Language.Haskell.TH.Syntax as TH++refine :: Predicate p x => x -> Either String (Refined p x)+refine x =+ fix $ \result ->+ maybe (Right (Refined x)) Left $+ validate (predicateByResult result) x+ where+ -- A work-around for the type-inference.+ predicateByResult :: Either String (Refined p x) -> p+ predicateByResult =+ const undefined++refineTH :: (Predicate p x, TH.Lift x) => x -> TH.Q (TH.TExp (Refined p x))+refineTH =+ fix $ \loop ->+ fmap TH.TExp . either fail TH.lift . refineByResult (loop undefined)+ where+ -- A work-around for the type-inference.+ refineByResult :: Predicate p x => TH.Q (TH.TExp (Refined p x)) -> x -> Either String (Refined p x)+ refineByResult =+ const refine++newtype Refined p x = Refined x++instance TH.Lift x => TH.Lift (Refined p x) where+ lift (Refined a) = [|Refined a|]++data Architecture = Bit32 | Bit64 | Unknown++intToArchitecture :: Int -> Architecture+intToArchitecture 4 = Bit32+intToArchitecture 8 = Bit64+intToArchitecture _ = Unknown++class Predicate p x where+ validate :: p -> x -> Maybe String++data MustBe64++instance (x ~ Int) => Predicate MustBe64 x where+ validate _ x =+ case intToArchitecture x of+ Bit64 -> Nothing+ _ -> Just "Your architecture is not 64-bit. Failing to compile."
+ src/CCast.hs view
@@ -0,0 +1,126 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}++-- | This module provides type-safe conversions from Foreign C types+-- to Haskell types, and vice versa. It is especially convenient when+-- writing code with Haskell's C FFI.+--+-- This module will not compile on non-64-bit operating systems.+module CCast+ ( Cast(cast)+ , CComplex(CComplex)+ ) where++import Data.Coerce+import Data.Complex+import Data.Int+import Data.Word+import Foreign.C.Types+import Foreign.Ptr +import Foreign.Storable++import Bit64Only++-- | A typeclass for typesafe c-style casts from 'a' to 'b',+-- for use with Haskell's C FFI. This is just a convenience,+-- to prevent from having to think about numeric conversions.+-- Type inference is still weak here; I recommend two solutions:+--+-- With -XTypeApplications:+--+-- @+-- cast \@\CChar \@\Int8 x -- convert x from CChar to Int8+-- @+--+-- With explicit type annotations:+--+-- @+-- cast x :: Int8 -- convert x from CChar to Int8+-- @+--+class Cast a b where+ cast :: Coercible a b => a -> b+ cast = coerce;++-- | Complex number for FFI with the same memory layout as std::complex\<T\>+data CComplex a = CComplex !a !a+ deriving (Eq)++instance Storable a => Storable (CComplex a) where+ sizeOf _ = sizeOf (undefined :: a) * 2+ alignment _ = alignment (undefined :: a)+ poke p (CComplex x y) = do+ pokeElemOff (castPtr p) 0 x+ pokeElemOff (castPtr p) 1 y+ peek p = CComplex+ <$> peekElemOff (castPtr p) 0+ <*> peekElemOff (castPtr p) 1++instance Cast CChar Int8 where+instance Cast Int8 CChar where+instance Cast CSChar Int8 where+instance Cast Int8 CSChar where+instance Cast CUChar Word8 where+instance Cast Word8 CUChar where+instance Cast CShort Int16 where+instance Cast Int16 CShort where+instance Cast CUShort Word16 where+instance Cast Word16 CUShort where+instance Cast CInt Int32 where+instance Cast Int32 CInt where+instance Cast CUInt Word32 where+instance Cast Word32 CUInt where+instance Cast CInt Int where; cast = fromIntegral;+-- | WARNING! This conversion is potentially lossy.+instance Cast Int CInt where; cast = fromIntegral;+instance Cast CLong Int64 where+instance Cast Int64 CLong where+instance Cast CULong Word64 where+instance Cast Word64 CULong where+instance Cast CFloat Float where+instance Cast Float CFloat where+instance Cast CDouble Double where+instance Cast Double CDouble where++instance Cast (CComplex CFloat) (Complex Float) where; cast (CComplex x y) = cast x :+ cast y; {-# INLINE cast #-}+instance Cast (Complex Float) (CComplex CFloat) where; cast (x :+ y) = CComplex (cast x) (cast y); {-# INLINE cast #-} +instance Cast (CComplex CDouble) (Complex Double) where; cast (CComplex x y) = cast x :+ cast y; {-# INLINE cast #-}+instance Cast (Complex Double) (CComplex CDouble) where; cast (x :+ y) = CComplex (cast x) (cast y); {-# INLINE cast #-}++instance Cast CPtrdiff Int64 where+instance Cast Int64 CPtrdiff where+instance Cast CSize Word64 where+instance Cast Word64 CSize where+instance Cast CWchar Int32 where+instance Cast Int32 CWchar where+instance Cast CSigAtomic Int32 where+instance Cast Int32 CSigAtomic where+instance Cast CLLong Int64 where+instance Cast CULLong Word64 where+instance Cast CBool Word8 where+instance Cast Word8 CBool where+instance Cast CIntPtr Int64 where+instance Cast Int64 CIntPtr where+instance Cast CUIntPtr Word64 where+instance Cast Word64 CUIntPtr where+instance Cast CIntMax Int64 where+instance Cast Int64 CIntMax where+instance Cast CClock Int64 where+instance Cast Int64 CClock where+instance Cast CTime Int64 where+instance Cast Int64 CTime where+instance Cast CUSeconds Word32 where+instance Cast Word32 CUSeconds where+instance Cast CSUSeconds Int64 where+instance Cast Int64 CSUSeconds where++-- Proof that we are on a 64-bit architecture.+-- This module will not compile outside of a 64-bit architecture.+myArchitecture :: Refined MustBe64 Int+myArchitecture = $$(refineTH (sizeOf (undefined :: Int)))