conversions (empty) → 0.0.2
raw patch · 4 files changed
+371/−0 lines, 4 filesdep +basedep +bytestringdep +control-bool
Dependencies added: base, bytestring, control-bool, conversions, devtools, exceptions, mtl, source-constraints, template-haskell, text, unliftio-core
Files
- conversions.cabal +78/−0
- src/Data/Conversions.hs +255/−0
- src/Data/Conversions/FromType.hs +27/−0
- test/Test.hs +11/−0
+ conversions.cabal view
@@ -0,0 +1,78 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.33.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: 34a788b41cd0ff6e77f9045d78ad27d946fd81ab9ce667cbb1bb61ec652e0ef5++name: conversions+version: 0.0.2+synopsis: Injective explicit total and partial conversions+homepage: https://github.com/mbj/conversions#readme+bug-reports: https://github.com/mbj/conversions/issues+maintainer: Markus Schirp mbj@schirp-ds.com, Allan Lukwago <epicallan.al@gmail.com>+copyright: 2020 Strainge Inc.+license: MIT+build-type: Simple++source-repository head+ type: git+ location: https://github.com/mbj/conversions++flag development+ description: Run GHC with development flags+ manual: True+ default: False++library+ exposed-modules:+ Data.Conversions+ Data.Conversions.FromType+ other-modules:+ Paths_conversions+ hs-source-dirs:+ src+ default-extensions: AllowAmbiguousTypes ConstraintKinds DataKinds DerivingStrategies DerivingVia DuplicateRecordFields FlexibleContexts FlexibleInstances ExistentialQuantification KindSignatures LambdaCase MultiParamTypeClasses NoImplicitPrelude OverloadedLists OverloadedStrings PolyKinds ScopedTypeVariables StrictData TupleSections TypeApplications TypeFamilies TypeOperators+ ghc-options: -Wall -Wcompat -Widentities -Wimplicit-prelude -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-local-signatures -Wmissing-signatures -Wmonomorphism-restriction -Wredundant-constraints -fhide-source-paths -fplugin=SourceConstraints -funbox-strict-fields -optP-Wno-nonportable-include-path+ build-depends:+ base >4.12 && <4.15+ , bytestring >=0.10 && <0.11+ , control-bool >=0.2 && <0.3+ , devtools >=0.0.2 && <0.1+ , exceptions >=0.10 && <0.11+ , mtl >=2.2 && <2.3+ , source-constraints >=0.0.1 && <0.1+ , template-haskell >=2.15 && <2.16+ , text >=1.2 && <1.3+ , unliftio-core >=0.1 && <0.2+ if flag(development)+ ghc-options: -Werror+ else+ ghc-options: -Wwarn+ default-language: Haskell2010++test-suite test+ type: exitcode-stdio-1.0+ main-is: test/Test.hs+ other-modules:+ Paths_conversions+ default-extensions: AllowAmbiguousTypes ConstraintKinds DataKinds DerivingStrategies DerivingVia DuplicateRecordFields FlexibleContexts FlexibleInstances ExistentialQuantification KindSignatures LambdaCase MultiParamTypeClasses NoImplicitPrelude OverloadedLists OverloadedStrings PolyKinds ScopedTypeVariables StrictData TupleSections TypeApplications TypeFamilies TypeOperators+ ghc-options: -Wall -Wcompat -Widentities -Wimplicit-prelude -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-local-signatures -Wmissing-signatures -Wmonomorphism-restriction -Wredundant-constraints -fhide-source-paths -fplugin=SourceConstraints -funbox-strict-fields -optP-Wno-nonportable-include-path -rtsopts -threaded -with-rtsopts=-N+ build-depends:+ base >4.12 && <4.15+ , bytestring >=0.10 && <0.11+ , control-bool >=0.2 && <0.3+ , conversions+ , devtools >=0.0.2 && <0.1+ , exceptions >=0.10 && <0.11+ , mtl >=2.2 && <2.3+ , source-constraints >=0.0.1 && <0.1+ , template-haskell >=2.15 && <2.16+ , text >=1.2 && <1.3+ , unliftio-core >=0.1 && <0.2+ if flag(development)+ ghc-options: -Werror+ else+ ghc-options: -Wwarn+ default-language: Haskell2010
+ src/Data/Conversions.hs view
@@ -0,0 +1,255 @@+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE UndecidableInstances #-}+module Data.Conversions where++import Control.Applicative+import Control.Bool ( guard' )+import Control.Exception ( Exception )+import Control.Monad ( MonadPlus(..) )+import Control.Monad.Catch ( MonadThrow+ , throwM+ )+import Control.Monad.Except ( MonadError+ , throwError+ )+import Data.Coerce ( Coercible+ , coerce+ )+import Data.Int ( Int16+ , Int32+ , Int64+ , Int8+ )+import Data.Text ( Text )+import Data.Typeable ( Typeable )+import Data.Word ( Word16+ , Word32+ , Word64+ , Word8+ )+import Numeric.Natural ( Natural )+import Prelude hiding ( max+ , min+ )++import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Text as Text+import qualified Data.Text.Encoding as Text+import qualified Data.Text.Lazy as Text.Lazy+import qualified GHC.Show as Show+import qualified Language.Haskell.TH.Syntax as TH++data BoundError a b = (Bounded b, Show a, Show b) => BoundError a++instance Show.Show (BoundError a b) where+ show (BoundError value) = boundError value (minBound @b) (maxBound @b)++instance (Typeable a, Typeable b) => Exception (BoundError a b)++data UserBoundError a b = UserBoundError a b b+ deriving stock (Typeable)++instance (Show a, Show b) => Show.Show (UserBoundError a b) where+ show (UserBoundError value min max) = boundError value min max++instance (Show a, Show b, Typeable a, Typeable b) => Exception (UserBoundError a b)++class Conversion b a where+ convert :: a -> b++ default convert :: (Coercible a b) => a -> b+ convert = coerce++instance (MonadError (UserBoundError Int Natural) m) => Conversion (m Natural) Int where+ convert = convertErrorFromIntegral++instance (MonadError (UserBoundError Int64 Natural) m) => Conversion (m Natural) Int64 where+ convert = convertErrorFromIntegral++instance (MonadError (UserBoundError Int32 Natural) m) => Conversion (m Natural) Int32 where+ convert = convertErrorFromIntegral++instance (MonadError (UserBoundError Int16 Natural) m) => Conversion (m Natural) Int16 where+ convert = convertErrorFromIntegral++instance (MonadError (UserBoundError Int8 Natural) m) => Conversion (m Natural) Int8 where+ convert = convertErrorFromIntegral++instance (MonadError (UserBoundError Word Natural) m) => Conversion (m Natural) Word where+ convert = convertErrorFromIntegral++instance (MonadError (UserBoundError Word64 Natural) m) => Conversion (m Natural) Word64 where+ convert = convertErrorFromIntegral++instance (MonadError (UserBoundError Word32 Natural) m) => Conversion (m Natural) Word32 where+ convert = convertErrorFromIntegral++instance (MonadError (UserBoundError Word16 Natural) m) => Conversion (m Natural) Word16 where+ convert = convertErrorFromIntegral++instance (MonadError (UserBoundError Integer Text) m) => Conversion (m Natural) Integer where+ convert value = maybe (throwError $ UserBoundError value "0" "Natural") pure+ $ checkedFromIntegral value++instance (MonadError (UserBoundError Natural Int) m) => Conversion (m Int) Natural where+ convert = convertErrorFromNatural++instance (MonadError (UserBoundError Natural Int16) m) => Conversion (m Int16) Natural where+ convert = convertErrorFromNatural++instance (MonadError (UserBoundError Natural Int32) m) => Conversion (m Int32) Natural where+ convert = convertErrorFromNatural++instance (MonadError (UserBoundError Natural Int64) m) => Conversion (m Int64) Natural where+ convert = convertErrorFromNatural++instance Conversion a a where+ convert = id++instance Conversion Integer Int where+ convert = fromIntegral++instance Conversion Integer Word32 where+ convert = fromIntegral++instance Conversion Integer Word16 where+ convert = fromIntegral++instance Conversion Integer Word8 where+ convert = fromIntegral++instance Conversion Natural Word32 where+ convert = fromIntegral++instance Conversion Natural Word16 where+ convert = fromIntegral++instance Conversion Natural Word8 where+ convert = fromIntegral++instance Conversion Integer Natural where+ convert = fromIntegral++instance (MonadError (BoundError Integer Int) m) => Conversion (m Int) Integer where+ convert = convertBoundedFromIntegral++instance (MonadError (BoundError Integer Word32) m) => Conversion (m Word32) Integer where+ convert = convertBoundedFromIntegral++instance (MonadError (BoundError Integer Word16) m) => Conversion (m Word16) Integer where+ convert = convertBoundedFromIntegral++instance (MonadError (BoundError Integer Word8) m) => Conversion (m Word8) Integer where+ convert = convertBoundedFromIntegral++instance Conversion LBS.ByteString BS.ByteString where+ convert = LBS.fromStrict++instance Conversion BS.ByteString LBS.ByteString where+ convert = LBS.toStrict++instance Conversion BS.ByteString Text where+ convert = Text.encodeUtf8++instance Conversion Text.Lazy.Text Text where+ convert = Text.Lazy.fromStrict++instance Conversion Text Text.Lazy.Text where+ convert = Text.Lazy.toStrict++instance Conversion Text String where+ convert = Text.pack++instance Conversion String Text where+ convert = Text.unpack++type ToText a = Conversion Text a++convertErrorFromNatural+ :: forall a m+ . (Integral a, Bounded a, MonadError (UserBoundError Natural a) m)+ => Natural+ -> m a+convertErrorFromNatural value =+ maybe (throwError $ UserBoundError value minBound maxBound) pure+ $ checkedFromIntegral value++convertErrorFromIntegral+ :: forall a m+ . (Integral a, Bounded a, MonadError (UserBoundError a Natural) m)+ => a+ -> m Natural+convertErrorFromIntegral value =+ maybe (throwError $ UserBoundError value 0 maxBound') pure+ $ checkedFromIntegral value+ where+ maxBound' :: Natural+ maxBound' = fromIntegral $ maxBound @a++convertBoundedFromIntegral+ :: forall a b m+ . ( Integral a+ , Show a+ , Show b+ , Num b+ , Bounded b+ , Conversion a b+ , MonadError (BoundError a b) m+ )+ => a+ -> m b+convertBoundedFromIntegral value =+ if convert (minBound @b) <= value && value <= convert (maxBound @b)+ then pure $ fromIntegral value+ else throwError $ BoundError value++checkedFromIntegral+ :: forall a b m . (MonadPlus m, Integral a, Integral b) => a -> m b+checkedFromIntegral value = guard' (fromIntegral converted == value) converted+ where+ converted :: b+ converted = fromIntegral value++convertEither :: forall b a e . (Conversion (Either e b) a) => a -> Either e b+convertEither = convert++convertUnsafe :: forall b a e . (Conversion (Either e b) a, Show e) => a -> b+convertUnsafe = either (error . show) id . convertEither @b @a @e++convertThrow+ :: forall b a e m+ . (Conversion (Either e b) a, Exception e, MonadThrow m)+ => a+ -> m b+convertThrow = either throwM pure . convertEither @b @a @e++convertFail+ :: forall b a e m+ . (Conversion (Either e b) a, Show e, MonadFail m)+ => a+ -> m b+convertFail = either (fail . show) pure . convertEither @b @a @e++convertMaybe :: forall b a e . (Conversion (Either e b) a) => a -> Maybe b+convertMaybe = either (const empty) pure . convertEither @b @a @e++boundError :: forall a b . (Show a, Show b) => a -> b -> b -> String+boundError value min max =+ "Value should be between "+ <> show min+ <> " and "+ <> show max+ <> " but was "+ <> show value++mkTH+ :: forall a b e+ . (TH.Lift b, Exception e, Conversion (Either e b) a)+ => a+ -> TH.Q (TH.TExp b)+mkTH input =+ TH.TExp <$> either (fail . show) (TH.lift @b) (convertThrow @b @a @e input)++toText :: ToText a => a -> Text+toText = convert
+ src/Data/Conversions/FromType.hs view
@@ -0,0 +1,27 @@+-- | Conversions from type-level values+--+module Data.Conversions.FromType where++import Data.Conversions+import Data.Kind ( Type )+import Data.Proxy ( Proxy(..) )+import Data.Text ( Text )+import GHC.TypeLits hiding ( natVal )+import GHC.TypeNats ( natVal )+import Numeric.Natural ( Natural )+import Prelude++class FromType a (b :: Type) where+ fromType :: b++-- These instances are not polymorphic in the last parameter so to+-- avoid over-lapping instances+--+instance (KnownNat nat) => FromType nat Natural where+ fromType = natVal (Proxy @nat)++instance (KnownSymbol symbol) => FromType symbol String where+ fromType = symbolVal (Proxy @symbol)++instance (KnownSymbol symbol) => FromType symbol Text where+ fromType = convert @Text @String $ fromType @symbol
+ test/Test.hs view
@@ -0,0 +1,11 @@+module Main+ ( main+ )+where++import System.IO ( IO )++import qualified Devtools++main :: IO ()+main = Devtools.main Devtools.defaultConfig