{-# LANGUAGE
DefaultSignatures,
MultiParamTypeClasses,
FlexibleInstances,
FlexibleContexts,
TypeFamilies,
ScopedTypeVariables,
DataKinds,
TypeOperators,
UndecidableInstances
#-}
module Inj.Base () where
import GHC.TypeLits
import Control.Applicative
import Control.Exception hiding (TypeError)
import Control.Monad.ST
import Data.Complex
import Data.Fixed
import Data.Functor.Compose
import Data.Functor.Identity
import Data.Int
import Data.List.NonEmpty
import Data.Monoid
import Data.Ord
import Data.Proxy
import Data.Semigroup
import Data.Word
import Foreign.Ptr
import GHC.Conc
import GHC.Generics
import GHC.Real
import Numeric.Natural
import Text.ParserCombinators.ReadP
import Text.ParserCombinators.ReadPrec
import Inj
instance Integral p => Inj p Integer where
inj = toInteger
instance Integral p => Inj p Natural where
inj = fromIntegral
fromIntegralBounded ::
forall p a. (Integral a, Bounded a) => Integral p => p -> a
fromIntegralBounded p
| p' < toInteger (minBound :: a) = throw Underflow
| p' > toInteger (maxBound :: a) = throw Overflow
| otherwise = fromInteger p'
where
p' = toInteger p
instance Integral p => Inj p Int where
inj = fromIntegralBounded
instance Integral p => Inj p Int8 where
inj = fromIntegralBounded
instance Integral p => Inj p Int16 where
inj = fromIntegralBounded
instance Integral p => Inj p Int32 where
inj = fromIntegralBounded
instance Integral p => Inj p Int64 where
inj = fromIntegralBounded
instance Integral p => Inj p Word where
inj = fromIntegralBounded
instance Integral p => Inj p Word8 where
inj = fromIntegralBounded
instance Integral p => Inj p Word16 where
inj = fromIntegralBounded
instance Integral p => Inj p Word32 where
inj = fromIntegralBounded
instance Integral p => Inj p Word64 where
inj = fromIntegralBounded
instance Integral p => Inj p IntPtr where
inj = fromIntegralBounded
instance Integral p => Inj p WordPtr where
inj = fromIntegralBounded
instance (Inj Integer a, Real p) => Inj p (Ratio a) where
inj p = inj n :% inj d
where
n :% d = toRational p
instance (HasResolution res, Real p) => Inj p (Fixed res) where
inj p
| denominator i == 1 = MkFixed (numerator i)
| otherwise = throw LossOfPrecision
where
i = toRational p * toRational res
res = resolution (Proxy :: Proxy res)
instance Real p => Inj p Float where
inj = realToFrac
instance Real p => Inj p Double where
inj = realToFrac
instance (Num a, Inj p a) => Inj p (Complex a) where
inj p = inj p :+ 0
instance Inj p a => Inj p [a] where
inj = pure . inj
instance Inj p a => Inj p (Maybe a) where
inj = pure . inj
instance Inj p a => Inj p (IO a) where
inj = pure . inj
instance Inj p a => Inj p (NonEmpty a) where
inj = pure . inj
instance Inj p a => Inj p (ReadP a) where
inj = pure . inj
instance Inj p a => Inj p (ReadPrec a) where
inj = pure . inj
instance Inj p a => Inj p (Down a) where
inj = pure . inj
instance Inj p a => Inj p (Product a) where
inj = pure . inj
instance Inj p a => Inj p (Sum a) where
inj = pure . inj
instance Inj p a => Inj p (Dual a) where
inj = pure . inj
instance Inj p a => Inj p (Data.Monoid.Last a) where
inj = pure . inj
instance Inj p a => Inj p (Data.Monoid.First a) where
inj = pure . inj
instance Inj p a => Inj p (STM a) where
inj = pure . inj
instance Inj p a => Inj p (Identity a) where
inj = pure . inj
instance Inj p a => Inj p (ZipList a) where
inj = pure . inj
instance Inj p a => Inj p (Option a) where
inj = pure . inj
instance Inj p a => Inj p (Data.Semigroup.Last a) where
inj = pure . inj
instance Inj p a => Inj p (Data.Semigroup.First a) where
inj = pure . inj
instance Inj p a => Inj p (Max a) where
inj = pure . inj
instance Inj p a => Inj p (Min a) where
inj = pure . inj
instance
TypeError
('Text "Refusing to decide whether to inject " ':<>:
'ShowType p ':<>: 'Text " into 'Left' " ':<>:
'ShowType x ':<>: 'Text " or 'Right' " ':<>: 'ShowType y ':$$:
'Text "in the " ':<>: 'ShowType Inj ':<>:
'Text " instance for " ':<>: 'ShowType Either) =>
Inj p (Either x y)
where
inj = error "impossible"
instance
TypeError
('Text "Refusing to decide whether to inject " ':<>:
'ShowType p ':<>: 'Text " into 'fst' " ':<>:
'ShowType x ':<>: 'Text " or 'snd' " ':<>: 'ShowType y ':$$:
'Text "in the " ':<>: 'ShowType Inj ':<>:
'Text " instance for " ':<>: 'ShowType (,)) =>
Inj p ((,) x y)
where
inj = error "impossible"
instance Inj p a => Inj p (ST s a) where
inj = pure . inj
instance Inj p a => Inj p (r -> a) where
inj = pure . inj
instance Inj p (f (g a)) => Inj p (Compose f g a) where
inj = Compose . inj
instance Inj p (f a) => Inj p (Rec1 f a) where
inj = Rec1 . inj
instance Inj p (f a) => Inj p (M1 i c f a) where
inj = M1 . inj
instance Inj p a => Inj p (Par1 a) where
inj = Par1 . inj
instance Inj p a => Inj p (K1 i a x) where
inj = K1 . inj
instance Inj p (f (g a)) => Inj p ((:.:) f g a) where
inj = Comp1 . inj