module LawfulConversions.Proxies.ViaIsSome where

import LawfulConversions.Classes
import LawfulConversions.Prelude
import qualified Test.QuickCheck as QuickCheck

-- |
-- Helper for deriving common instances on types which have an instance of @'IsSome' a@ using the @DerivingVia@ extension.
--
-- E.g.,
--
-- > newtype Percent = Percent Double
-- >   deriving newtype (Show, Eq, Ord)
-- >   deriving (Read, Arbitrary) via (ViaIsSome Double Percent)
-- >
-- > instance IsSome Double Percent where
-- >   to (Percent double) = double
-- >   maybeFrom double =
-- >     if double < 0 || double > 1
-- >       then Nothing
-- >       else Just (Percent double)
--
-- In the code above all the instances that are able to construct the values of 'Percent' are automatically derived based on the @IsSome Double Percent@ instance.
-- This guarantees that they only construct values that pass thru the checks defined in 'maybeFrom'.
newtype ViaIsSome a b = ViaIsSome b

instance (IsSome a b) => IsSome a (ViaIsSome a b) where
  to :: ViaIsSome a b -> a
to (ViaIsSome b
a) = b -> a
forall a b. IsSome a b => b -> a
to b
a
  maybeFrom :: a -> Maybe (ViaIsSome a b)
maybeFrom = (b -> ViaIsSome a b) -> Maybe b -> Maybe (ViaIsSome a b)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> ViaIsSome a b
forall a b. b -> ViaIsSome a b
ViaIsSome (Maybe b -> Maybe (ViaIsSome a b))
-> (a -> Maybe b) -> a -> Maybe (ViaIsSome a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> Maybe b
forall a b. IsSome a b => a -> Maybe b
maybeFrom

instance IsSome b (ViaIsSome a b) where
  to :: ViaIsSome a b -> b
to = ViaIsSome a b -> b
forall a b. Coercible a b => a -> b
coerce

instance IsSome (ViaIsSome a b) b where
  to :: b -> ViaIsSome a b
to = b -> ViaIsSome a b
forall a b. Coercible a b => a -> b
coerce

instance IsMany b (ViaIsSome a b)

instance IsMany (ViaIsSome a b) b

instance Is b (ViaIsSome a b)

instance Is (ViaIsSome a b) b

instance (IsSome a b, Show a) => Show (ViaIsSome a b) where
  show :: ViaIsSome a b -> String
show (ViaIsSome b
a) = a -> String
forall a. Show a => a -> String
show (forall a b. IsSome a b => b -> a
to @a b
a)

instance (IsSome a b, Read a) => Read (ViaIsSome a b) where
  readPrec :: ReadPrec (ViaIsSome a b)
readPrec = do
    a <- ReadPrec a
forall a. Read a => ReadPrec a
readPrec
    case maybeFrom @a a of
      Just b
a -> ViaIsSome a b -> ReadPrec (ViaIsSome a b)
forall a. a -> ReadPrec a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b -> ViaIsSome a b
forall a b. b -> ViaIsSome a b
ViaIsSome b
a)
      Maybe b
Nothing -> String -> ReadPrec (ViaIsSome a b)
forall a. String -> ReadPrec a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Value is not from the subset"

instance (IsSome a b, IsString a) => IsString (ViaIsSome a b) where
  fromString :: String -> ViaIsSome a b
fromString =
    ViaIsSome a b -> (b -> ViaIsSome a b) -> Maybe b -> ViaIsSome a b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> ViaIsSome a b
forall a. HasCallStack => String -> a
error String
"Value is not from the subset") b -> ViaIsSome a b
forall a b. b -> ViaIsSome a b
ViaIsSome (Maybe b -> ViaIsSome a b)
-> (String -> Maybe b) -> String -> ViaIsSome a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. IsSome a b => a -> Maybe b
maybeFrom @a (a -> Maybe b) -> (String -> a) -> String -> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> a
forall a. IsString a => String -> a
fromString

instance (IsSome a b, Eq a) => Eq (ViaIsSome a b) where
  == :: ViaIsSome a b -> ViaIsSome a b -> Bool
(==) = (a -> a -> Bool)
-> (ViaIsSome a b -> a) -> ViaIsSome a b -> ViaIsSome a b -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==) (forall a b. IsSome a b => b -> a
to @a)

instance (IsSome a b, Ord a) => Ord (ViaIsSome a b) where
  compare :: ViaIsSome a b -> ViaIsSome a b -> Ordering
compare = (a -> a -> Ordering)
-> (ViaIsSome a b -> a)
-> ViaIsSome a b
-> ViaIsSome a b
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (forall a b. IsSome a b => b -> a
to @a)

instance (IsSome a b, QuickCheck.Arbitrary a) => QuickCheck.Arbitrary (ViaIsSome a b) where
  arbitrary :: Gen (ViaIsSome a b)
arbitrary =
    Gen a -> (a -> Maybe (ViaIsSome a b)) -> Gen (ViaIsSome a b)
forall a b. Gen a -> (a -> Maybe b) -> Gen b
QuickCheck.suchThatMap Gen a
forall a. Arbitrary a => Gen a
QuickCheck.arbitrary (forall a b. IsSome a b => a -> Maybe b
maybeFrom @a)
  shrink :: ViaIsSome a b -> [ViaIsSome a b]
shrink ViaIsSome a b
value = do
    shrunkValue <- a -> [a]
forall a. Arbitrary a => a -> [a]
QuickCheck.shrink (forall a b. IsSome a b => b -> a
to @a ViaIsSome a b
value)
    shrunkValue
      & maybeFrom
      & maybeToList