{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}

module Witch.Utility where

import qualified Control.Exception as Exception
import qualified Data.Typeable as Typeable
import qualified GHC.Stack as Stack
import qualified Witch.Cast as Cast
import qualified Witch.Identity as Identity
import qualified Witch.TryCast as TryCast
import qualified Witch.TryCastException as TryCastException

-- | This is the same as 'id' except that it requires a type application. This
-- can be an ergonomic way to pin down a polymorphic type in a function
-- pipeline. For example:
--
-- > -- Avoid this:
-- > f . (\ x -> x :: Int) . g
-- >
-- > -- Prefer this:
-- > f . as @Int . g
as :: forall s source . Identity.Identity s ~ source => source -> source
as :: source -> source
as = source -> source
forall a. a -> a
id

-- | This is the same as 'Cast.cast' except that it requires a type
-- application for the @source@ type.
--
-- > -- Avoid this:
-- > cast (x :: s)
-- >
-- > -- Prefer this:
-- > from @s x
from
  :: forall s target source
   . (Identity.Identity s ~ source, Cast.Cast source target)
  => source
  -> target
from :: source -> target
from = source -> target
forall source target. Cast source target => source -> target
Cast.cast

-- | This is the same as 'Cast.cast' except that it requires a type
-- application for the @target@ type.
--
-- > -- Avoid this:
-- > cast x :: t
-- >
-- > -- Prefer this:
-- > into @t x
into
  :: forall t source target
   . (Identity.Identity t ~ target, Cast.Cast source target)
  => source
  -> target
into :: source -> target
into = source -> target
forall source target. Cast source target => source -> target
Cast.cast

-- | This function converts from some @source@ type into some @target@ type,
-- applies the given function, then converts back into the @source@ type. This
-- is useful when you have two types that are isomorphic but some function
-- that only works with one of them.
--
-- > -- Avoid this:
-- > from @t . f . from @s
-- >
-- > -- Prefer this:
-- > over @t f
over
  :: forall t source target
   . ( Identity.Identity t ~ target
     , Cast.Cast source target
     , Cast.Cast target source
     )
  => (target -> target)
  -> source
  -> source
over :: (target -> target) -> source -> source
over target -> target
f = target -> source
forall source target. Cast source target => source -> target
Cast.cast (target -> source) -> (source -> target) -> source -> source
forall b c a. (b -> c) -> (a -> b) -> a -> c
. target -> target
f (target -> target) -> (source -> target) -> source -> target
forall b c a. (b -> c) -> (a -> b) -> a -> c
. source -> target
forall source target. Cast source target => source -> target
Cast.cast

-- | This function first converts from some @source@ type into some @through@
-- type, and then converts that into some @target@ type. Usually this is used
-- when writing 'Cast.Cast' instances. Sometimes this can be used to work
-- around the lack of an instance that should probably exist.
--
-- > -- Avoid this:
-- > from @u . into @u
-- >
-- > -- Prefer this:
-- > via @u
via
  :: forall u source target through
   . ( Identity.Identity u ~ through
     , Cast.Cast source through
     , Cast.Cast through target
     )
  => source
  -> target
via :: source -> target
via = through -> target
forall source target. Cast source target => source -> target
Cast.cast (through -> target) -> (source -> through) -> source -> target
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\through
x -> through
x :: through) (through -> through) -> (source -> through) -> source -> through
forall b c a. (b -> c) -> (a -> b) -> a -> c
. source -> through
forall source target. Cast source target => source -> target
Cast.cast

-- | This is the same as 'TryCast.tryCast' except that it requires a type
-- application for the @source@ type.
--
-- > -- Avoid this:
-- > tryCast (x :: s)
-- >
-- > -- Prefer this:
-- > tryFrom @s x
tryFrom
  :: forall s target source
   . (Identity.Identity s ~ source, TryCast.TryCast source target)
  => source
  -> Either (TryCastException.TryCastException source target) target
tryFrom :: source -> Either (TryCastException source target) target
tryFrom = source -> Either (TryCastException source target) target
forall source target.
TryCast source target =>
source -> Either (TryCastException source target) target
TryCast.tryCast

-- | This is the same as 'TryCast.tryCast' except that it requires a type
-- application for the @target@ type.
--
-- > -- Avoid this:
-- > tryCast x :: Either (TryCastException s t) t
-- >
-- > -- Prefer this:
-- > tryInto @t x
tryInto
  :: forall t source target
   . (Identity.Identity t ~ target, TryCast.TryCast source target)
  => source
  -> Either (TryCastException.TryCastException source target) target
