{-# LANGUAGE PackageImports #-}

-- | Utilities for "Refined".
--
-- @since 0.1.0.0
module Refined.Extras.Utils
  ( -- * Pattern Synonym
    pattern MkRefined,

    -- * Exception Functions
    showRefineException,
    showtRefineException,
    refineExceptionToType,
  )
where

-- NOTE: The package-import is solely because doctest gets confused about
-- these vs. these-skinny. Eventually we may remove doctests altogether,
-- as they are quite fragile.

import Data.Text (Text)
import Data.Text qualified as T
import Data.Typeable (TypeRep)
import Refined
  ( RefineException
      ( RefineAndException,
        RefineNotException,
        RefineOrException,
        RefineOtherException,
        RefineSomeException,
        RefineXorException
      ),
  )
import Refined.Unsafe.Type (Refined (Refined))
import "these-skinny" Data.These (These (That, These, This))

-- $setup
-- >>> :set -XAllowAmbiguousTypes
-- >>> :set -XTemplateHaskell
-- >>> import Data.Bifunctor (Bifunctor (..))
-- >>> import Refined (And, NonNegative, NonZero, refine, Xor, refineTH)
-- >>> import Refined.Extras.Polymorphism (Implies)

-- | Unidirectional pattern synonym for 'Refined'. This allows us to pattern
-- match on a refined term without exposing the unsafe internal details.
--
-- ==== __Examples__
-- >>> :{
-- let safeDiv :: Implies p NonZero => Int -> Refined p Int -> Int
--     safeDiv n (MkRefined d) = n `div` d
--     two = $$(refineTH @NonZero @Int 2)
--  in safeDiv 10 two
-- :}
-- 5
--
-- @since 0.1.0.0
pattern MkRefined :: a -> Refined p a
pattern $mMkRefined :: forall {r} {k} {a} {p :: k}.
Refined p a -> (a -> r) -> ((# #) -> r) -> r
MkRefined a <- Refined a

{-# COMPLETE MkRefined #-}

-- | Displays a 'RefineException' without formatting. Intended for situations
-- where 'RefineException'\'s default formatting is undesirable
-- (e.g. doctests, logging).
--
-- ==== __Examples__
-- >>> first showRefineException $ refine @(And NonZero NonNegative) 0
-- Left "RefineAndException (And * * (NotEqualTo 0) (From 0)) (This (RefineOtherException (NotEqualTo 0) \"Value does equal 0\"))"
--
-- >>> let ex = refine @(Xor (And NonZero NonNegative) NonZero) 0
-- >>> first showRefineException ex
-- Left "RefineXorException (Xor * * (And * * (NotEqualTo 0) (From 0)) (NotEqualTo 0)) (RefineAndException (And * * (NotEqualTo 0) (From 0)) (This (RefineOtherException (NotEqualTo 0) \"Value does equal 0\"))) (RefineOtherException (NotEqualTo 0) \"Value does equal 0\")"
--
-- @since 0.1.0.0
showRefineException :: RefineException -> String
showRefineException :: RefineException -> String
showRefineException = Text -> String
T.unpack (Text -> String)
-> (RefineException -> Text) -> RefineException -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RefineException -> Text
showtRefineException

-- | Variant of showRefineException for 'Text'.
--
-- @since 0.1.0.0
showtRefineException :: RefineException -> Text
showtRefineException :: RefineException -> Text
showtRefineException (RefineNotException TypeRep
ty) = Text
"RefineNotException " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TypeRep -> Text
forall a. Show a => a -> Text
showParens TypeRep
ty
showtRefineException (RefineAndException TypeRep
ty These RefineException RefineException
th) =
  Text
"RefineAndException " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TypeRep -> Text
forall a. Show a => a -> Text
showParens TypeRep
ty Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> These RefineException RefineException -> Text
showThese These RefineException RefineException
th Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
showtRefineException (RefineOrException TypeRep
ty RefineException
e1 RefineException
e2) =
  Text
"RefineOrException "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TypeRep -> Text
forall a. Show a => a -> Text
showParens TypeRep
ty
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ("
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RefineException -> Text
showtRefineException RefineException
e1
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
") ("
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RefineException -> Text
showtRefineException RefineException
e2
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
showtRefineException (RefineXorException TypeRep
ty Maybe (RefineException, RefineException)
mEx) =
  Text
"RefineXorException " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TypeRep -> Text
forall a. Show a => a -> Text
showParens TypeRep
ty Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> case Maybe (RefineException, RefineException)
mEx of
    Maybe (RefineException, RefineException)
Nothing -> Text
" Nothing"
    Just (RefineException
e1, RefineException
e2) ->
      Text
" ("
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RefineException -> Text
showtRefineException RefineException
e1
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
") ("
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RefineException -> Text
showtRefineException RefineException
e2
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
showtRefineException (RefineSomeException TypeRep
ty SomeException
someEx) =
  Text
"RefineSomeException " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TypeRep -> Text
forall a. Show a => a -> Text
showParens TypeRep
ty Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (SomeException -> String
forall a. Show a => a -> String
show SomeException
someEx) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
showtRefineException (RefineOtherException TypeRep
ty Text
txt) =
  Text
"RefineOtherException " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TypeRep -> Text
forall a. Show a => a -> Text
showParens TypeRep
ty Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Text -> String
forall a. Show a => a -> String
show Text
txt)

-- | Retrieves the 'TypeRep' corresponding to a 'RefineException'.
--
-- ==== __Examples__
-- >>> first refineExceptionToType $ refine @(And NonZero NonNegative) 0
-- Left (And * * (NotEqualTo 0) (From 0))
--
-- @since 0.1.0.0
refineExceptionToType :: RefineException -> TypeRep
refineExceptionToType :: RefineException -> TypeRep
refineExceptionToType (RefineNotException TypeRep
ty) = TypeRep
ty
refineExceptionToType (RefineAndException TypeRep
ty These RefineException RefineException
_) = TypeRep
ty
refineExceptionToType (RefineOrException TypeRep
ty RefineException
_ RefineException
_) = TypeRep
ty
refineExceptionToType (RefineXorException TypeRep
ty Maybe (RefineException, RefineException)
_) = TypeRep
ty
refineExceptionToType (RefineSomeException TypeRep
ty SomeException
_) = TypeRep
ty
refineExceptionToType (RefineOtherException TypeRep
ty Text
_) = TypeRep
ty

showParens :: (Show a) => a -> Text
showParens :: forall a. Show a => a -> Text
showParens a
ty = Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (a -> String
forall a. Show a => a -> String
show a
ty) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"

showThese :: These RefineException RefineException -> Text
showThese :: These RefineException RefineException -> Text
showThese (These RefineException
e1 RefineException
e2) =
  Text
"These ("
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RefineException -> Text
showtRefineException RefineException
e1
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
") ("
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RefineException -> Text
showtRefineException RefineException
e2
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
showThese (This RefineException
e1) =
  Text
"This ("
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RefineException -> Text
showtRefineException RefineException
e1
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
showThese (That RefineException
e2) =
  Text
"That ("
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RefineException -> Text
showtRefineException RefineException
e2
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"