{- |
Copyright: (c) 2020 Thomas Tuegel
SPDX-License-Identifier: BSD-3-Clause
Maintainer: Thomas Tuegel <ttuegel@mailbox.org>

-}

module Injection
    ( Injection (..)
    , Retraction (..)
    ) where

import Data.Complex (Complex ((:+)))
import Data.Dynamic (Dynamic, Typeable, fromDynamic, toDyn)
import Data.Fixed (Fixed, HasResolution)
import Data.Functor.Const (Const (..))
import Data.Functor.Identity (Identity (..))
import Data.List.NonEmpty (NonEmpty (..))
import Data.Maybe (maybeToList)
import Data.Monoid (Dual (..))
import Data.Monoid (Product (..))
import Data.Monoid (Sum (..))
import Data.Monoid (Any (..))
import Data.Monoid (All (..))
import qualified Data.Monoid as Monoid (First (..), Last (..))
import Data.Ord (Down (..))
import Data.Ratio (Ratio)
import qualified Data.Ratio as Ratio
import Data.Semigroup (Max (..), Min (..))
import qualified Data.Semigroup as Semigroup (First (..), Last (..))
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Lazy as Lazy (Text)
import qualified Data.Text.Lazy as Text.Lazy
import Data.Void (Void)
import Numeric.Natural (Natural)

{- | @Injection@ describes a lossless conversion that includes one type in another.

The sole method of this class,

> inject :: from -> into

takes a value @input :: from@ and returns a value @output :: into@ which preserves all the information contained in the input.
Specifically, each @input@ is mapped to a /unique/ @output@.
In mathematical terminology, @inject@ is /injective/:

> inject a ≡ inject b → a ≡ b

The name of the class is derived from the mathematical term.

@Injection@ models the "is-a" relationship used in languages with subtypes (such as in object-oriented programming),
but an explicit cast with @inject@ is required in Haskell.

Although it is often possible to infer the type parameters of this class,
it is advisable to specify one or both of the parameters to @inject@
using a type signature or the @TypeApplications@ language extension.
Specifying the type parameters will give clearer error messages from the type checker in any case.

-}
class Injection from into where
    inject :: from -> into

{- | @Retraction@ undoes an 'Injection'.

Because 'Injection' is a lossless conversion, we can define a @Retraction@ which undoes it.
The method

> retract :: into -> Maybe from

is the (left) inverse of 'inject':

> retract (inject x) = Just x

'retract' is partial (returns 'Maybe') because the type @into@ may be larger than the type @from@;
that is, there may be values in @into@ which are not 'inject'-ed from @from@,
and in that case @retract@ may return 'Nothing'.

Although it is often possible to infer the type parameters of this class,
it is advisable to specify one or both of the parameters to @retract@
using a type signature or the @TypeApplications@ language extension.
Specifying the type parameters will give clearer error messages from the type checker in any case.

-}
class Injection from into => Retraction from into where
    retract :: into -> Maybe from

instance Injection a a where
    inject :: a -> a
