cast.hs

{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -Wno-redundant-constraints #-}
{-# OPTIONS_GHC -fno-show-provenance-of-hole-fits #-}
{-# OPTIONS_GHC -funclutter-valid-hole-fits #-}

module Numeric.Lens.Convert
  ( Number (..),
    _Widen,
  )
where

import Control.Lens.Fold
import Control.Lens.Prism
import Debug.Trace
import Data.Int
import Data.Kind
import Data.Proxy
import Data.Word
import GHC.TypeLits

_Widen :: forall a b. (Number a, Number b, CmpNat (Size a) (Size b) ~ 'GT, Sign a ~ Sign b) => Prism' a b
_Widen = prism' fromIntegral narrow
  where
    narrow a
      | a `fitsInto` (Proxy @b) = Just (fromIntegral a)
      | otherwise = Nothing

_Narrow :: forall a b. (Number a, Number b, CmpNat (Size a) (Size b) ~ 'LT, Sign a ~ Sign b) => Prism' a b
_Narrow = prism' fromIntegral narrow
  where
    narrow a
      | a `fitsInto` (Proxy @b) = Just (fromIntegral a)
      | otherwise = Nothing


data Signedness = Signed | Unsigned

class (Show a, Bounded a, Integral a, Num (Cast a), KnownNat (Size a)) => Number a where
  type Sign a :: Signedness
  type Size a :: Nat

instance Number Int where
  type Sign Int = 'Signed
  type Size Int = 64

instance Number Int64 where
  type Sign Int64 = 'Signed
  type Size Int64 = 64

instance Number Int32 where
  type Sign Int32 = 'Signed
  type Size Int32 = 32

instance Number Int16 where
  type Sign Int16 = 'Signed
  type Size Int16 = 16

instance Number Int8 where
  type Sign Int8 = 'Signed
  type Size Int8 = 8

instance Number Word where
  type Sign Word = 'Unsigned
  type Size Word = 64

instance Number Word64 where
  type Sign Word64 = 'Unsigned
  type Size Word64 = 64

instance Number Word32 where
  type Sign Word32 = 'Unsigned
  type Size Word32 = 32

instance Number Word16 where
  type Sign Word16 = 'Unsigned
  type Size Word16 = 16

instance Number Word8 where
  type Sign Word8 = 'Unsigned
  type Size Word8 = 8