packages feed

convert 1.0 → 1.0.1

raw patch · 19 files changed

+611/−607 lines, 19 filesdep ~containersdep ~eitherdep ~lens

Dependency ranges changed: containers, either, lens, mtl, old-locale, old-time, template-haskell

Files

− Data/Convert.hs 
@@ -1,5 +0,0 @@--module Data.Convert (module X) where--import Data.Convert.Base      as X-import Data.Convert.Instances ()
− Data/Convert/Base.hs 
@@ -1,69 +0,0 @@-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE RankNTypes #-}--{-# LANGUAGE CPP #-}-#if __GLASGOW_HASKELL__ < 710-{-# LANGUAGE OverlappingInstances #-}-#endif--module Data.Convert.Base where--import Control.Lens--------------------------------------------------------------------------- Conversions-------------------------------------------------------------------------class MaybeConvertible a e b | a b -> e where-    tryConvert :: a -> Either e b--class MaybeConvertible' a e b | b -> a e where-    tryConvert' :: a -> Either e b--class Convertible a b where-    convert :: a -> b---- Maybe we should change the name to Specializable and specialize?-class Convertible' a b | b -> a where-    convert' :: a -> b--class Castable a b where-    cast :: a -> b--type IsoMaybeConvertible  a e b = (MaybeConvertible  a e b, MaybeConvertible  b e a)-type IsoMaybeConvertible' a e b = (MaybeConvertible' a e b, MaybeConvertible' b e a)-type IsoConvertible       a b   = (Convertible       a b  , Convertible       b a  )-type IsoConvertible'      a b   = (Convertible'      a b  , Convertible'      b a  )-type IsoCastable          a b   = (Castable          a b  , Castable          b a  )--class ConvertibleM  m n where convertM  :: m (t1 :: k) -> n (t1 :: k)-class ConvertibleM2 m n where convertM2 :: m (t1 :: k) (t2 :: k) -> n (t1 :: k) (t2 :: k)-class ConvertibleM3 m n where convertM3 :: m (t1 :: k) (t2 :: k) (t3 :: k) -> n (t1 :: k) (t2 :: k) (t3 :: k)-class ConvertibleM4 m n where convertM4 :: m (t1 :: k) (t2 :: k) (t3 :: k) (t4 :: k) -> n (t1 :: k) (t2 :: k) (t3 :: k) (t4 :: k)-class ConvertibleM5 m n where convertM5 :: m (t1 :: k) (t2 :: k) (t3 :: k) (t4 :: k) (t5 :: k) -> n (t1 :: k) (t2 :: k) (t3 :: k) (t4 :: k) (t5 :: k)---- utils--unsafeConvert :: Show e => MaybeConvertible a e b => a -> b-unsafeConvert a =-    case tryConvert a of-      Left  e -> error $ show e-      Right r -> r--casted :: IsoCastable a b => Iso' a b-casted = iso cast cast--converted :: IsoConvertible a b => Iso' a b-converted = iso convert convert---- instances--instance {-# OVERLAPPABLE #-} Convertible a a where convert  = id--instance {-# OVERLAPPABLE #-} Convertible a b => Convertible (Maybe a) (Maybe b) where-    convert = fmap convert--instance {-# OVERLAPPABLE #-} Convertible a b => Castable a b where-    cast = convert
− Data/Convert/Bound.hs 
@@ -1,165 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE NoMonomorphismRestriction #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE ViewPatterns #-}--module Data.Convert.Bound where--import Data.Convert.Base-import Data.Typeable-import Control.Applicative-import Language.Haskell.TH hiding (Type, Safety, Safe, Unsafe)-import Data.Monoid-import GHC.TypeLits-import Prelude hiding (Bounded, maxBound, minBound)-import qualified Prelude as Prelude------- === The runtime used safe conversion ===---- TODO [wd]: We can optimize it further. Right now we are converting everything to Rational and comparing.---            It's because sometimes we are converting between types of different bounds like Char and Int8---            - neither can we safely convert Char to Int 8 nor vice versa.---            We can though make typeclasses that will find the smallest super-type for a given type pair---            and convert both values to that super-type-boundedConversion :: (Bounded b, Ord a, Convertible a Rational, Convertible (Bounds b) (Bounds Rational))-                  => (a -> b) -> (a -> Either BoundError b)-boundedConversion (func :: a -> b) inp = if (convert inp) `boundedBy` (convert (bounds :: Bounds b) :: Bounds Rational)-    then Right $ func inp-    else Left BoundError------- === Errors ===--data BoundError = BoundError deriving (Show)----- === Conversion ===--data Conversion = Conversion (Q Exp) Type Type--class Conversions a b where-    conversions :: Q Exp -> a -> b -> [Conversion]---- utils--genConversion :: Conversion -> Q Dec-genConversion c@(Conversion qexp (Type name bounds) (Type name' bounds')) = do-    exp <- qexp :: Q Exp-    let convf name fmod = [ValD (VarP $ mkName name) (NormalB $ fmod exp) []]-    return $ if bounds `isSubBound` bounds'-        then InstanceD [] (AppT (AppT (ConT $ mkName "Convertible") (ConT name)) (ConT name')) $ convf "convert" id-        else InstanceD [] (AppT (AppT (AppT (ConT $ mkName "MaybeConvertible") (ConT name)) (ConT $ mkName "BoundError")) (ConT name')) $ convf "tryConvert" $ AppE (VarE $ mkName "boundedConversion")---genConversions :: [Conversion] -> Q [Dec]-genConversions = mapM genConversion---- instances--instance Conversions [Type] [Type] where conversions f a b = Conversion f <$> a <*> b-instance Conversions Type   [Type] where conversions f a b = Conversion f a <$> b-instance Conversions [Type] Type   where conversions f a b = flip (Conversion f) b <$> a-instance Conversions Type   Type   where conversions f a b = [Conversion f a b]--instance Show Conversion where-    show (Conversion _ a b) = "Conversion " -- <> " " <> name a <> " " <> name b------- === Type ===--data Type = Type { name    :: Name-                 , tbounds :: (Bounds Integer)-                 } deriving (Show, Eq)------ === Layout ===-data Layout = IntLayout Sign Integer-            | InfiniteLayout-            deriving (Show, Eq)--data Sign = Signed-          | Unsigned-          deriving (Show, Eq)--layoutBounds :: Layout -> Bounds Integer-layoutBounds = \case-    InfiniteLayout -> infiniteBounds-    IntLayout s i  -> Bounds (Value (- base)) (Value $ base - 1)-                      where base = case s of-                                   Signed   -> 2 ^ (i - 1)-                                   Unsigned -> 2 ^ i------ === Value ===--data Value a = MinusInfinity-             | Value a-             | Infinity-             deriving (Show, Functor, Eq)---- instances--instance Num a => Num (Value a) where-    fromInteger = Value . fromInteger--instance Convertible a b => Convertible (Value a) (Value b) where-    convert (Value a) = Value $ convert a--instance Ord a => Ord (Value a) where-    compare MinusInfinity MinusInfinity = EQ-    compare MinusInfinity a             = LT-    compare a             MinusInfinity = GT-    compare Infinity      Infinity      = EQ-    compare Infinity      a             = GT-    compare a             Infinity      = LT-    compare (Value a)     (Value a')    = compare a a'------- === Bounds ===--data Bounds a = Bounds (Value a) (Value a) deriving (Show, Functor, Eq)--class Bounded a where-    bounds :: Bounds a---- utils--infiniteBounds :: Bounds a-infiniteBounds = Bounds MinusInfinity Infinity--isSubBound :: Ord a => Bounds a -> Bounds a -> Bool-isSubBound (Bounds min max) (Bounds min' max') = min >= min' && max <= max'--boundedBy :: Ord a => a -> Bounds a -> Bool-boundedBy (Value -> a) (Bounds min max) = a >= min && a <= max---- instances-instance {-# OVERLAPPABLE #-} Convertible a b => Convertible (Bounds a) (Bounds b) where-    convert (Bounds a b) = Bounds (convert a) (convert b)--instance {-# OVERLAPPABLE #-} (Prelude.Bounded a)-      => Bounded a where-    bounds = Bounds (Value Prelude.minBound) (Value Prelude.maxBound)--instance {-# OVERLAPPABLE #-} Bounded Float    where bounds = infiniteBounds-instance {-# OVERLAPPABLE #-} Bounded Double   where bounds = infiniteBounds-instance {-# OVERLAPPABLE #-} Bounded Rational where bounds = infiniteBounds-instance {-# OVERLAPPABLE #-} Bounded Integer  where bounds = infiniteBounds
− Data/Convert/Errors.hs 
@@ -1,5 +0,0 @@-module Data.Convert.Errors where--import Data.Typeable--data TypeMismatch = TypeMismatch TypeRep TypeRep deriving (Show)
− Data/Convert/Instances.hs 
@@ -1,6 +0,0 @@-module Data.Convert.Instances () where--import Data.Convert.Instances.Map     ()-import Data.Convert.Instances.Num     ()-import Data.Convert.Instances.Text    ()-import Data.Convert.Instances.TH      ()
− Data/Convert/Instances/Map.hs 
@@ -1,13 +0,0 @@-module Data.Convert.Instances.Map()-where--import Data.Convert.Base--import qualified Data.Map as Map---instance Ord k => Convertible [(k, a)] (Map.Map k a) where-    convert = Map.fromList--instance Convertible (Map.Map k a) [(k, a)] where-    convert = Map.toList
− Data/Convert/Instances/Num.hs 
@@ -1,66 +0,0 @@-{-# LANGUAGE NoMonomorphismRestriction #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE TemplateHaskell #-}--module Data.Convert.Instances.Num where--import Data.Convert.Bound-import Data.Convert.Base-import Data.Monoid-import qualified Data.ByteString as BS-import GHC.Int-import Data.Word-import Data.Bits (shiftR)--intTypes   = [ Type ''Int      $ layoutBounds $ IntLayout Signed 30 -- according to: https://hackage.haskell.org/package/base-4.8.0.0/docs/Data-Int.html#t:Int-             , Type ''Integer  $ layoutBounds $ InfiniteLayout-             , Type ''Int8     $ layoutBounds $ IntLayout Signed 8-             , Type ''Int16    $ layoutBounds $ IntLayout Signed 16-             , Type ''Int32    $ layoutBounds $ IntLayout Signed 32-             , Type ''Int64    $ layoutBounds $ IntLayout Signed 64-             ]--wordTypes  = [ Type ''Word     $ layoutBounds $ IntLayout Signed 30 -- according to: https://hackage.haskell.org/package/base-4.8.0.0/docs/Data-Int.html#t:Int-             , Type ''Word8    $ layoutBounds $ IntLayout Signed 8-             , Type ''Word16   $ layoutBounds $ IntLayout Signed 16-             , Type ''Word32   $ layoutBounds $ IntLayout Signed 32-             , Type ''Word64   $ layoutBounds $ IntLayout Signed 64-             ]--floatTypes = [ Type ''Float    $ layoutBounds $ InfiniteLayout-             , Type ''Double   $ layoutBounds $ InfiniteLayout-             , Type ''Rational $ layoutBounds $ InfiniteLayout-             ]--charType = Type ''Char $ Bounds 0 1114111 -- max char enum is 1114111--integralTypes = intTypes <> wordTypes-----------------instance Convertible ()                  [t] where convert _                            = []-instance Convertible (t,t)               [t] where convert (t1,t2)                      = [t1,t2]-instance Convertible (t,t,t)             [t] where convert (t1,t2,t3)                   = [t1,t2,t3]-instance Convertible (t,t,t,t)           [t] where convert (t1,t2,t3,t4)                = [t1,t2,t3,t4]-instance Convertible (t,t,t,t,t)         [t] where convert (t1,t2,t3,t4,t5)             = [t1,t2,t3,t4,t5]-instance Convertible (t,t,t,t,t,t)       [t] where convert (t1,t2,t3,t4,t5,t6)          = [t1,t2,t3,t4,t5,t6]-instance Convertible (t,t,t,t,t,t,t)     [t] where convert (t1,t2,t3,t4,t5,t6,t7)       = [t1,t2,t3,t4,t5,t6,t7]-instance Convertible (t,t,t,t,t,t,t,t)   [t] where convert (t1,t2,t3,t4,t5,t6,t7,t8)    = [t1,t2,t3,t4,t5,t6,t7,t8]-instance Convertible (t,t,t,t,t,t,t,t,t) [t] where convert (t1,t2,t3,t4,t5,t6,t7,t8,t9) = [t1,t2,t3,t4,t5,t6,t7,t8,t9]----- TODO: http://stackoverflow.com/questions/8350814/converting-64-bit-double-to-bytestring-efficiently-instance Convertible Word64 (Word8,Word8,Word8,Word8,Word8,Word8,Word8,Word8) where-    convert word = (unpack 56, unpack 48, unpack 40, unpack 32, unpack 24, unpack 16, unpack 8, unpack 0)-        where unpack = fromIntegral . shiftR word---- ...------------------numConversions =  conversions [| fromIntegral            |] integralTypes (integralTypes <> floatTypes)-               <> conversions [| truncate                |] floatTypes    integralTypes-               <> conversions [| realToFrac              |] floatTypes    floatTypes-               <> conversions [| fromIntegral . fromEnum |] charType      (integralTypes <> floatTypes)-               <> conversions [| toEnum . fromIntegral   |] integralTypes charType
− Data/Convert/Instances/TH.hs 
@@ -1,10 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}--module Data.Convert.Instances.TH where--import Data.Convert.Base-import Data.Convert.Bound-import Data.Convert.Instances.Num (numConversions)---genConversions numConversions
− Data/Convert/Instances/Text.hs 
@@ -1,217 +0,0 @@-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE TypeSynonymInstances #-}-{-# LANGUAGE CPP #-}---module Data.Convert.Instances.Text()-where--import Data.Convert.Base-import qualified Data.Text as TS-import qualified Data.Text.Encoding as TE-import qualified Data.Text.Lazy as TL-import qualified Data.Text.Lazy.Builder as TLB-import qualified Data.Text.Lazy.Encoding as TLE-import qualified Data.ByteString as BS-import qualified Data.ByteString.Lazy as BL-import qualified Data.ByteString.Builder as BB-import Data.Word (Word8)-import Data.Foldable----instance Convertible TS.Text [Char] where-    {-# INLINE convert #-}-    convert = TS.unpack--instance Convertible TS.Text TL.Text where-    {-# INLINE convert #-}-    convert = TL.fromStrict--instance Convertible TS.Text TLB.Builder where-    {-# INLINE convert #-}-    convert = TLB.fromText--instance Convertible TS.Text BS.ByteString where-    {-# INLINE convert #-}-    convert = TE.encodeUtf8--instance Convertible TS.Text BL.ByteString where-    {-# INLINE convert #-}-    convert = BL.fromStrict . TE.encodeUtf8--instance Convertible TS.Text BB.Builder where-    {-# INLINE convert #-}-#if MIN_VERSION_text(1,2,0)-    convert = TE.encodeUtf8Builder-#else-    convert = convert . TE.encodeUtf8-#endif----instance Convertible TL.Text [Char] where-    {-# INLINE convert #-}-    convert = TL.unpack--instance Convertible TL.Text TS.Text where-    {-# INLINE convert #-}-    convert = TL.toStrict--instance Convertible TL.Text TLB.Builder where-    {-# INLINE convert #-}-    convert = TLB.fromLazyText--instance Convertible TL.Text BS.ByteString where-    {-# INLINE convert #-}-    convert = convert . TLE.encodeUtf8--instance Convertible TL.Text BL.ByteString where-    {-# INLINE convert #-}-    convert = TLE.encodeUtf8--instance Convertible TL.Text BB.Builder where-    {-# INLINE convert #-}-#if MIN_VERSION_text(1,2,0)-    convert = TLE.encodeUtf8Builder-#else-    convert = convert . TLE.encodeUtf8-#endif----instance Convertible TLB.Builder [Char] where-    {-# INLINE convert #-}-    convert = convert . TLB.toLazyText--instance Convertible TLB.Builder TS.Text where-    {-# INLINE convert #-}-    convert = convert . TLB.toLazyText--instance Convertible TLB.Builder TL.Text where-    {-# INLINE convert #-}-    convert = TLB.toLazyText--instance Convertible TLB.Builder BS.ByteString where-    {-# INLINE convert #-}-    convert = convert . TLB.toLazyText--instance Convertible TLB.Builder BL.ByteString where-    {-# INLINE convert #-}-    convert = convert . TLB.toLazyText--instance Convertible TLB.Builder BB.Builder where-    {-# INLINE convert #-}-    convert = convert . TLB.toLazyText----instance Convertible BS.ByteString [Word8] where-    {-# INLINE convert #-}-    convert = BS.unpack--instance Convertible BS.ByteString TS.Text where-    {-# INLINE convert #-}-    convert = TE.decodeUtf8--instance Convertible BS.ByteString TL.Text where-    {-# INLINE convert #-}-    convert = TL.fromStrict . convert--instance Convertible BS.ByteString TLB.Builder where-    {-# INLINE convert #-}-    convert = TLB.fromText . convert--instance Convertible BS.ByteString BL.ByteString where-    {-# INLINE convert #-}-    convert = BL.fromStrict--instance Convertible BS.ByteString BB.Builder where-    {-# INLINE convert #-}-    convert = BB.byteString----instance Convertible BL.ByteString [Word8] where-    {-# INLINE convert #-}-    convert = BL.unpack--instance Convertible BL.ByteString TS.Text where-    {-# INLINE convert #-}-    convert = TL.toStrict . convert--instance Convertible BL.ByteString TL.Text where-    {-# INLINE convert #-}-    convert = TLE.decodeUtf8--instance Convertible BL.ByteString TLB.Builder where-    {-# INLINE convert #-}-    convert = TLB.fromLazyText . convert--instance Convertible BL.ByteString BS.ByteString where-    {-# INLINE convert #-}-    convert = BL.toStrict--instance Convertible BL.ByteString BB.Builder where-    {-# INLINE convert #-}-    convert = BB.lazyByteString----instance Convertible [Char] TS.Text where-    {-# INLINE convert #-}-    convert = TS.pack--instance Convertible [Char] TL.Text where-    {-# INLINE convert #-}-    convert = TL.pack--instance Convertible [Char] TLB.Builder where-    {-# INLINE convert #-}-    convert = TLB.fromString----instance Convertible [Word8] BS.ByteString where-    {-# INLINE convert #-}-    convert = BS.pack--instance Convertible [Word8] BL.ByteString where-    {-# INLINE convert #-}-    convert = BL.pack--instance Convertible [Word8] BB.Builder where-    {-# INLINE convert #-}-    convert = foldMap BB.word8----instance Convertible Char TS.Text where-    {-# INLINE convert #-}-    convert = TS.singleton--instance Convertible Char TL.Text where-    {-# INLINE convert #-}-    convert = TL.singleton--instance Convertible Char TLB.Builder where-    {-# INLINE convert #-}-    convert = TLB.singleton----instance Convertible Word8 BS.ByteString where-    {-# INLINE convert #-}-    convert = BS.singleton--instance Convertible Word8 BL.ByteString where-    {-# INLINE convert #-}-    convert = BL.singleton--instance Convertible Word8 BB.Builder where-    {-# INLINE convert #-}-    convert = BB.word8
convert.cabal view
@@ -1,56 +1,48 @@-name:                convert-version:             1.0-synopsis:            Safe and unsafe data conversion utilities with strong type-level operation. checking.--- description:         -license:             Apache-2.0-license-file:        LICENSE-author:              Wojciech Danilo-maintainer:          Wojciech Danilo <wojciech.danilo@gmail.com>-stability:           experimental-homepage:            https://github.com/wdanilo/convert-bug-reports:         https://github.com/wdanilo/convert/issues-copyright:           Copyright (C) 2015 Wojciech Danilo-category:            Data-build-type:          Simple--- extra-source-files:  -cabal-version:       >=1.10-+name: convert+version: 1.0.1+cabal-version: >=1.10+build-type: Simple+license: Apache-2.0+license-file: LICENSE+copyright: Copyright (C) 2015 Wojciech Danilo+maintainer: Wojciech Danilo <wojciech.danilo@gmail.com>+stability: experimental+homepage: https://github.com/wdanilo/convert+bug-reports: https://github.com/wdanilo/convert/issues+synopsis: Safe and unsafe data conversion utilities with strong type-level operation. checking.+category: Data+author: Wojciech Danilo  flag dump-splices-  default: False-  manual: True+    default: False+    manual: True  library-  Build-Depends: base>=3 && <5,-                 old-time,-                 time>=1.1.3,-                 bytestring >= 0.10.2,-                 containers,-                 old-locale,-                 mtl,-                 text >= 0.8,-                 either,-                 template-haskell,-                 lens--  GHC-Options: -O2 -Wall -fno-warn-orphans-  default-language:   Haskell2010----  Exposed-Modules: Data.Convert,-                   Data.Convert.Base,-                   Data.Convert.Bound,-                   Data.Convert.Errors,-                   Data.Convert.Instances,-                   Data.Convert.Instances.Map,-                   Data.Convert.Instances.Num,-                   Data.Convert.Instances.Text,-                   Data.Convert.Instances.TH--  default-extensions: MultiParamTypeClasses,-                      UndecidableInstances, FlexibleInstances,-                      FlexibleContexts, CPP--+    exposed-modules:+        Data.Convert+        Data.Convert.Base+        Data.Convert.Bound+        Data.Convert.Errors+        Data.Convert.Instances+        Data.Convert.Instances.Map+        Data.Convert.Instances.Num+        Data.Convert.Instances.Text+        Data.Convert.Instances.TH+    build-depends:+        base >=3 && <5,+        old-time >=1.1.0.3,+        time >=1.1.3,+        bytestring >=0.10.2,+        containers >=0.5.6.2,+        old-locale >=1.0.0.7,+        mtl >=2.2.1,+        text >=0.8,+        either >=4.4.1,+        template-haskell >=2.10.0.0,+        lens >=4.13+    default-language: Haskell2010+    default-extensions: MultiParamTypeClasses UndecidableInstances+                        FlexibleInstances FlexibleContexts CPP DefaultSignatures+    hs-source-dirs: src+    ghc-options: -O2 -Wall -fno-warn-orphans
+ src/Data/Convert.hs view
@@ -0,0 +1,5 @@++module Data.Convert (module X) where++import Data.Convert.Base      as X+import Data.Convert.Instances ()
+ src/Data/Convert/Base.hs view
@@ -0,0 +1,73 @@+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RankNTypes #-}++{-# LANGUAGE CPP #-}+#if __GLASGOW_HASKELL__ < 710+{-# LANGUAGE OverlappingInstances #-}+#endif++module Data.Convert.Base where++import Prelude+import Control.Lens++----------------------------------------------------------------------+-- Conversions+----------------------------------------------------------------------++class MaybeConvertible a e b | a b -> e where+    tryConvert :: a -> Either e b++class MaybeConvertible' a e b | b -> a e where+    tryConvert' :: a -> Either e b++class Convertible a b where+    convert :: a -> b++-- Maybe we should change the name to Specializable and specialize?+class Convertible' a b | b -> a where+    convert' :: a -> b++type BiCastable a b = (Castable a b, Castable b a)++class Castable a b where+    cast :: a -> b+    default cast :: Convertible a b => a -> b+    cast = convert++type IsoMaybeConvertible  a e b = (MaybeConvertible  a e b, MaybeConvertible  b e a)+type IsoMaybeConvertible' a e b = (MaybeConvertible' a e b, MaybeConvertible' b e a)+type IsoConvertible       a b   = (Convertible       a b  , Convertible       b a  )+type IsoConvertible'      a b   = (Convertible'      a b  , Convertible'      b a  )+type IsoCastable          a b   = (Castable          a b  , Castable          b a  )++class ConvertibleM  m n where convertM  :: m t1 -> n t1+class ConvertibleM2 m n where convertM2 :: m t1 t2 -> n t1 t2+class ConvertibleM3 m n where convertM3 :: m t1 t2 t3 -> n t1 t2 t3+class ConvertibleM4 m n where convertM4 :: m t1 t2 t3 t4 -> n t1 t2 t3 t4+class ConvertibleM5 m n where convertM5 :: m t1 t2 t3 t4 t5 -> n t1 t2 t3 t4 t5++-- utils++unsafeConvert :: Show e => MaybeConvertible a e b => a -> b+unsafeConvert a =+    case tryConvert a of+      Left  e -> error $ show e+      Right r -> r++casted :: IsoCastable a b => Iso' a b+casted = iso cast cast++converted :: IsoConvertible a b => Iso' a b+converted = iso convert convert++-- instances++instance {-# OVERLAPPABLE #-} Castable    a a where cast    = id ; {-# INLINE cast    #-}+instance {-# OVERLAPPABLE #-} Convertible a a where convert = id ; {-# INLINE convert #-}++instance {-# OVERLAPPABLE #-} Convertible a b => Convertible (Maybe a) (Maybe b) where convert = fmap convert ; {-# INLINE convert #-}+
+ src/Data/Convert/Bound.hs view
@@ -0,0 +1,165 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ViewPatterns #-}++module Data.Convert.Bound where++import Data.Convert.Base+import Data.Typeable+import Control.Applicative+import Language.Haskell.TH hiding (Type, Safety, Safe, Unsafe)+import Data.Monoid+import GHC.TypeLits+import Prelude hiding (Bounded, maxBound, minBound)+import qualified Prelude as Prelude+++++-- === The runtime used safe conversion ===++-- TODO [wd]: We can optimize it further. Right now we are converting everything to Rational and comparing.+--            It's because sometimes we are converting between types of different bounds like Char and Int8+--            - neither can we safely convert Char to Int 8 nor vice versa.+--            We can though make typeclasses that will find the smallest super-type for a given type pair+--            and convert both values to that super-type+boundedConversion :: (Bounded b, Ord a, Convertible a Rational, Convertible (Bounds b) (Bounds Rational))+                  => (a -> b) -> (a -> Either BoundError b)+boundedConversion (func :: a -> b) inp = if (convert inp) `boundedBy` (convert (bounds :: Bounds b) :: Bounds Rational)+    then Right $ func inp+    else Left BoundError+++++-- === Errors ===++data BoundError = BoundError deriving (Show)+++-- === Conversion ===++data Conversion = Conversion (Q Exp) Type Type++class Conversions a b where+    conversions :: Q Exp -> a -> b -> [Conversion]++-- utils++genConversion :: Conversion -> Q Dec+genConversion c@(Conversion qexp (Type name bounds) (Type name' bounds')) = do+    exp <- qexp :: Q Exp+    let convf name fmod = [ValD (VarP $ mkName name) (NormalB $ fmod exp) []]+    return $ if bounds `isSubBound` bounds'+        then InstanceD [] (AppT (AppT (ConT $ mkName "Convertible") (ConT name)) (ConT name')) $ convf "convert" id+        else InstanceD [] (AppT (AppT (AppT (ConT $ mkName "MaybeConvertible") (ConT name)) (ConT $ mkName "BoundError")) (ConT name')) $ convf "tryConvert" $ AppE (VarE $ mkName "boundedConversion")+++genConversions :: [Conversion] -> Q [Dec]+genConversions = mapM genConversion++-- instances++instance Conversions [Type] [Type] where conversions f a b = Conversion f <$> a <*> b+instance Conversions Type   [Type] where conversions f a b = Conversion f a <$> b+instance Conversions [Type] Type   where conversions f a b = flip (Conversion f) b <$> a+instance Conversions Type   Type   where conversions f a b = [Conversion f a b]++instance Show Conversion where+    show (Conversion _ a b) = "Conversion " -- <> " " <> name a <> " " <> name b+++++-- === Type ===++data Type = Type { name    :: Name+                 , tbounds :: (Bounds Integer)+                 } deriving (Show, Eq)++++-- === Layout ===+data Layout = IntLayout Sign Integer+            | InfiniteLayout+            deriving (Show, Eq)++data Sign = Signed+          | Unsigned+          deriving (Show, Eq)++layoutBounds :: Layout -> Bounds Integer+layoutBounds = \case+    InfiniteLayout -> infiniteBounds+    IntLayout s i  -> Bounds (Value (- base)) (Value $ base - 1)+                      where base = case s of+                                   Signed   -> 2 ^ (i - 1)+                                   Unsigned -> 2 ^ i++++-- === Value ===++data Value a = MinusInfinity+             | Value a+             | Infinity+             deriving (Show, Functor, Eq)++-- instances++instance Num a => Num (Value a) where+    fromInteger = Value . fromInteger++instance Convertible a b => Convertible (Value a) (Value b) where+    convert (Value a) = Value $ convert a++instance Ord a => Ord (Value a) where+    compare MinusInfinity MinusInfinity = EQ+    compare MinusInfinity a             = LT+    compare a             MinusInfinity = GT+    compare Infinity      Infinity      = EQ+    compare Infinity      a             = GT+    compare a             Infinity      = LT+    compare (Value a)     (Value a')    = compare a a'+++++-- === Bounds ===++data Bounds a = Bounds (Value a) (Value a) deriving (Show, Functor, Eq)++class Bounded a where+    bounds :: Bounds a++-- utils++infiniteBounds :: Bounds a+infiniteBounds = Bounds MinusInfinity Infinity++isSubBound :: Ord a => Bounds a -> Bounds a -> Bool+isSubBound (Bounds min max) (Bounds min' max') = min >= min' && max <= max'++boundedBy :: Ord a => a -> Bounds a -> Bool+boundedBy (Value -> a) (Bounds min max) = a >= min && a <= max++-- instances+instance {-# OVERLAPPABLE #-} Convertible a b => Convertible (Bounds a) (Bounds b) where+    convert (Bounds a b) = Bounds (convert a) (convert b)++instance {-# OVERLAPPABLE #-} (Prelude.Bounded a)+      => Bounded a where+    bounds = Bounds (Value Prelude.minBound) (Value Prelude.maxBound)++instance {-# OVERLAPPABLE #-} Bounded Float    where bounds = infiniteBounds+instance {-# OVERLAPPABLE #-} Bounded Double   where bounds = infiniteBounds+instance {-# OVERLAPPABLE #-} Bounded Rational where bounds = infiniteBounds+instance {-# OVERLAPPABLE #-} Bounded Integer  where bounds = infiniteBounds
+ src/Data/Convert/Errors.hs view
@@ -0,0 +1,6 @@+module Data.Convert.Errors where++import Prelude+import Data.Typeable++data TypeMismatch = TypeMismatch TypeRep TypeRep deriving (Show)
+ src/Data/Convert/Instances.hs view
@@ -0,0 +1,6 @@+module Data.Convert.Instances () where++import Data.Convert.Instances.Map     ()+import Data.Convert.Instances.Num     ()+import Data.Convert.Instances.Text    ()+import Data.Convert.Instances.TH      ()
+ src/Data/Convert/Instances/Map.hs view
@@ -0,0 +1,14 @@+module Data.Convert.Instances.Map()+where++import Prelude+import Data.Convert.Base++import qualified Data.Map as Map+++instance Ord k => Convertible [(k, a)] (Map.Map k a) where+    convert = Map.fromList++instance Convertible (Map.Map k a) [(k, a)] where+    convert = Map.toList
+ src/Data/Convert/Instances/Num.hs view
@@ -0,0 +1,68 @@+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TemplateHaskell #-}++module Data.Convert.Instances.Num where++import Prelude++import Data.Convert.Bound+import Data.Convert.Base+import Data.Monoid+import qualified Data.ByteString as BS+import GHC.Int+import Data.Word+import Data.Bits (shiftR)++intTypes   = [ Type ''Int      $ layoutBounds $ IntLayout Signed 30 -- according to: https://hackage.haskell.org/package/base-4.8.0.0/docs/Data-Int.html#t:Int+             , Type ''Integer  $ layoutBounds $ InfiniteLayout+             , Type ''Int8     $ layoutBounds $ IntLayout Signed 8+             , Type ''Int16    $ layoutBounds $ IntLayout Signed 16+             , Type ''Int32    $ layoutBounds $ IntLayout Signed 32+             , Type ''Int64    $ layoutBounds $ IntLayout Signed 64+             ]++wordTypes  = [ Type ''Word     $ layoutBounds $ IntLayout Signed 30 -- according to: https://hackage.haskell.org/package/base-4.8.0.0/docs/Data-Int.html#t:Int+             , Type ''Word8    $ layoutBounds $ IntLayout Signed 8+             , Type ''Word16   $ layoutBounds $ IntLayout Signed 16+             , Type ''Word32   $ layoutBounds $ IntLayout Signed 32+             , Type ''Word64   $ layoutBounds $ IntLayout Signed 64+             ]++floatTypes = [ Type ''Float    $ layoutBounds $ InfiniteLayout+             , Type ''Double   $ layoutBounds $ InfiniteLayout+             , Type ''Rational $ layoutBounds $ InfiniteLayout+             ]++charType = Type ''Char $ Bounds 0 1114111 -- max char enum is 1114111++integralTypes = intTypes <> wordTypes++-------------++instance Convertible ()                  [t] where convert _                            = []+instance Convertible (t,t)               [t] where convert (t1,t2)                      = [t1,t2]+instance Convertible (t,t,t)             [t] where convert (t1,t2,t3)                   = [t1,t2,t3]+instance Convertible (t,t,t,t)           [t] where convert (t1,t2,t3,t4)                = [t1,t2,t3,t4]+instance Convertible (t,t,t,t,t)         [t] where convert (t1,t2,t3,t4,t5)             = [t1,t2,t3,t4,t5]+instance Convertible (t,t,t,t,t,t)       [t] where convert (t1,t2,t3,t4,t5,t6)          = [t1,t2,t3,t4,t5,t6]+instance Convertible (t,t,t,t,t,t,t)     [t] where convert (t1,t2,t3,t4,t5,t6,t7)       = [t1,t2,t3,t4,t5,t6,t7]+instance Convertible (t,t,t,t,t,t,t,t)   [t] where convert (t1,t2,t3,t4,t5,t6,t7,t8)    = [t1,t2,t3,t4,t5,t6,t7,t8]+instance Convertible (t,t,t,t,t,t,t,t,t) [t] where convert (t1,t2,t3,t4,t5,t6,t7,t8,t9) = [t1,t2,t3,t4,t5,t6,t7,t8,t9]+++-- TODO: http://stackoverflow.com/questions/8350814/converting-64-bit-double-to-bytestring-efficiently+instance Convertible Word64 (Word8,Word8,Word8,Word8,Word8,Word8,Word8,Word8) where+    convert word = (unpack 56, unpack 48, unpack 40, unpack 32, unpack 24, unpack 16, unpack 8, unpack 0)+        where unpack = fromIntegral . shiftR word++-- ...++--------------++numConversions =  conversions [| fromIntegral            |] integralTypes (integralTypes <> floatTypes)+               <> conversions [| truncate                |] floatTypes    integralTypes+               <> conversions [| realToFrac              |] floatTypes    floatTypes+               <> conversions [| fromIntegral . fromEnum |] charType      (integralTypes <> floatTypes)+               <> conversions [| toEnum . fromIntegral   |] integralTypes charType
+ src/Data/Convert/Instances/TH.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE TemplateHaskell #-}++module Data.Convert.Instances.TH where++import Data.Convert.Base+import Data.Convert.Bound+import Data.Convert.Instances.Num (numConversions)+++genConversions numConversions
+ src/Data/Convert/Instances/Text.hs view
@@ -0,0 +1,221 @@+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE CPP #-}+++module Data.Convert.Instances.Text()+where++import Prelude++import Data.Convert.Base+import qualified Data.Text as TS+import qualified Data.Text.Encoding as TE+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Builder as TLB+import qualified Data.Text.Lazy.Encoding as TLE+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString.Builder as BB+import Data.Word (Word8)+import Data.Foldable++++instance Convertible TS.Text [Char] where+    {-# INLINE convert #-}+    convert = TS.unpack++instance Convertible TS.Text TL.Text where+    {-# INLINE convert #-}+    convert = TL.fromStrict++instance Convertible TS.Text TLB.Builder where+    {-# INLINE convert #-}+    convert = TLB.fromText++instance Convertible TS.Text BS.ByteString where+    {-# INLINE convert #-}+    convert = TE.encodeUtf8++instance Convertible TS.Text BL.ByteString where+    {-# INLINE convert #-}+    convert = BL.fromStrict . TE.encodeUtf8++instance Convertible TS.Text BB.Builder where+    {-# INLINE convert #-}+-- FIXME: doesnt work on OSX+-- #if MIN_VERSION_text(1,2,0)+    convert = TE.encodeUtf8Builder+-- #else+--     convert = convert . TE.encodeUtf8+-- #endif++++instance Convertible TL.Text [Char] where+    {-# INLINE convert #-}+    convert = TL.unpack++instance Convertible TL.Text TS.Text where+    {-# INLINE convert #-}+    convert = TL.toStrict++instance Convertible TL.Text TLB.Builder where+    {-# INLINE convert #-}+    convert = TLB.fromLazyText++instance Convertible TL.Text BS.ByteString where+    {-# INLINE convert #-}+    convert = convert . TLE.encodeUtf8++instance Convertible TL.Text BL.ByteString where+    {-# INLINE convert #-}+    convert = TLE.encodeUtf8++instance Convertible TL.Text BB.Builder where+    {-# INLINE convert #-}+-- FIXME: doesnt work on OSX+-- #if MIN_VERSION_text(1,2,0)+    convert = TLE.encodeUtf8Builder+-- #else+--     convert = convert . TLE.encodeUtf8+-- #endif++++instance Convertible TLB.Builder [Char] where+    {-# INLINE convert #-}+    convert = convert . TLB.toLazyText++instance Convertible TLB.Builder TS.Text where+    {-# INLINE convert #-}+    convert = convert . TLB.toLazyText++instance Convertible TLB.Builder TL.Text where+    {-# INLINE convert #-}+    convert = TLB.toLazyText++instance Convertible TLB.Builder BS.ByteString where+    {-# INLINE convert #-}+    convert = convert . TLB.toLazyText++instance Convertible TLB.Builder BL.ByteString where+    {-# INLINE convert #-}+    convert = convert . TLB.toLazyText++instance Convertible TLB.Builder BB.Builder where+    {-# INLINE convert #-}+    convert = convert . TLB.toLazyText++++instance Convertible BS.ByteString [Word8] where+    {-# INLINE convert #-}+    convert = BS.unpack++instance Convertible BS.ByteString TS.Text where+    {-# INLINE convert #-}+    convert = TE.decodeUtf8++instance Convertible BS.ByteString TL.Text where+    {-# INLINE convert #-}+    convert = TL.fromStrict . convert++instance Convertible BS.ByteString TLB.Builder where+    {-# INLINE convert #-}+    convert = TLB.fromText . convert++instance Convertible BS.ByteString BL.ByteString where+    {-# INLINE convert #-}+    convert = BL.fromStrict++instance Convertible BS.ByteString BB.Builder where+    {-# INLINE convert #-}+    convert = BB.byteString++++instance Convertible BL.ByteString [Word8] where+    {-# INLINE convert #-}+    convert = BL.unpack++instance Convertible BL.ByteString TS.Text where+    {-# INLINE convert #-}+    convert = TL.toStrict . convert++instance Convertible BL.ByteString TL.Text where+    {-# INLINE convert #-}+    convert = TLE.decodeUtf8++instance Convertible BL.ByteString TLB.Builder where+    {-# INLINE convert #-}+    convert = TLB.fromLazyText . convert++instance Convertible BL.ByteString BS.ByteString where+    {-# INLINE convert #-}+    convert = BL.toStrict++instance Convertible BL.ByteString BB.Builder where+    {-# INLINE convert #-}+    convert = BB.lazyByteString++++instance Convertible [Char] TS.Text where+    {-# INLINE convert #-}+    convert = TS.pack++instance Convertible [Char] TL.Text where+    {-# INLINE convert #-}+    convert = TL.pack++instance Convertible [Char] TLB.Builder where+    {-# INLINE convert #-}+    convert = TLB.fromString++++instance Convertible [Word8] BS.ByteString where+    {-# INLINE convert #-}+    convert = BS.pack++instance Convertible [Word8] BL.ByteString where+    {-# INLINE convert #-}+    convert = BL.pack++instance Convertible [Word8] BB.Builder where+    {-# INLINE convert #-}+    convert = foldMap BB.word8++++instance Convertible Char TS.Text where+    {-# INLINE convert #-}+    convert = TS.singleton++instance Convertible Char TL.Text where+    {-# INLINE convert #-}+    convert = TL.singleton++instance Convertible Char TLB.Builder where+    {-# INLINE convert #-}+    convert = TLB.singleton++++instance Convertible Word8 BS.ByteString where+    {-# INLINE convert #-}+    convert = BS.singleton++instance Convertible Word8 BL.ByteString where+    {-# INLINE convert #-}+    convert = BL.singleton++instance Convertible Word8 BB.Builder where+    {-# INLINE convert #-}+    convert = BB.word8