Remove casting type wrapper

This commit is contained in:
Taylor Fausak 2021-05-10 18:51:40 -04:00
parent e10349b2c4
commit 1d660f8a8c
4 changed files with 1 additions and 108 deletions

View File

@ -55,9 +55,6 @@ module Witch
-- * Data types
, Witch.TryCastException.TryCastException(..)
-- ** Casting
, Witch.Casting.Casting(Casting)
-- * Notes
-- ** Motivation
@ -193,7 +190,6 @@ module Witch
) where
import qualified Witch.Cast
import qualified Witch.Casting
import Witch.Instances ()
import qualified Witch.Lift
import qualified Witch.TryCast

View File

@ -1,62 +0,0 @@
{-# 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 = Cast.cast $ Cast.cast @t @s maxBound
minBound = Cast.cast $ Cast.cast @t @s minBound
instance (Cast.Cast s t, Cast.Cast t s, Enum t) => Enum (Casting s t) where
fromEnum = fromEnum . Cast.cast @s @t . Cast.cast
toEnum = Cast.cast . Cast.cast @t @s . toEnum
instance (Cast.Cast s t, Eq t) => Eq (Casting s t) where
(==) = Function.on (==) $ Cast.cast @s @t . Cast.cast
instance (Cast.Cast s t, Ord t) => Ord (Casting s t) where
compare = Function.on compare $ Cast.cast @s @t . Cast.cast
instance (Cast.Cast t s, Read t) => Read (Casting s t) where
readsPrec = fmap (fmap . Bifunctor.first $ Cast.cast . Cast.cast @t @s) . readsPrec
instance (Cast.Cast s t, Show t) => Show (Casting s t) where
show = show . Cast.cast @s @t . Cast.cast

View File

@ -1659,46 +1659,6 @@ main = Hspec.hspec . Hspec.describe "Witch" $ do
let f = Witch.cast @(Witch.TryCastException Bool Int) @LazyText.Text
test $ f (Witch.TryCastException False Nothing) `Hspec.shouldBe` LazyText.pack "TryCastException @Bool @Int False Nothing"
-- Casting
Hspec.describe "Casting" $ do
Hspec.describe "Bounded" $ do
Hspec.it "maxBound" $ do
maxBound `Hspec.shouldBe` Age maxBound
Hspec.it "minBound" $ do
minBound `Hspec.shouldBe` Age minBound
Hspec.describe "Enum" $ do
Hspec.prop "fromEnum" $ \x ->
fromEnum (Age x) === fromEnum x
Hspec.prop "toEnum" $ \x ->
toEnum x === Age (toEnum x)
Hspec.describe "Eq" $ do
Hspec.prop "==" $ \x ->
Age x === Age x
Hspec.describe "Ord" $ do
Hspec.prop "compare" $ \x y ->
compare (Age x) (Age y) === compare x y
Hspec.describe "Read" $ do
Hspec.prop "readMaybe" $ \x ->
Read.readMaybe x === fmap Age (Read.readMaybe x)
Hspec.describe "Show" $ do
Hspec.prop "show" $ \x ->
show (Age x) === show x
test :: Hspec.Example a => a -> Hspec.SpecWith (Hspec.Arg a)
test = Hspec.it ""
@ -1716,7 +1676,7 @@ instance Exception.Exception Untested
newtype Age
= Age Int.Int8
deriving (Bounded, Enum, Eq, Ord, Read, Show) via Witch.Casting Age Int.Int8
deriving (Eq, Show)
instance Witch.Cast Age Int.Int8

View File

@ -47,7 +47,6 @@ library
exposed-modules:
Witch
Witch.Cast
Witch.Casting
Witch.Identity
Witch.Instances
Witch.Lift