{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Witch.Casting where

import qualified Data.Bifunctor as Bifunctor
import qualified Data.Function as Function
import qualified Witch.Cast as Cast

-- | This type mostly exists to make it easier to derive instances through
-- some other type. It does this by leaning on the 'Cast.Cast' type class. For
-- example, consider this data type:
--
-- > data Toggle = Off | On
-- > instance Cast Toggle String where
-- >   cast toggle = case toggle of
-- >     Off -> "off"
-- >     On -> "on"
--
-- If you wanted to implement a 'Show' instance for @Toggle@ by going through
-- a 'String', you would need to write something like this:
--
-- > instance Show Toggle where
-- >   show = show . into @String
--
-- That may not very complicated, but at the same time it is not very
-- interesting. And it can be tricky if you want to keep other instances (like
-- 'Read') in sync. That's where the 'Casting' type comes in! You can
-- derive the above instance like so:
--
-- > data Toggle = Off | On
-- >   deriving Show via Casting Toggle String
newtype Casting source target
  = Casting source

-- | Uses @coerce@.
instance Cast.Cast s (Casting s t)

-- | Uses @coerce@.
instance Cast.Cast (Casting s t) s

instance (Cast.Cast t s, Bounded t) => Bounded (Casting s t) where
  maxBound :: Casting s t
maxBound = s -> Casting s t
forall source target. Cast source target => source -> target
Cast.cast (s -> Casting s t) -> s -> Casting s t
forall a b. (a -> b) -> a -> b
$ t -> s
forall source target. Cast source target => source -> target
Cast.cast @t @s t
forall a. Bounded a => a
maxBound
  minBound :: Casting s t
minBound = s -> Casting s t
forall source target. Cast source target => source -> target
Cast.cast (s -> Casting s t) -> s -> Casting s t
forall a b. (a -> b) -> a -> b
$ t -> s
forall source target. Cast source target => source -> target
Cast.cast @t @s t
forall a. Bounded a => a
minBound

instance (Cast.Cast s t, Cast.Cast t s, Enum t) => Enum (Casting s t) where
  fromEnum :: Casting s t -> Int
fromEnum = t -> Int
forall a. Enum a => a -> Int
fromEnum (t -> Int) -> (Casting s t -> t) -> Casting s t -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cast s t => s -> t
forall source target. Cast source target => source -> target
Cast.cast @s @t (s -> t) -> (Casting s t -> s) -> Casting s t -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Casting s t -> s
forall source target. Cast source target => source -> target
Cast.cast
  toEnum :: Int -> Casting s t
toEnum = s -> Casting s t
forall source target. Cast source target => source -> target
Cast.cast (s -> Casting s t) -> (Int -> s) -> Int -> Casting s t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cast t s => t -> s
forall source target. Cast source target => source -> target
Cast.cast @t @s (t -> s) -> (Int -> t) -> Int -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> t
forall a. Enum a => Int -> a
toEnum

instance (Cast.Cast s t, Eq t) => Eq (Casting s t) where
  == :: Casting s t -> Casting s t -> Bool
(==) = (t -> t -> Bool)
-> (Casting s t -> t) -> Casting s t -> Casting s t -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
Function.on t -> t -> Bool
forall a. Eq a => a -> a -> Bool
(==) ((Casting s t -> t) -> Casting s t -> Casting s t -> Bool)
-> (Casting s t -> t) -> Casting s t -> Casting s t -> Bool
forall a b. (a -> b) -> a -> b
$ Cast s t => s -> t
forall source target. Cast source target => source -> target
Cast.cast @s @t (s -> t) -> (Casting s t -> s) -> Casting s t -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Casting s t -> s
forall source target. Cast source target => source -> target
Cast.cast

instance (Cast.Cast s t, Ord t) => Ord (Casting s t) where
  compare :: Casting s t -> Casting s t -> Ordering
compare = (t -> t -> Ordering)
-> (Casting s t -> t) -> Casting s t -> Casting s t -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
Function.on t -> t -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ((Casting s t -> t) -> Casting s t -> Casting s t -> Ordering)
-> (Casting s t -> t) -> Casting s t -> Casting s t -> Ordering
forall a b. (a -> b) -> a -> b
$ Cast s t => s -> t
forall source target. Cast source target => source -> target
Cast.cast @s @t (s -> t) -> (Casting s t -> s) -> Casting s t -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Casting s t -> s
forall source target. Cast source target => source -> target
Cast.cast

instance (Cast.Cast t s, Read t) => Read (Casting s t) where
  readsPrec :: Int -> ReadS (Casting s t)
readsPrec = ([(t, String)] -> [(Casting s t, String)])
-> (String -> [(t, String)]) -> ReadS (Casting s t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((t, String) -> (Casting s t, String))
-> [(t, String)] -> [(Casting s t, String)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((t, String) -> (Casting s t, String))
 -> [(t, String)] -> [(Casting s t, String)])
-> ((t -> Casting s t) -> (t, String) -> (Casting s t, String))
-> (t -> Casting s t)
-> [(t, String)]
-> [(Casting s t, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t -> Casting s t) -> (t, String) -> (Casting s t, String)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
Bifunctor.first ((t -> Casting s t) -> [(t, String)] -> [(Casting s t, String)])
-> (t -> Casting s t) -> [(t, String)] -> [(Casting s t, String)]
forall a b. (a -> b) -> a -> b
$ s -> Casting s t
forall source target. Cast source target => source -> target
Cast.cast (s -> Casting s t) -> (t -> s) -> t -> Casting s t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cast t s => t -> s
forall source target. Cast source target => source -> target
Cast.cast @t @s) ((String -> [(t, String)]) -> ReadS (Casting s t))
-> (Int -> String -> [(t, String)]) -> Int -> ReadS (Casting s t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [(t, String)]
forall a. Read a => Int -> ReadS a
readsPrec

instance (Cast.Cast s t, Show t) => Show (Casting s t) where
  show :: Casting s t -> String
show = t -> String
forall a. Show a => a -> String
show (t -> String) -> (Casting s t -> t) -> Casting s t -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cast s t => s -> t
forall source target. Cast source target => source -> target
Cast.cast @s @t (s -> t) -> (Casting s t -> s) -> Casting s t -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Casting s t -> s
forall source target. Cast source target => source -> target
Cast.cast