inject = a -> a
forall a. a -> a
id
    {-# INLINE inject #-}

instance Retraction a a where
    retract :: a -> Maybe a
retract = a -> Maybe a
forall a. a -> Maybe a
Just
    {-# INLINE retract #-}

instance Typeable a => Injection a Dynamic where
    inject :: a -> Dynamic
inject = a -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn
    {-# INLINE inject #-}

instance Typeable a => Retraction a Dynamic where
    retract :: Dynamic -> Maybe a
retract = Dynamic -> Maybe a
forall a. Typeable a => Dynamic -> Maybe a
fromDynamic
    {-# INLINE retract #-}

instance Injection a b => Injection a (Maybe b) where
    inject :: a -> Maybe b
inject = b -> Maybe b
forall a. a -> Maybe a
Just (b -> Maybe b) -> (a -> b) -> a -> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
forall from into. Injection from into => from -> into
inject
    {-# INLINE inject #-}

instance Retraction a b => Retraction a (Maybe b) where
    retract :: Maybe b -> Maybe a
retract = \Maybe b
x -> Maybe b
x Maybe b -> (b -> Maybe a) -> Maybe a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Retraction a b => b -> Maybe a
forall from into. Retraction from into => into -> Maybe from
retract @a @b
    {-# INLINE retract #-}

instance Injection a b => Injection (Maybe a) [b] where
    inject :: Maybe a -> [b]
inject = Maybe b -> [b]
forall a. Maybe a -> [a]
maybeToList (Maybe b -> [b]) -> (Maybe a -> Maybe b) -> Maybe a -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Injection a b => a -> b
forall from into. Injection from into => from -> into
inject @a @b)
    {-# INLINE inject #-}

instance Retraction a b => Retraction (Maybe a) [b] where
    retract :: [b] -> Maybe (Maybe a)
retract [] = Maybe a -> Maybe (Maybe a)
forall a. a -> Maybe a
Just Maybe a
forall a. Maybe a
Nothing
    retract [b
b] = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Maybe a -> Maybe (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> Maybe a
forall from into. Retraction from into => into -> Maybe from
retract @a @b b
b
    retract [b]
_ = Maybe (Maybe a)
forall a. Maybe a
Nothing

instance Injection Natural Integer where
    inject :: Natural -> Integer
inject = Natural -> Integer
forall a. Integral a => a -> Integer
toInteger
    {-# INLINE inject #-}

instance Retraction Natural Integer where
    retract :: Integer -> Maybe Natural
retract Integer
x
        | Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 = Maybe Natural
forall a. Maybe a
Nothing
        | Bool
otherwise = Natural -> Maybe Natural
forall a. a -> Maybe a
Just (Integer -> Natural
forall a. Num a => Integer -> a
fromInteger Integer
x)
    {-# INLINE retract #-}

instance Injection Void any where
    inject :: Void -> any
inject = \case {}
    {-# INLINE inject #-}

-- | 'Text.unpack' is the canonical injection @'Text' -> 'String'@.
-- There is no injection in the other direction because 'String' can represent
-- invalid surrogate code points, but 'Text' cannot; for details, see
-- "Data.Text".
instance Injection Text String where
    inject :: Text -> String
inject = Text -> String
Text.unpack
    {-# INLINE inject #-}

-- | 'Text.Lazy.unpack' is the canonical injection @'Lazy.Text' -> 'String'@.
-- There is no injection in the other direction because 'String' can represent
-- invalid surrogate code points, but 'Lazy.Text' cannot; for details, see
-- "Data.Text.Lazy".
instance Injection Lazy.Text String where
    inject :: Text -> String
inject = Text -> String
Text.Lazy.unpack
    {-# INLINE inject #-}

instance Injection Text Lazy.Text where
    inject :: Text -> Text
inject = Text -> Text
Text.Lazy.fromStrict
    {-# INLINE inject #-}

instance Injection Lazy.Text Text where
    inject :: Text -> Text
inject = Text -> Text
Text.Lazy.toStrict
    {-# INLINE inject #-}

instance HasResolution a => Injection Integer (Fixed a) where
    inject :: Integer -> Fixed a
inject = Integer -> Fixed a
forall a. Num a => Integer -> a
fromInteger
    {-# INLINE inject #-}

instance HasResolution a => Retraction Integer (Fixed a) where
    retract :: Fixed a -> Maybe Integer
retract Fixed a
x = Rational -> Maybe Integer
forall from into. Retraction from into => into -> Maybe from
retract @Integer (Fixed a -> Rational
forall a. Real a => a -> Rational
toRational Fixed a
x)
    {-# INLINE retract #-}

instance Injection a (Const a b) where
    inject :: a -> Const a b
inject = a -> Const a b
forall k a (b :: k). a -> Const a b
Const
    {-# INLINE inject #-}

instance Injection (Const a b) a where
    inject :: Const a b -> a
inject = Const a b -> a
forall a k (b :: k). Const a b -> a
getConst
    {-# INLINE inject #-}

instance Injection Integer (Ratio Integer) where
    inject :: Integer -> Rational
inject = Integer -> Rational
forall a. Num a => Integer -> a
fromInteger
    {-# INLINE inject #-}

instance Retraction Integer (Ratio Integer) where
    retract :: Rational -> Maybe Integer
retract Rational
x
        | Rational -> Integer
forall a. Ratio a -> a
Ratio.denominator Rational
x Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 = Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Rational -> Integer
forall a. Ratio a -> a
Ratio.numerator Rational
x)
        | Bool
otherwise = Maybe Integer
forall a. Maybe a
Nothing
    {-# INLINE retract #-}

instance Num a => Injection a (Complex a) where
    inject :: a -> Complex a
inject = (a -> a -> Complex a
forall a. a -> a -> Complex a
:+ a
0)
    {-# INLINE inject #-}

instance (Eq a, Num a) => Retraction a (Complex a) where
    retract :: Complex a -> Maybe a
retract (a
x :+ a
y)
      | a
y a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 = a -> Maybe a
forall a. a -> Maybe a
Just a
x
      | Bool
otherwise = Maybe a
forall a. Maybe a
Nothing
    {-# INLINE retract #-}

instance Injection a (Identity a) where
    inject :: a -> Identity a
inject = a -> Identity a
forall a. a -> Identity a
Identity
    {-# INLINE inject #-}

instance Injection (Identity a) a where
    inject :: Identity a -> a
inject = Identity a -> a
forall a. Identity a -> a
runIdentity
    {-# INLINE inject #-}

instance Injection (NonEmpty a) [a] where
    inject :: NonEmpty a -> [a]
inject (a
x :| [a]
xs) = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs
    {-# INLINE inject #-}

instance Retraction (NonEmpty a) [a] where
    retract :: [a] -> Maybe (NonEmpty a)
retract (a
x : [a]
xs) = NonEmpty a -> Maybe (NonEmpty a)
forall a. a -> Maybe a
Just (a
x a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [a]
xs)
    retract [] = Maybe (NonEmpty a)
forall a. Maybe a
Nothing
    {-# INLINE retract #-}

instance Injection a (Down a) where
    inject :: a -> Down a
inject = a -> Down a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    {-# INLINE inject #-}

instance Injection (Down a) a where
    inject :: Down a -> a
inject = \(Down a
a) -> a
a
    {-# INLINE inject #-}

instance Injection a (Product a) where
    inject :: a -> Product a
inject = a -> Product a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    {-# INLINE inject #-}

instance Injection (Product a) a where
    inject :: Product a -> a
inject = Product a -> a
forall a. Product a -> a
getProduct
    {-# INLINE inject #-}

instance Injection a (Sum a) where
    inject :: a -> Sum a
inject = a -> Sum a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    {-# INLINE inject #-}

instance Injection (Sum a) a where
    inject :: Sum a -> a
inject = Sum a -> a
forall a. Sum a -> a
getSum
    {-# INLINE inject #-}

instance Injection a (Dual a) where
    inject :: a -> Dual a
inject = a -> Dual a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    {-# INLINE inject #-}

instance Injection (Dual a) a where
    inject :: Dual a -> a
inject = Dual a -> a
forall a. Dual a -> a
getDual
    {-# INLINE inject #-}

instance Injection a (Monoid.Last a) where
    inject :: a -> Last a
inject = a -> Last a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    {-# INLINE inject #-}

instance Retraction a (Monoid.Last a) where
    retract :: Last a -> Maybe a
retract = Last a -> Maybe a
forall a. Last a -> Maybe a
Monoid.getLast
    {-# INLINE retract #-}

instance Injection a (Monoid.First a) where
    inject :: a -> First a
inject = a -> First a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    {-# INLINE inject #-}

instance Retraction a (Monoid.First a) where
    retract :: First a -> Maybe a
retract = First a -> Maybe a
forall a. First a -> Maybe a
Monoid.getFirst
    {-# INLINE retract #-}

instance Injection a (Semigroup.First a) where
    inject :: a -> First a
inject = a -> First a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    {-# INLINE inject #-}

instance Injection (Semigroup.First a) a where
    inject :: First a -> a
inject = First a -> a
forall a. First a -> a
Semigroup.getFirst
    {-# INLINE inject #-}

instance Injection a (Semigroup.Last a) where
    inject :: a -> Last a
inject = a -> Last a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    {-# INLINE inject #-}

instance Injection (Semigroup.Last a) a where
    inject :: Last a -> a
inject = Last a -> a
forall a. Last a -> a
Semigroup.getLast
    {-# INLINE inject #-}

instance Injection a (Max a) where
    inject :: a -> Max a
inject = a -> Max a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    {-# INLINE inject #-}

instance Injection (Max a) a where
    inject :: Max a -> a
inject = Max a -> a
forall a. Max a -> a
getMax
    {-# INLINE inject #-}

instance Injection a (Min a) where
    inject :: a -> Min a
inject = a -> Min a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    {-# INLINE inject #-}

instance Injection (Min a) a where
    inject :: Min a -> a
inject = Min a -> a
forall a. Min a -> a
getMin
    {-# INLINE inject #-}

instance Injection a (r -> a) where
    inject :: a -> r -> a
inject = a -> r -> a
forall a r. a -> r -> a
const
    {-# INLINE inject #-}

instance Injection Bool Any where
    inject :: Bool -> Any
inject = Bool -> Any
Any
    {-# INLINE inject #-}

instance Injection Any Bool where
    inject :: Any -> Bool
inject = Any -> Bool
getAny
    {-# INLINE inject #-}

instance Injection Bool All where
    inject :: Bool -> All
inject = Bool -> All
All
    {-# INLINE inject #-}

instance Injection All Bool where
    inject :: All -> Bool
inject = All -> Bool
getAll
    {-# INLINE inject #-}