{-# LANGUAGE CPP                  #-}
{-# LANGUAGE ConstraintKinds      #-}
{-# LANGUAGE DataKinds            #-}
{-# LANGUAGE DeriveDataTypeable   #-}
{-# LANGUAGE DeriveGeneric        #-}
{-# LANGUAGE KindSignatures       #-}
{-# LANGUAGE PolyKinds            #-}
{-# LANGUAGE RankNTypes           #-}
{-# LANGUAGE Trustworthy          #-}
{-# LANGUAGE TypeFamilies         #-}
{-# LANGUAGE TypeInType           #-}
{-# LANGUAGE TypeOperators        #-}
{-# LANGUAGE UndecidableInstances #-}

#if __GLASGOW_HASKELL__ > 802
{-# LANGUAGE DerivingStrategies   #-}
#endif

{- |
Copyright:  (c) 2016 Stephen Diehl
            (c) 2016-2018 Serokell
            (c) 2018-2020 Kowainik
SPDX-License-Identifier: MIT
Maintainer:  Kowainik <xrom.xkov@gmail.com>
Stability:   Stable
Portability: Portable

Functions for debugging and prototyping. If you leave these functions in your
code then a warning is generated to remind you about left usages.

@
__ghci>__ foo = trace "I forgot trace in code"

\<interactive\>:4:7: __warning__: [-Wdeprecations]
    In the use of ‘trace’ (imported from "Relude"):
    "'trace' remains in code"
@

__⚠ NOTE:__ Use these functions only for debugging purposes. They break referential
transparency, they are only useful when you want to observe intermediate values
of your pure functions.
-}

module Relude.Debug
    ( -- * Tracing
      trace
    , traceM
    , traceId
    , traceShow
    , traceShowId
    , traceShowM

      -- * Imprecise error
    , error
    , Undefined (..)
    , undefined
    ) where

import Data.Data (Data)
import GHC.Exts (RuntimeRep, TYPE)
import GHC.TypeLits (ErrorMessage (..), TypeError)

import Relude.Applicative (Applicative)
import Relude.Base (Bounded, Char, Constraint, Enum, Eq, Generic, HasCallStack, Ord, Show, Type,
                    Typeable)
import Relude.String (Read, String, Text, toString)

import qualified Debug.Trace as Debug
import qualified Prelude


-- $setup
-- >>> import Relude
-- >>> :set -Wno-deprecations

----------------------------------------------------------------------------
-- trace
----------------------------------------------------------------------------

{- | Version of 'Debug.Trace.trace' that leaves warning.

>>> increment l = map (+1) l
>>> increment [2, 3, 4]
[3,4,5]

>>> increment l = trace ("incrementing each value of: " ++ show l) (map (+1) l)
>>> increment [2, 3, 4]
incrementing each value of: [2,3,4]
[3,4,5]

-}
trace :: String -> a -> a
trace :: String -> a -> a
trace = String -> a -> a
forall a. String -> a -> a
Debug.trace
{-# WARNING trace "'trace' remains in code" #-}

{- | Version of 'Debug.Trace.traceShow' that leaves warning.

>>> increment l = map (+1) l
>>> increment [2, 3, 4]
[3,4,5]

>>> increment l = traceShow l (map (+1) l)
>>> increment [2, 3, 4]
[2,3,4]
[3,4,5]

-}
traceShow :: Show a => a -> b -> b
traceShow :: a -> b -> b
traceShow = a -> b -> b
forall a b. Show a => a -> b -> b
Debug.traceShow
{-# WARNING traceShow "'traceShow' remains in code" #-}

{- | Version of 'Debug.Trace.traceShowId' that leaves warning.

>>> traceShowId (1+2+3, "hello" ++ "world")
(6,"helloworld")
(6,"helloworld")

-}
traceShowId :: Show a => a -> a
traceShowId :: a -> a
traceShowId = a -> a
forall a. Show a => a -> a
Debug.traceShowId
{-# WARNING traceShowId "'traceShowId' remains in code" #-}

{- | Version of 'Debug.Trace.traceM' that leaves warning.

>>> :{
let action :: Maybe Int
    action = do
        x <- Just 3
        traceM ("x: " ++ show x)
        y <- pure 12
        traceM ("y: " ++ show y)
        pure (x*2 + y)
in action
:}
x: 3
y: 12
Just 18
-}
traceM :: (Applicative f) => String -> f ()
traceM :: String -> f ()
traceM = String -> f ()
forall (f :: * -> *). Applicative f => String -> f ()
Debug.traceM
{-# WARNING traceM "'traceM' remains in code" #-}

{-|
Like 'traceM', but uses 'Relude.show' on the argument to convert it to a
'String'.

>>> :{
let action :: Maybe Int
    action = do
        x <- Just 3
        traceShowM x
        y <- pure 12
        traceShowM y
        pure (x*2 + y)
in action
:}
3
12
Just 18
-}
traceShowM :: (Show a, Applicative f) => a -> f ()
traceShowM :: a -> f ()
traceShowM = a -> f ()
forall a (f :: * -> *). (Show a, Applicative f) => a -> f ()
Debug.traceShowM
{-# WARNING traceShowM "'traceShowM' remains in code" #-}

{- | Version of 'Debug.Trace.traceId' that leaves warning.

>>> traceId "hello"
"hello
hello"
-}
traceId :: String -> String
traceId :: String -> String
traceId = String -> String
Debug.traceId
{-# WARNING traceId "'traceId' remains in code" #-}

----------------------------------------------------------------------------
-- error
----------------------------------------------------------------------------

{- | Throw pure errors. Use this function only to when you are sure that this
branch of code execution is not possible.  __DO NOT USE__ 'error' as a normal
error handling mechanism.

#ifdef mingw32_HOST_OS
>>> error "oops"
*** Exception: oops
CallStack (from HasCallStack):
  error, called at src\\Relude\\Debug.hs:218:11 in ...
  ...
#else
>>> error "oops"
*** Exception: oops
CallStack (from HasCallStack):
  error, called at src/Relude/Debug.hs:218:11 in ...
...
#endif

⚠️__CAUTION__⚠️  Unlike "Prelude" version, 'error' takes 'Relude.Text' as an
argument. In case it used by mistake, the user will see the following:

>>> error ("oops" :: String)
...
... 'error' expects 'Text' but was given 'String'.
      Possible fixes:
          * Make sure OverloadedStrings extension is enabled
          * Use 'error (toText msg)' instead of 'error msg'
...
>>> error False
...
... 'error' works with 'Text'
      But given: Bool
...
-}
error
    :: forall (r :: RuntimeRep) (a :: TYPE r) (t :: Type) .
       (HasCallStack, IsText t)
    => t
    -> a
error :: t -> a
error e :: t
e = String -> a
forall a. HasCallStack => String -> a
Prelude.error (t -> String
forall a. ToString a => a -> String
toString t
e)

type IsText (t :: Type) = (t ~ Text, CheckIsText t)

type family CheckIsText (t :: Type) :: Constraint where
    CheckIsText Text = ()
    CheckIsText [Char] = TypeError
        ( 'Text "'error' expects 'Text' but was given 'String'."
        ':$$: 'Text "Possible fixes:"
        ':$$: 'Text "    * Make sure OverloadedStrings extension is enabled"
        ':$$: 'Text "    * Use 'error (toText msg)' instead of 'error msg'"
        )
    CheckIsText a = TypeError
        ( 'Text "'error' works with 'Text'"
        ':$$: 'Text "But given: " ':<>: 'ShowType a
        )

----------------------------------------------------------------------------
-- Undefined and undefined
----------------------------------------------------------------------------

-- | Similar to 'undefined' but data type.
data Undefined = Undefined
#if __GLASGOW_HASKELL__ > 802
    deriving stock (Undefined -> Undefined -> Bool
(Undefined -> Undefined -> Bool)
-> (Undefined -> Undefined -> Bool) -> Eq Undefined
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Undefined -> Undefined -> Bool
$c/= :: Undefined -> Undefined -> Bool
== :: Undefined -> Undefined -> Bool
$c== :: Undefined -> Undefined -> Bool
Eq, Eq Undefined
Eq Undefined =>
(Undefined -> Undefined -> Ordering)
-> (Undefined -> Undefined -> Bool)
-> (Undefined -> Undefined -> Bool)
-> (Undefined -> Undefined -> Bool)
-> (Undefined -> Undefined -> Bool)
-> (Undefined -> Undefined -> Undefined)
-> (Undefined -> Undefined -> Undefined)
-> Ord Undefined
Undefined -> Undefined -> Bool
Undefined -> Undefined -> Ordering
Undefined -> Undefined -> Undefined
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Undefined -> Undefined -> Undefined
$cmin :: Undefined -> Undefined -> Undefined
max :: Undefined -> Undefined -> Undefined
$cmax :: Undefined -> Undefined -> Undefined
>= :: Undefined -> Undefined -> Bool
$c>= :: Undefined -> Undefined -> Bool
> :: Undefined -> Undefined -> Bool
$c> :: Undefined -> Undefined -> Bool
<= :: Undefined -> Undefined -> Bool
$c<= :: Undefined -> Undefined -> Bool
< :: Undefined -> Undefined -> Bool
$c< :: Undefined -> Undefined -> Bool
compare :: Undefined -> Undefined -> Ordering
$ccompare :: Undefined -> Undefined -> Ordering
$cp1Ord :: Eq Undefined
Ord, Int -> Undefined -> String -> String
[Undefined] -> String -> String
Undefined -> String
(Int -> Undefined -> String -> String)
-> (Undefined -> String)
-> ([Undefined] -> String -> String)
-> Show Undefined
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Undefined] -> String -> String
$cshowList :: [Undefined] -> String -> String
show :: Undefined -> String
$cshow :: Undefined -> String
showsPrec :: Int -> Undefined -> String -> String
$cshowsPrec :: Int -> Undefined -> String -> String
Show, ReadPrec [Undefined]
ReadPrec Undefined
Int -> ReadS Undefined
ReadS [Undefined]
(Int -> ReadS Undefined)
-> ReadS [Undefined]
-> ReadPrec Undefined
-> ReadPrec [Undefined]
-> Read Undefined
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Undefined]
$creadListPrec :: ReadPrec [Undefined]
readPrec :: ReadPrec Undefined
$creadPrec :: ReadPrec Undefined
readList :: ReadS [Undefined]
$creadList :: ReadS [Undefined]
readsPrec :: Int -> ReadS Undefined
$creadsPrec :: Int -> ReadS Undefined
Read, Int -> Undefined
Undefined -> Int
Undefined -> [Undefined]
Undefined -> Undefined
Undefined -> Undefined -> [Undefined]
Undefined -> Undefined -> Undefined -> [Undefined]
(Undefined -> Undefined)
-> (Undefined -> Undefined)
-> (Int -> Undefined)
-> (Undefined -> Int)
-> (Undefined -> [Undefined])
-> (Undefined -> Undefined -> [Undefined])
-> (Undefined -> Undefined -> [Undefined])
-> (Undefined -> Undefined -> Undefined -> [Undefined])
-> Enum Undefined
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Undefined -> Undefined -> Undefined -> [Undefined]
$cenumFromThenTo :: Undefined -> Undefined -> Undefined -> [Undefined]
enumFromTo :: Undefined -> Undefined -> [Undefined]
$cenumFromTo :: Undefined -> Undefined -> [Undefined]
enumFromThen :: Undefined -> Undefined -> [Undefined]
$cenumFromThen :: Undefined -> Undefined -> [Undefined]
enumFrom :: Undefined -> [Undefined]
$cenumFrom :: Undefined -> [Undefined]
fromEnum :: Undefined -> Int
$cfromEnum :: Undefined -> Int
toEnum :: Int -> Undefined
$ctoEnum :: Int -> Undefined
pred :: Undefined -> Undefined
$cpred :: Undefined -> Undefined
succ :: Undefined -> Undefined
$csucc :: Undefined -> Undefined
Enum, Undefined
Undefined -> Undefined -> Bounded Undefined
forall a. a -> a -> Bounded a
maxBound :: Undefined
$cmaxBound :: Undefined
minBound :: Undefined
$cminBound :: Undefined
Bounded, Typeable Undefined
DataType
Constr
Typeable Undefined =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Undefined -> c Undefined)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Undefined)
-> (Undefined -> Constr)
-> (Undefined -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Undefined))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Undefined))
-> ((forall b. Data b => b -> b) -> Undefined -> Undefined)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Undefined -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Undefined -> r)
-> (forall u. (forall d. Data d => d -> u) -> Undefined -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Undefined -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Undefined -> m Undefined)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Undefined -> m Undefined)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Undefined -> m Undefined)
-> Data Undefined
Undefined -> DataType
Undefined -> Constr
(forall b. Data b => b -> b) -> Undefined -> Undefined
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Undefined -> c Undefined
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Undefined
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Undefined -> u
forall u. (forall d. Data d => d -> u) -> Undefined -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Undefined -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Undefined -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Undefined -> m Undefined
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Undefined -> m Undefined
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Undefined
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Undefined -> c Undefined
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Undefined)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Undefined)
$cUndefined :: Constr
$tUndefined :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Undefined -> m Undefined
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Undefined -> m Undefined
gmapMp :: (forall d. Data d => d -> m d) -> Undefined -> m Undefined
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Undefined -> m Undefined
gmapM :: (forall d. Data d => d -> m d) -> Undefined -> m Undefined
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Undefined -> m Undefined
gmapQi :: Int -> (forall d. Data d => d -> u) -> Undefined -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Undefined -> u
gmapQ :: (forall d. Data d => d -> u) -> Undefined -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Undefined -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Undefined -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Undefined -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Undefined -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Undefined -> r
gmapT :: (forall b. Data b => b -> b) -> Undefined -> Undefined
$cgmapT :: (forall b. Data b => b -> b) -> Undefined -> Undefined
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Undefined)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Undefined)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Undefined)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Undefined)
dataTypeOf :: Undefined -> DataType
$cdataTypeOf :: Undefined -> DataType
toConstr :: Undefined -> Constr
$ctoConstr :: Undefined -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Undefined
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Undefined
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Undefined -> c Undefined
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Undefined -> c Undefined
$cp1Data :: Typeable Undefined
Data, Typeable, (forall x. Undefined -> Rep Undefined x)
-> (forall x. Rep Undefined x -> Undefined) -> Generic Undefined
forall x. Rep Undefined x -> Undefined
forall x. Undefined -> Rep Undefined x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Undefined x -> Undefined
$cfrom :: forall x. Undefined -> Rep Undefined x
Generic)
#else
    deriving (Eq, Ord, Show, Read, Enum, Bounded, Data, Typeable, Generic)
#endif
{-# WARNING Undefined "'Undefined' type remains in code" #-}

-- | 'Prelude.undefined' that leaves warning in code on every usage.
undefined :: forall (r :: RuntimeRep) . forall (a :: TYPE r) . HasCallStack => a
undefined :: a
undefined = a
forall a. HasCallStack => a
Prelude.undefined
{-# WARNING undefined "'undefined' function remains in code" #-}