{-# language AllowAmbiguousTypes #-}
{-# language DefaultSignatures #-}
{-# language FlexibleInstances #-}
{-# language MultiParamTypeClasses #-}
{-# language ScopedTypeVariables #-}

-- | This module provides the 'From' type class for converting values between
-- various types. This aims to be a common interface for the various @xToY@ or
-- @yFromX@ functions you might write instead. It is inspired by the
-- @std::convert::From@ trait that the Rust programming language provides.
--
-- Many Haskell libraries already provide similar functionality. Here's how
-- this module compares to them:
--
-- - <https://hackage.haskell.org/package/base-4.14.0.0/docs/Data-Coerce.html>:
--   This type class is convenient because it's automatically inferred by the
--   compiler, but it only works for types that have the same runtime
--   representation.
--
-- - <https://hackage.haskell.org/package/convertible-1.1.1.0/docs/Data-Convertible-Base.html>:
--   This type class allows for conversions to fail.
--
-- - <https://hackage.haskell.org/package/basement-0.0.11/docs/Basement-From.html>:
--   This type class is essentially the same, but the @basement@ package is an
--   alternative standard library that some people may not want to depend on.
--
-- - <https://hackage.haskell.org/package/inj-base-0.2.0.0/docs/Inj-Base.html>:
--   This type class requires conversions to be injective, as opposed to merely
--   suggesting it. Also some conversions fail at runtime.
--
-- - <https://github.com/mbj/conversions/blob/6ac6c52/src/Data/Conversions/FromType.hs>:
--   This type class comes with many convenient helper functions, but some of
--   the provided instances fail at runtime.
--
-- - <https://github.com/kframework/kore/blob/626f230/kore/src/From.hs>:
--   This package is not available on Hackage, but otherwise is very similar to
--   this one.
module Witch (From(from), into, via) where

import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Lazy as LazyByteString
import qualified Data.Coerce as Coerce
import qualified Data.Foldable as Foldable
import qualified Data.Int as Int
import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Map as Map
import qualified Data.Sequence as Seq
import qualified Data.Set as Set
import qualified Data.Text as Text
import qualified Data.Text.Lazy as LazyText
import qualified Data.Tuple as Tuple
import qualified Data.Void as Void
import qualified Data.Word as Word
import qualified Numeric.Natural as Natural

-- | This type class represents a way to convert values from some type into
-- another type. The constraint @From a b@ means that you can convert from a
-- value of type @a@ into a value of type @b@.
--
-- This is primarily intended for "zero cost" conversions like @newtype@s. For
-- example if you wanted to have a type to represent someone's name, you could
-- say:
--
-- > newtype Name = Name String
-- > instance From String Name
-- > instance From Name String
--
-- And then you could convert back and forth between @Name@s and @String@s:
--
-- > let someString = "Taylor"
-- > let someName = Name someString
-- > into @Name someString -- convert from string to name
-- > into @String someName -- convert from name to string
--
-- This type class does not have any laws, but it does have some expectations:
--
-- - Conversions should be total. A conversion should never fail or crash.
--   Avoid writing instances like @From Int (Maybe Char)@. (It might be
--   worthwhile to have a separate @TryFrom@ type class for this.)
--
-- - Conversions should be unambiguous. For example there are many ways to
--   decode a @ByteString@ into @Text@, so you shouldn't provide an instance
--   for that.
--
-- - Conversions should be cheap, ideally free. For example converting from
--   @String@ to @Text@ is probably fine, but converting from a UTF-8 encoded
--   @ByteString@ to @Text@ is problematic.
--
-- - Conversions should be lossless. In other words if you have @From a b@ then
--   no two @a@ values should be converted to the same @b@ value. For example
--   @From Int Integer@ is fine because every @Int@ can be mapped to a
--   corresponding @Integer@, but @From Integer Int@ is not good because some
--   @Integer@s are out of bounds and would need to be clamped.
--
-- - If you have both @From a b@ and @From b a@, then @from . from@ should be
--   the same as 'id'. In other words @a@ and @b@ are isomorphic.
--
-- - If you have both @From a b@ and @From b c@, then it's up to you if you
--   want to provide @From a c@. Sometimes using 'via' is ergonomic enough,
--   other times you want the extra instance. (It would be nice if we could
--   provide @instance (From a b, From b c) => From a c where from = via \@b@.)
class From a b where
  -- | This method converts a value from one type into another. This is
  -- intended to be used with the @TypeApplications@ language extension. For
  -- example, here are a few ways to convert from an 'Int' into an 'Integer':
  --
  -- > from @Int @Integer 123
  -- > from @_ @Integer (123 :: Int)
  -- > from @Int @_ 123 :: Integer
  -- > from @Int 123 :: Integer
  -- > from (123 :: Int) :: Integer
  --
  -- Often the context around an expression will make the explicit type
  -- signatures unnecessary. If you find yourself using a partial type
  -- signature, consider using 'into' instead. For example:
  --
  -- > let someInt = 123 :: Int
  -- > from @_ @Integer someInt -- avoid this
  -- > into @Integer someInt -- prefer this
  --
  -- The default implementation of 'from' simply calls 'Coerce.coerce', which
  -- works for types that have the same runtime representation.
  from :: a -> b
  default from :: Coerce.Coercible a b => a -> b
  from = a -> b
Coerce.coerce

-- | This function converts a value from one type into another. This is the
-- same as 'from' except that the type variables are in the opposite order.
into :: forall b a . From a b => a -> b
into :: a -> b
into = a -> b
forall a b. From a b => a -> b
from

-- | This function converts a value from one type into another by going through
-- some third type. This is the same as calling 'from' (or 'into') twice, but
-- can sometimes be more convenient.
--
-- Note that the type in the middle of the conversion is the first type
-- variable of this function. In other words, @via \@b \@a \@c@ first converts
-- from @a@ to @b@, and then from @b@ to @c@. Often both @a@ and @c@ will be
-- inferred from context, which means you can just write @via \@b@.
via :: forall b a c . (From a b, From b c) => a -> c
via :: a -> c
via = b -> c
forall a b. From a b => a -> b
from (b -> c) -> (a -> b) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\ b
x -> b
x :: b) (b -> b) -> (a -> b) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
forall a b. From a b => a -> b
from

-- | 'id'
instance From a a where
  from :: a -> a
from = a -> a
forall a. a -> a
id

-- | 'const'
instance From a (x -> a) where
  from :: a -> x -> a
from = a -> x -> a
forall a x. a -> x -> a
const

-- | 'pure'
instance From a [a] where
  from :: a -> [a]
from = a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | 'Just'
instance From a (Maybe a) where
  from :: a -> Maybe a
from = a -> Maybe a
forall a. a -> Maybe a
Just

-- | 'Left'
instance From a (Either a x) where
  from :: a -> Either a x
from = a -> Either a x
forall a x. a -> Either a x
Left

-- | 'Right'
instance From a (Either x a) where
  from :: a -> Either x a
from = a -> Either x a
forall a b. b -> Either a b
Right

-- | 'Void.absurd'
instance From Void.Void x where
  from :: Void -> x
from = Void -> x
forall x. Void -> x
Void.absurd

-- | 'fst'
instance From (a, x) a where
  from :: (a, x) -> a
from = (a, x) -> a
forall a x. (a, x) -> a
fst

-- | 'snd'
instance From (x, a) a where
  from :: (x, a) -> a
from = (x, a) -> a
forall x a. (x, a) -> a
snd

-- | 'Tuple.swap'
instance From (a, b) (b, a) where
  from :: (a, b) -> (b, a)
from = (a, b) -> (b, a)
forall a b. (a, b) -> (b, a)
Tuple.swap

-- | 'NonEmpty.toList'
instance From (NonEmpty.NonEmpty a) [a] where
  from :: NonEmpty a -> [a]
from = NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
NonEmpty.toList

-- | 'fromIntegral'
instance From Word.Word8 Word.Word16 where
  from :: Word8 -> Word16
from = Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | 'fromIntegral'
instance From Word.Word16 Word.Word32 where
  from :: Word16 -> Word32
from = Word16 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | 'fromIntegral'
instance From Word.Word32 Word.Word64 where
  from :: Word32 -> Word64
from = Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | 'fromIntegral'
instance From Word Natural.Natural where
  from :: Word -> Natural
from = Word -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | 'fromIntegral'
instance From Natural.Natural Integer where
  from :: Natural -> Integer
from = Natural -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | 'fromIntegral'
instance From Int.Int8 Int.Int16 where
  from :: Int8 -> Int16
from = Int8 -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | 'fromIntegral'
instance From Int.Int16 Int.Int32 where
  from :: Int16 -> Int32
from = Int16 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | 'fromIntegral'
instance From Int.Int32 Int.Int64 where
  from :: Int32 -> Int64
from = Int32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | 'fromIntegral'
instance From Int Integer where
  from :: Int -> Integer
from = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | 'fromIntegral'
instance From Integer Rational where
  from :: Integer -> Rational
from = Integer -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | 'realToFrac'
instance From Float Double where
  from :: Float -> Double
from = Float -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac

-- | 'fromEnum'
instance From Bool Int where
  from :: Bool -> Int
from = Bool -> Int
forall a. Enum a => a -> Int
fromEnum

-- | 'fromEnum'
instance From Char Int where
  from :: Char -> Int
from = Char -> Int
forall a. Enum a => a -> Int
fromEnum

-- | 'ByteString.pack'
instance From [Word.Word8] ByteString.ByteString where
  from :: [Word8] -> ByteString
from = [Word8] -> ByteString
ByteString.pack

-- | 'ByteString.unpack'
instance From ByteString.ByteString [Word.Word8] where
  from :: ByteString -> [Word8]
from = ByteString -> [Word8]
ByteString.unpack

-- | 'LazyByteString.fromStrict'
instance From ByteString.ByteString LazyByteString.ByteString where
  from :: ByteString -> ByteString
from = ByteString -> ByteString
LazyByteString.fromStrict

-- | 'LazyByteString.toStrict'
instance From LazyByteString.ByteString ByteString.ByteString where
  from :: ByteString -> ByteString
from = ByteString -> ByteString
LazyByteString.toStrict

-- | 'Text.pack'
instance From String Text.Text where
  from :: String -> Text
from = String -> Text
Text.pack

-- | 'Text.unpack'
instance From Text.Text String where
  from :: Text -> String
from = Text -> String
Text.unpack

-- | 'LazyText.fromStrict'
instance From Text.Text LazyText.Text where
  from :: Text -> Text
from = Text -> Text
LazyText.fromStrict

-- | 'LazyText.toStrict'
instance From LazyText.Text Text.Text where
  from :: Text -> Text
from = Text -> Text
LazyText.toStrict

-- | 'Seq.fromList'
instance From [a] (Seq.Seq a) where
  from :: [a] -> Seq a
from = [a] -> Seq a
forall a. [a] -> Seq a
Seq.fromList

-- | 'Foldable.toList'
instance From (Seq.Seq a) [a] where
  from :: Seq a -> [a]
from = Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList

-- | 'Set.fromList'
--
-- Note that this will remove duplicate elements from the list.
instance Ord a => From [a] (Set.Set a) where
  from :: [a] -> Set a
from = [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList

-- | 'Set.toAscList'
instance From (Set.Set a) [a] where
  from :: Set a -> [a]
from = Set a -> [a]
forall a. Set a -> [a]
Set.toAscList

-- | 'Map.fromList'
--
-- Note that if there are duplicate keys in the list, the one closest to the
-- end will win.
instance Ord k => From [(k, v)] (Map.Map k v) where
  from :: [(k, v)] -> Map k v
from = [(k, v)] -> Map k v
forall k v. Ord k => [(k, v)] -> Map k v
Map.fromList

-- | 'Map.toAscList'
instance From (Map.Map k v) [(k, v)] where
  from :: Map k v -> [(k, v)]
from = Map k v -> [(k, v)]
forall k v. Map k v -> [(k, v)]
Map.toAscList