{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}

{- | Conversion between types with a known level of safety.  *Heavily* inspired
 by `witch` (which has dependencies that make it hard for us to use just yet).
-}
module Tahoe.SDMF.Internal.Converting where

import Control.Monad.Fail (MonadFail)
import Data.Int (Int64)
import Data.Word (Word16, Word32, Word64, Word8)

-- | Precise, infallible conversion between two types.
class From a b where
    from :: a -> b

-- | Precise, fallible conversion between two types.
class TryFrom a b m where
    tryFrom ::
        -- | An error message for context if the conversion fails.
        String ->
        -- | The value to convert.
        a ->
        m b

instance MonadFail m => TryFrom Int Word32 m where
    tryFrom :: String -> Int -> m Word32
tryFrom String
msg Int
n
        | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = String -> m Word32
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
msg
        | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxWord32 = String -> m Word32
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
msg
        | Bool
otherwise = Word32 -> m Word32
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word32 -> m Word32) -> Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
      where
        maxWord32 :: Int
maxWord32 = Word32 -> Int
forall a b. From a b => a -> b
from @Word32 @Int Word32
forall a. Bounded a => a
maxBound

instance MonadFail m => TryFrom Int Word64 m where
    tryFrom :: String -> Int -> m Word64
tryFrom String
msg Int
n
        | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = String -> m Word64
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
msg
        | Bool
otherwise = Word64 -> m Word64
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word64 -> m Word64) -> Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n

instance MonadFail m => TryFrom Int64 Word64 m where
    tryFrom :: String -> Int64 -> m Word64
tryFrom String
msg Int64
n
        | Int64
n Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
0 = String -> m Word64
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
msg
        | Bool
otherwise = Word64 -> m Word64
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word64 -> m Word64) -> Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
n

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

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

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

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

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

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

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

instance MonadFail m => TryFrom Word64 Int m where
    tryFrom :: String -> Word64 -> m Int
tryFrom String
msg Word64
n
        | Word64
n Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> Word64
maxInt = String -> m Int
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
msg
        | Bool
otherwise = Int -> m Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> m Int) -> Int -> m Int
forall a b. (a -> b) -> a -> b
$ Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n
      where
        maxInt :: Word64
maxInt = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
forall a. Bounded a => a
maxBound :: Int) :: Word64

instance MonadFail m => TryFrom Word16 Word8 m where
    tryFrom :: String -> Word16 -> m Word8
tryFrom String
msg Word16
n
        | Word16
n Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
> Word16
maxWord8 = String -> m Word8
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
msg
        | Bool
otherwise = Word8 -> m Word8
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word8 -> m Word8) -> Word8 -> m Word8
forall a b. (a -> b) -> a -> b
$ Word16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
n
      where
        maxWord8 :: Word16
maxWord8 = Word8 -> Word16
forall a b. From a b => a -> b
from @Word8 @Word16 Word8
forall a. Bounded a => a
maxBound

instance MonadFail m => TryFrom Word64 Int64 m where
    tryFrom :: String -> Word64 -> m Int64
tryFrom String
msg Word64
n
        | Word64
n Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> Word64
maxInt64 = String -> m Int64
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
msg
        | Bool
otherwise = Int64 -> m Int64
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int64 -> m Int64) -> Int64 -> m Int64
forall a b. (a -> b) -> a -> b
$ Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n
      where
        maxInt64 :: Word64
maxInt64 = Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64
forall a. Bounded a => a
maxBound :: Int64) :: Word64

{- | Like `from` but with the order of the input/output type parameters
 reversed.
-}
into :: forall b a. From a b => a -> b
into :: a -> b
into = a -> b
forall a b. From a b => a -> b
from

{- | Like `tryFrom` but with the order of the input/output type parameters
 reverse.
-}
tryInto :: forall b a m. TryFrom a b m => String -> a -> m b
tryInto :: String -> a -> m b
tryInto = String -> a -> m b
forall a b (m :: * -> *). TryFrom a b m => String -> a -> m b
tryFrom