{-# 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 a b -> String show (BoundError a value) = a -> b -> b -> String forall a b. (Show a, Show b) => a -> b -> b -> String boundError a value (Bounded b => b forall a. Bounded a => a minBound @b) (Bounded b => b forall a. Bounded a => a 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 a b -> String show (UserBoundError a value b min b max) = a -> b -> b -> String forall a b. (Show a, Show b) => a -> b -> b -> String boundError a value b min b 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 = a -> b coerce instance (MonadError (UserBoundError Int Natural) m) => Conversion (m Natural) Int where convert :: Int -> m Natural convert = Int -> m Natural forall a (m :: * -> *). (Integral a, Bounded a, MonadError (UserBoundError a Natural) m) => a -> m Natural convertErrorFromIntegral instance (MonadError (UserBoundError Int64 Natural) m) => Conversion (m Natural) Int64 where convert :: Int64 -> m Natural convert = Int64 -> m Natural forall a (m :: * -> *). (Integral a, Bounded a, MonadError (UserBoundError a Natural) m) => a -> m Natural convertErrorFromIntegral instance (MonadError (UserBoundError Int32 Natural) m) => Conversion (m Natural) Int32 where convert :: Int32 -> m Natural convert = Int32 -> m Natural forall a (m :: * -> *). (Integral a, Bounded a, MonadError (UserBoundError a Natural) m) => a -> m Natural convertErrorFromIntegral instance (MonadError (UserBoundError Int16 Natural) m) => Conversion (m Natural) Int16 where convert :: Int16 -> m Natural convert = Int16 -> m Natural forall a (m :: * -> *). (Integral a, Bounded a, MonadError (UserBoundError a Natural) m) => a -> m Natural convertErrorFromIntegral instance (MonadError (UserBoundError Int8 Natural) m) => Conversion (m Natural) Int8 where convert :: Int8 -> m Natural convert = Int8 -> m Natural forall a (m :: * -> *). (Integral a, Bounded a, MonadError (UserBoundError a Natural) m) => a -> m Natural convertErrorFromIntegral instance (MonadError (UserBoundError Word Natural) m) => Conversion (m Natural) Word where convert :: Word -> m Natural convert = Word -> m Natural forall a (m :: * -> *). (Integral a, Bounded a, MonadError (UserBoundError a Natural) m) => a -> m Natural convertErrorFromIntegral instance (MonadError (UserBoundError Word64 Natural) m) => Conversion (m Natural) Word64 where convert :: Word64 -> m Natural convert = Word64 -> m Natural forall a (m :: * -> *). (Integral a, Bounded a, MonadError (UserBoundError a Natural) m) => a -> m Natural convertErrorFromIntegral instance (MonadError (UserBoundError Word32 Natural) m) => Conversion (m Natural) Word32 where convert :: Word32 -> m Natural convert = Word32 -> m Natural forall a (m :: * -> *). (Integral a, Bounded a, MonadError (UserBoundError a Natural) m) => a -> m Natural convertErrorFromIntegral instance (MonadError (UserBoundError Word16 Natural) m) => Conversion (m Natural) Word16 where convert :: Word16 -> m Natural convert = Word16 -> m Natural forall a (m :: * -> *). (Integral a, Bounded a, MonadError (UserBoundError a Natural) m) => a -> m Natural convertErrorFromIntegral instance (MonadError (UserBoundError Integer Text) m) => Conversion (m Natural) Integer where convert :: Integer -> m Natural convert Integer value = m Natural -> (Natural -> m Natural) -> Maybe Natural -> m Natural forall b a. b -> (a -> b) -> Maybe a -> b maybe (UserBoundError Integer Text -> m Natural forall e (m :: * -> *) a. MonadError e m => e -> m a throwError (UserBoundError Integer Text -> m Natural) -> UserBoundError Integer Text -> m Natural forall a b. (a -> b) -> a -> b $ Integer -> Text -> Text -> UserBoundError Integer Text forall a b. a -> b -> b -> UserBoundError a b UserBoundError Integer value Text "0" Text "Natural") Natural -> m Natural forall (f :: * -> *) a. Applicative f => a -> f a pure (Maybe Natural -> m Natural) -> Maybe Natural -> m Natural forall a b. (a -> b) -> a -> b $ Integer -> Maybe Natural forall a b (m :: * -> *). (MonadPlus m, Integral a, Integral b) => a -> m b checkedFromIntegral Integer value instance (MonadError (UserBoundError Natural Int) m) => Conversion (m Int) Natural where convert :: Natural -> m Int convert = Natural -> m Int forall a (m :: * -> *). (Integral a, Bounded a, MonadError (UserBoundError Natural a) m) => Natural -> m a convertErrorFromNatural instance (MonadError (UserBoundError Natural Int16) m) => Conversion (m Int16) Natural where convert :: Natural -> m Int16 convert = Natural -> m Int16 forall a (m :: * -> *). (Integral a, Bounded a, MonadError (UserBoundError Natural a) m) => Natural -> m a convertErrorFromNatural instance (MonadError (UserBoundError Natural Int32) m) => Conversion (m Int32) Natural where convert :: Natural -> m Int32 convert = Natural -> m Int32 forall a (m :: * -> *). (Integral a, Bounded a, MonadError (UserBoundError Natural a) m) => Natural -> m a convertErrorFromNatural instance (MonadError (UserBoundError Natural Int64) m) => Conversion (m Int64) Natural where convert :: Natural -> m Int64 convert = Natural -> m Int64 forall a (m :: * -> *). (Integral a, Bounded a, MonadError (UserBoundError Natural a) m) => Natural -> m a convertErrorFromNatural instance Conversion a a where convert :: a -> a convert = a -> a forall a. a -> a id instance Conversion Integer Int where convert :: Int -> Integer convert = Int -> Integer forall a b. (Integral a, Num b) => a -> b fromIntegral instance Conversion Integer Word32 where convert :: Word32 -> Integer convert = Word32 -> Integer forall a b. (Integral a, Num b) => a -> b fromIntegral instance Conversion Integer Word16 where convert :: Word16 -> Integer convert = Word16 -> Integer forall a b. (Integral a, Num b) => a -> b fromIntegral instance Conversion Integer Word8 where convert :: Word8 -> Integer convert = Word8 -> Integer forall a b. (Integral a, Num b) => a -> b fromIntegral instance Conversion Natural Word32 where convert :: Word32 -> Natural convert = Word32 -> Natural forall a b. (Integral a, Num b) => a -> b fromIntegral instance Conversion Natural Word16 where convert :: Word16 -> Natural convert = Word16 -> Natural forall a b. (Integral a, Num b) => a -> b fromIntegral instance Conversion Natural Word8 where convert :: Word8 -> Natural convert = Word8 -> Natural forall a b. (Integral a, Num b) => a -> b fromIntegral instance Conversion Integer Natural where convert :: Natural -> Integer convert = Natural -> Integer forall a b. (Integral a, Num b) => a -> b fromIntegral instance (MonadError (BoundError Integer Int) m) => Conversion (m Int) Integer where convert :: Integer -> m Int convert = Integer -> m Int 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 instance (MonadError (BoundError Integer Word32) m) => Conversion (m Word32) Integer where convert :: Integer -> m Word32 convert = Integer -> m Word32 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 instance (MonadError (BoundError Integer Word16) m) => Conversion (m Word16) Integer where convert :: Integer -> m Word16 convert = Integer -> m Word16 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 instance (MonadError (BoundError Integer Word8) m) => Conversion (m Word8) Integer where convert :: Integer -> m Word8 convert = Integer -> m Word8 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 instance Conversion LBS.ByteString BS.ByteString where convert :: ByteString -> ByteString convert = ByteString -> ByteString LBS.fromStrict instance Conversion BS.ByteString LBS.ByteString where convert :: ByteString -> ByteString convert = ByteString -> ByteString LBS.toStrict instance Conversion BS.ByteString Text where convert :: Text -> ByteString convert = Text -> ByteString Text.encodeUtf8 instance Conversion Text.Lazy.Text Text where convert :: Text -> Text convert = Text -> Text Text.Lazy.fromStrict instance Conversion Text Text.Lazy.Text where convert :: Text -> Text convert = Text -> Text Text.Lazy.toStrict instance Conversion Text String where convert :: String -> Text convert = String -> Text Text.pack instance Conversion String Text where convert :: Text -> String convert = Text -> String Text.unpack type ToText a = Conversion Text a convertText :: forall a b . (Conversion Text a, Conversion b Text) => a -> b convertText :: a -> b convertText = forall a. Conversion b a => a -> b forall b a. Conversion b a => a -> b convert @b (Text -> b) -> (a -> Text) -> a -> b forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. Conversion Text a => a -> Text forall b a. Conversion b a => a -> b convert @Text convertErrorFromNatural :: forall a m . (Integral a, Bounded a, MonadError (UserBoundError Natural a) m) => Natural -> m a convertErrorFromNatural :: Natural -> m a convertErrorFromNatural Natural value = m a -> (a -> m a) -> Maybe a -> m a forall b a. b -> (a -> b) -> Maybe a -> b maybe (UserBoundError Natural a -> m a forall e (m :: * -> *) a. MonadError e m => e -> m a throwError (UserBoundError Natural a -> m a) -> UserBoundError Natural a -> m a forall a b. (a -> b) -> a -> b $ Natural -> a -> a -> UserBoundError Natural a forall a b. a -> b -> b -> UserBoundError a b UserBoundError Natural value a forall a. Bounded a => a minBound a forall a. Bounded a => a maxBound) a -> m a forall (f :: * -> *) a. Applicative f => a -> f a pure (Maybe a -> m a) -> Maybe a -> m a forall a b. (a -> b) -> a -> b $ Natural -> Maybe a forall a b (m :: * -> *). (MonadPlus m, Integral a, Integral b) => a -> m b checkedFromIntegral Natural value convertErrorFromIntegral :: forall a m . (Integral a, Bounded a, MonadError (UserBoundError a Natural) m) => a -> m Natural convertErrorFromIntegral :: a -> m Natural convertErrorFromIntegral a value = m Natural -> (Natural -> m Natural) -> Maybe Natural -> m Natural forall b a. b -> (a -> b) -> Maybe a -> b maybe (UserBoundError a Natural -> m Natural forall e (m :: * -> *) a. MonadError e m => e -> m a throwError (UserBoundError a Natural -> m Natural) -> UserBoundError a Natural -> m Natural forall a b. (a -> b) -> a -> b $ a -> Natural -> Natural -> UserBoundError a Natural forall a b. a -> b -> b -> UserBoundError a b UserBoundError a value Natural 0 Natural maxBound') Natural -> m Natural forall (f :: * -> *) a. Applicative f => a -> f a pure (Maybe Natural -> m Natural) -> Maybe Natural -> m Natural forall a b. (a -> b) -> a -> b $ a -> Maybe Natural forall a b (m :: * -> *). (MonadPlus m, Integral a, Integral b) => a -> m b checkedFromIntegral a value where maxBound' :: Natural maxBound' :: Natural maxBound' = a -> Natural forall a b. (Integral a, Num b) => a -> b fromIntegral (a -> Natural) -> a -> Natural forall a b. (a -> b) -> a -> b $ Bounded a => a forall a. Bounded a => a 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 :: a -> m b convertBoundedFromIntegral a value = if b -> a forall b a. Conversion b a => a -> b convert (Bounded b => b forall a. Bounded a => a minBound @b) a -> a -> Bool forall a. Ord a => a -> a -> Bool <= a value Bool -> Bool -> Bool && a value a -> a -> Bool forall a. Ord a => a -> a -> Bool <= b -> a forall b a. Conversion b a => a -> b convert (Bounded b => b forall a. Bounded a => a maxBound @b) then b -> m b forall (f :: * -> *) a. Applicative f => a -> f a pure (b -> m b) -> b -> m b forall a b. (a -> b) -> a -> b $ a -> b forall a b. (Integral a, Num b) => a -> b fromIntegral a value else BoundError a b -> m b forall e (m :: * -> *) a. MonadError e m => e -> m a throwError (BoundError a b -> m b) -> BoundError a b -> m b forall a b. (a -> b) -> a -> b $ a -> BoundError a b forall a b. (Bounded b, Show a, Show b) => a -> BoundError a b BoundError a value checkedFromIntegral :: forall a b m . (MonadPlus m, Integral a, Integral b) => a -> m b checkedFromIntegral :: a -> m b checkedFromIntegral a value = Bool -> b -> m b forall (m :: * -> *) a. MonadPlus m => Bool -> a -> m a guard' (b -> a forall a b. (Integral a, Num b) => a -> b fromIntegral b converted a -> a -> Bool forall a. Eq a => a -> a -> Bool == a value) b converted where converted :: b converted :: b converted = a -> b forall a b. (Integral a, Num b) => a -> b fromIntegral a value convertEither :: forall b a e . (Conversion (Either e b) a) => a -> Either e b convertEither :: a -> Either e b convertEither = a -> Either e b forall b a. Conversion b a => a -> b convert convertUnsafe :: forall b a e . (Conversion (Either e b) a, Show e) => a -> b convertUnsafe :: a -> b convertUnsafe = (e -> b) -> (b -> b) -> Either e b -> b forall a c b. (a -> c) -> (b -> c) -> Either a b -> c either (String -> b forall a. HasCallStack => String -> a error (String -> b) -> (e -> String) -> e -> b forall b c a. (b -> c) -> (a -> b) -> a -> c . e -> String forall a. Show a => a -> String show) b -> b forall a. a -> a id (Either e b -> b) -> (a -> Either e b) -> a -> b forall b c a. (b -> c) -> (a -> b) -> a -> c . Conversion (Either e b) a => a -> Either e b forall b a e. Conversion (Either e b) a => a -> Either e b convertEither @b @a @e convertThrow :: forall b a e m . (Conversion (Either e b) a, Exception e, MonadThrow m) => a -> m b convertThrow :: a -> m b convertThrow = (e -> m b) -> (b -> m b) -> Either e b -> m b forall a c b. (a -> c) -> (b -> c) -> Either a b -> c either e -> m b forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a throwM b -> m b forall (f :: * -> *) a. Applicative f => a -> f a pure (Either e b -> m b) -> (a -> Either e b) -> a -> m b forall b c a. (b -> c) -> (a -> b) -> a -> c . Conversion (Either e b) a => a -> Either e b forall b a e. Conversion (Either e b) a => a -> Either e b convertEither @b @a @e convertFail :: forall b a e m . (Conversion (Either e b) a, Show e, MonadFail m) => a -> m b convertFail :: a -> m b convertFail = (e -> m b) -> (b -> m b) -> Either e b -> m b forall a c b. (a -> c) -> (b -> c) -> Either a b -> c either (String -> m b forall (m :: * -> *) a. MonadFail m => String -> m a fail (String -> m b) -> (e -> String) -> e -> m b forall b c a. (b -> c) -> (a -> b) -> a -> c . e -> String forall a. Show a => a -> String show) b -> m b forall (f :: * -> *) a. Applicative f => a -> f a pure (Either e b -> m b) -> (a -> Either e b) -> a -> m b forall b c a. (b -> c) -> (a -> b) -> a -> c . Conversion (Either e b) a => a -> Either e b forall b a e. Conversion (Either e b) a => a -> Either e b convertEither @b @a @e convertMaybe :: forall b a e . (Conversion (Either e b) a) => a -> Maybe b convertMaybe :: a -> Maybe b convertMaybe = (e -> Maybe b) -> (b -> Maybe b) -> Either e b -> Maybe b forall a c b. (a -> c) -> (b -> c) -> Either a b -> c either (Maybe b -> e -> Maybe b forall a b. a -> b -> a const Maybe b forall (f :: * -> *) a. Alternative f => f a empty) b -> Maybe b forall (f :: * -> *) a. Applicative f => a -> f a pure (Either e b -> Maybe b) -> (a -> Either e b) -> a -> Maybe b forall b c a. (b -> c) -> (a -> b) -> a -> c . Conversion (Either e b) a => a -> Either e b forall b a e. Conversion (Either e b) a => a -> Either e b convertEither @b @a @e boundError :: forall a b . (Show a, Show b) => a -> b -> b -> String boundError :: a -> b -> b -> String boundError a value b min b max = String "Value should be between " String -> ShowS forall a. Semigroup a => a -> a -> a <> b -> String forall a. Show a => a -> String show b min String -> ShowS forall a. Semigroup a => a -> a -> a <> String " and " String -> ShowS forall a. Semigroup a => a -> a -> a <> b -> String forall a. Show a => a -> String show b max String -> ShowS forall a. Semigroup a => a -> a -> a <> String " but was " String -> ShowS forall a. Semigroup a => a -> a -> a <> a -> String forall a. Show a => a -> String show a value mkTH :: forall a b e . (TH.Lift b, Exception e, Conversion (Either e b) a) => a -> TH.Q (TH.TExp b) mkTH :: a -> Q (TExp b) mkTH a input = Exp -> TExp b forall a. Exp -> TExp a TH.TExp (Exp -> TExp b) -> Q Exp -> Q (TExp b) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (SomeException -> Q Exp) -> (b -> Q Exp) -> Either SomeException b -> Q Exp forall a c b. (a -> c) -> (b -> c) -> Either a b -> c either (String -> Q Exp forall (m :: * -> *) a. MonadFail m => String -> m a fail (String -> Q Exp) -> (SomeException -> String) -> SomeException -> Q Exp forall b c a. (b -> c) -> (a -> b) -> a -> c . SomeException -> String forall a. Show a => a -> String show) b -> Q Exp forall t. Lift t => t -> Q Exp TH.lift (a -> Either SomeException b forall b a e (m :: * -> *). (Conversion (Either e b) a, Exception e, MonadThrow m) => a -> m b convertThrow @b @a @e a input) toText :: ToText a => a -> Text toText :: a -> Text toText = a -> Text forall b a. Conversion b a => a -> b convert