tryInto :: source -> Either (TryCastException source target) target
tryInto = source -> Either (TryCastException source target) target
forall source target.
TryCast source target =>
source -> Either (TryCastException source target) target
TryCast.tryCast

-- | This is similar to 'via' except that it works with 'TryCast.TryCast'
-- instances instead. This function is especially convenient because juggling
-- the types in the 'TryCastException.TryCastException' can be tedious.
--
-- > -- Avoid this:
-- > fmap (tryFrom @u) . tryInto @u
-- >
-- > -- Prefer this:
-- > tryVia @u
tryVia
  :: forall u source target through
   . ( Identity.Identity u ~ through
     , TryCast.TryCast source through
     , TryCast.TryCast through target
     )
  => source
  -> Either (TryCastException.TryCastException source target) target
tryVia :: source -> Either (TryCastException source target) target
tryVia source
s = case source -> Either (TryCastException source through) through
forall source target.
TryCast source target =>
source -> Either (TryCastException source target) target
TryCast.tryCast source
s of
  Left TryCastException source through
_ -> TryCastException source target
-> Either (TryCastException source target) target
forall a b. a -> Either a b
Left (TryCastException source target
 -> Either (TryCastException source target) target)
-> TryCastException source target
-> Either (TryCastException source target) target
forall a b. (a -> b) -> a -> b
$ source -> TryCastException source target
forall source target. source -> TryCastException source target
TryCastException.TryCastException source
s
  Right through
u -> case through -> Either (TryCastException through target) target
forall source target.
TryCast source target =>
source -> Either (TryCastException source target) target
TryCast.tryCast (through
u :: through) of
    Left TryCastException through target
_ -> TryCastException source target
-> Either (TryCastException source target) target
forall a b. a -> Either a b
Left (TryCastException source target
 -> Either (TryCastException source target) target)
-> TryCastException source target
-> Either (TryCastException source target) target
forall a b. (a -> b) -> a -> b
$ source -> TryCastException source target
forall source target. source -> TryCastException source target
TryCastException.TryCastException source
s
    Right target
t -> target -> Either (TryCastException source target) target
forall a b. b -> Either a b
Right target
t

-- | This function is like 'TryCast.tryCast' except that it will throw an
-- impure exception if the conversion fails.
--
-- > -- Avoid this:
-- > either throw id . cast
-- >
-- > -- Prefer this:
-- > unsafeCast
unsafeCast
  :: forall source target
   . ( Stack.HasCallStack
     , TryCast.TryCast source target
     , Show source
     , Typeable.Typeable source
     , Typeable.Typeable target
     )
  => source
  -> target
unsafeCast :: source -> target
unsafeCast = (TryCastException source target -> target)
-> (target -> target)
-> Either (TryCastException source target) target
-> target
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either TryCastException source target -> target
forall a e. Exception e => e -> a
Exception.throw target -> target
forall a. a -> a
id (Either (TryCastException source target) target -> target)
-> (source -> Either (TryCastException source target) target)
-> source
-> target
forall b c a. (b -> c) -> (a -> b) -> a -> c
. source -> Either (TryCastException source target) target
forall source target.
TryCast source target =>
source -> Either (TryCastException source target) target
TryCast.tryCast

-- | This function is like 'from' except that it will throw an impure
-- exception if the conversion fails.
--
-- > -- Avoid this:
-- > either throw id . from @s
-- >
-- > -- Prefer this:
-- > unsafeFrom @s
unsafeFrom
  :: forall s target source
   . ( Identity.Identity s ~ source
     , Stack.HasCallStack
     , TryCast.TryCast source target
     , Show source
     , Typeable.Typeable source
     , Typeable.Typeable target
     )
  => source
  -> target
unsafeFrom :: source -> target
unsafeFrom = source -> target
forall source target.
(HasCallStack, TryCast source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeCast

-- | This function is like 'into' except that it will throw an impure
-- exception if the conversion fails.
--
-- > -- Avoid this:
-- > either throw id . into @t
-- >
-- > -- Prefer this:
-- > unsafeInto @t
unsafeInto
  :: forall t source target
   . ( Identity.Identity t ~ target
     , Stack.HasCallStack
     , TryCast.TryCast source target
     , Show source
     , Typeable.Typeable source
     , Typeable.Typeable target
     )
  => source
  -> target
unsafeInto :: source -> target
unsafeInto = source -> target
forall source target.
(HasCallStack, TryCast source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeCast