{-# LANGUAGE AllowAmbiguousTypes        #-}
{-# LANGUAGE ConstraintKinds            #-}
{-# LANGUAGE ExtendedDefaultRules       #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures             #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TypeApplications           #-}
{-# OPTIONS_GHC -fno-warn-type-defaults #-}


{-|
  This module exposes the browser's native console logging and debugging features,
  including underutilized features such as time measurement, table displays, and assertions.
-}


module Shpadoinkle.Console (
  -- * Classes
  LogJS (..), Assert (..), Trapper (..), askJSM
  -- * Native methods
  -- ** Log levels
  , log, debug, info, warn
  -- ** Fancy display
  , table
  -- ** Time Measurement
  , TimeLabel(..), time, timeEnd
  -- * Re-exports
  , ToJSVal, ToJSON
  ) where


import           Control.Lens                ((^.))
import           Data.Aeson                  (ToJSON, encode)
import           Data.Kind                   (Constraint, Type)
import           Data.String                 (IsString)
import           Data.Text                   (Text, pack)
import           Data.Text.Lazy              (toStrict)
import           Data.Text.Lazy.Encoding     (decodeUtf8)
import           Language.Javascript.JSaddle (JSContextRef, MonadJSM,
                                              ToJSVal (toJSVal), askJSM, js1,
                                              js2, jsg, liftJSM, runJSM)
import           Prelude                     hiding (log)
import           System.IO.Unsafe            (unsafePerformIO)


default (Text)

{-|
   'LogJS' is the base class for logging to the browser console.
   Browser consoles contain rich tooling for exploring JavaScript objects,
   DOM nodes, and much more. To take advantage of these native features, we
   need to choose how we are going to log. The 'LogJS' class is intended to
   be used in conjunction with 'TypeApplications'.

   @
   data Person = Person { first :: String, last :: String, age :: Int } deriving (Generic, ToJSON)
   main = logJS @ToJSON "log" $ Person "bob" "saget" 45
   @

   is effectively equivalent to:

   @
   console.log({first: "bob", last: "saget", age: 45})
   @

   in that the console will render with nice expand/collapse object exploration features.
-}
class LogJS (c :: Type -> Constraint) where
  logJS :: MonadJSM m => c a => Text -> a -> m ()


-- | Logs against 'ToJSON' will be encoded via 'Aeson' then parsed using
-- native <https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/JSON/parse JSON.parse> before being sent to the console.
instance LogJS ToJSON where
  logJS :: Text -> a -> m ()
logJS Text
t a
a = JSM () -> m ()
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM (JSM () -> m ()) -> JSM () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    JSVal
console <- Text -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg Text
"console"
    JSVal
json    <- Text -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg Text
"JSON"
    JSVal
parsed  <- JSVal
json JSVal -> Getting (JSM JSVal) JSVal (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. Text -> Text -> JSF
forall name a0. (ToJSString name, ToJSVal a0) => name -> a0 -> JSF
js1 Text
"parse" (Text -> Text
toStrict (Text -> Text) -> (ByteString -> Text) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ a -> ByteString
forall a. ToJSON a => a -> ByteString
encode a
a)
    () () -> JSM JSVal -> JSM ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ JSVal
console JSVal -> Getting (JSM JSVal) JSVal (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. Text -> JSVal -> JSF
forall name a0. (ToJSString name, ToJSVal a0) => name -> a0 -> JSF
js1 Text
t JSVal
parsed


-- | Logs against 'Show' will be converted to a 'String' before being sent to the console.
instance LogJS Show where
  logJS :: Text -> a -> m ()
logJS Text
t a
a = JSM () -> m ()
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM (JSM () -> m ()) -> JSM () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    JSVal
console <- Text -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg Text
"console"
    () () -> JSM JSVal -> JSM ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ JSVal
console JSVal -> Getting (JSM JSVal) JSVal (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. Text -> Text -> JSF
forall name a0. (ToJSString name, ToJSVal a0) => name -> a0 -> JSF
js1 Text
t (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
a)


-- | Logs against 'ToJSVal' will be converted to a 'JSVal' before being sent to the console.
instance LogJS ToJSVal where
  logJS :: Text -> a -> m ()
logJS Text
t a
a = JSM () -> m ()
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM (JSM () -> m ()) -> JSM () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    JSVal
console <- Text -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg Text
"console"
    () () -> JSM JSVal -> JSM ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ JSVal
console JSVal -> Getting (JSM JSVal) JSVal (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. Text -> JSM JSVal -> JSF
forall name a0. (ToJSString name, ToJSVal a0) => name -> a0 -> JSF
js1 Text
t (a -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal a
a)


{-|
  Trapper is a class intended for continuous logging of your application and the catching of helpless animals.
  Usage is along the lines of 'Debug.Trace.trace' where the effect of logging is implicit.
  To make this work in both GHC and GHCjs contexts, you do need to
  pass the 'JSContextRef' in manually ('askJSM' re-exported here for convenience).

  @
  main :: IO ()
  main = runJSorWarp 8080 $ do
    ctx <- askJSM
    simple runParDiff initial (view . trapper @ToJSON ctx) getBody
  @
-}
class LogJS c => Trapper c where
  trapper :: c a => JSContextRef -> a -> a
  trapper JSContextRef
ctx a
x = IO a -> a
forall a. IO a -> a
unsafePerformIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ JSM a -> JSContextRef -> IO a
forall (m :: * -> *) a. MonadIO m => JSM a -> JSContextRef -> m a
runJSM (a
x a -> JSM () -> JSM a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ a -> JSM ()
forall (c :: * -> Constraint) a (m :: * -> *).
(MonadJSM m, LogJS c, c a) =>
a -> m ()
debug @c a
x) JSContextRef
ctx
  {-# NOINLINE trapper #-}

instance Trapper ToJSON
instance Trapper Show
instance Trapper ToJSVal


{-|
  Assert is a class for assertion programming. It behaves the same as 'LogJS' but calls
  <https://developer.mozilla.org/en-US/docs/Web/API/Console/assert console.assert> instead of
  other console methods. This will only have an effect if the 'Bool' provided to 'assert' is 'False'.
-}
class Assert (c :: Type -> Constraint) where
  assert :: MonadJSM m => c a => Bool -> a -> m ()

instance Assert ToJSON where
  assert :: Bool -> a -> m ()
assert Bool
b a
x = JSM () -> m ()
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM (JSM () -> m ()) -> JSM () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    JSVal
console <- Text -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg Text
"console"
    JSVal
json <- Text -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg Text
"JSON"
    JSVal
parsed <- JSVal
json JSVal -> Getting (JSM JSVal) JSVal (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. Text -> Text -> JSF
forall name a0. (ToJSString name, ToJSVal a0) => name -> a0 -> JSF
js1 Text
"parse" (Text -> Text
toStrict (Text -> Text) -> (ByteString -> Text) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ a -> ByteString
forall a. ToJSON a => a -> ByteString
encode a
x)
    () () -> JSM JSVal -> JSM ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ JSVal
console JSVal -> Getting (JSM JSVal) JSVal (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. Text -> JSM JSVal -> JSVal -> JSF
forall name a0 a1.
(ToJSString name, ToJSVal a0, ToJSVal a1) =>
name -> a0 -> a1 -> JSF
js2 Text
"assert" (Bool -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Bool
b) JSVal
parsed

instance Assert Show where
  assert :: Bool -> a -> m ()
assert Bool
b a
x = JSM () -> m ()
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM (JSM () -> m ()) -> JSM () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    JSVal
console <- Text -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg Text
"console"
    () () -> JSM JSVal -> JSM ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ JSVal
console JSVal -> Getting (JSM JSVal) JSVal (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. Text -> JSM JSVal -> Text -> JSF
forall name a0 a1.
(ToJSString name, ToJSVal a0, ToJSVal a1) =>
name -> a0 -> a1 -> JSF
js2 Text
"assert" (Bool -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Bool
b) (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
x)

instance Assert ToJSVal where
  assert :: Bool -> a -> m ()
assert Bool
b a
x = JSM () -> m ()
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM (JSM () -> m ()) -> JSM () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    JSVal
console <- Text -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg Text
"console"
    () () -> JSM JSVal -> JSM ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ JSVal
console JSVal -> Getting (JSM JSVal) JSVal (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. Text -> JSM JSVal -> JSM JSVal -> JSF
forall name a0 a1.
(ToJSString name, ToJSVal a0, ToJSVal a1) =>
name -> a0 -> a1 -> JSF
js2 Text
"assert" (Bool -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Bool
b) (a -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal a
x)


-- | Log a list of JSON objects to the console where it will rendered as a table using <https://developer.mozilla.org/en-US/docs/Web/API/Console/table console.table>
table :: MonadJSM m => ToJSON a => [a] -> m ()
table :: [a] -> m ()
table = Text -> [a] -> m ()
forall (c :: * -> Constraint) (m :: * -> *) a.
(LogJS c, MonadJSM m, c a) =>
Text -> a -> m ()
logJS @ToJSON Text
"table"


-- | Log to the console using <https://developer.mozilla.org/en-US/docs/Web/API/Console/log console.log>
log :: forall c a m. MonadJSM m => LogJS c => c a => a -> m ()
log :: a -> m ()
log = Text -> a -> m ()
forall (c :: * -> Constraint) (m :: * -> *) a.
(LogJS c, MonadJSM m, c a) =>
Text -> a -> m ()
logJS @c Text
"log"


-- | Log with the "warn" log level using <https://developer.mozilla.org/en-US/docs/Web/API/Console/warn console.warn>
warn :: forall c a m. MonadJSM m => LogJS c => c a => a -> m ()
warn :: a -> m ()
warn = Text -> a -> m ()
forall (c :: * -> Constraint) (m :: * -> *) a.
(LogJS c, MonadJSM m, c a) =>
Text -> a -> m ()
logJS @c Text
"warn"


-- | Log with the "info" log level using <https://developer.mozilla.org/en-US/docs/Web/API/Console/info console.info>
info :: forall c a m. MonadJSM m => LogJS c => c a => a -> m ()
info :: a -> m ()
info = Text -> a -> m ()
forall (c :: * -> Constraint) (m :: * -> *) a.
(LogJS c, MonadJSM m, c a) =>
Text -> a -> m ()
logJS @c Text
"info"


-- | Log with the "debug" log level using <https://developer.mozilla.org/en-US/docs/Web/API/Console/debug console.debug>
debug :: forall c a m. MonadJSM m => LogJS c => c a => a -> m ()
debug :: a -> m ()
debug = Text -> a -> m ()
forall (c :: * -> Constraint) (m :: * -> *) a.
(LogJS c, MonadJSM m, c a) =>
Text -> a -> m ()
logJS @c Text
"debug"


-- | A unique label for a timer. This is used to tie calls to <https://developer.mozilla.org/en-US/docs/Web/API/Console/time console.time> to <https://developer.mozilla.org/en-US/docs/Web/API/Console/timeEnd console.timeEnd>
newtype TimeLabel = TimeLabel { TimeLabel -> Text
unTimeLabel :: Text }
  deriving (TimeLabel -> TimeLabel -> Bool
(TimeLabel -> TimeLabel -> Bool)
-> (TimeLabel -> TimeLabel -> Bool) -> Eq TimeLabel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TimeLabel -> TimeLabel -> Bool
$c/= :: TimeLabel -> TimeLabel -> Bool
== :: TimeLabel -> TimeLabel -> Bool
$c== :: TimeLabel -> TimeLabel -> Bool
Eq, Eq TimeLabel
Eq TimeLabel
-> (TimeLabel -> TimeLabel -> Ordering)
-> (TimeLabel -> TimeLabel -> Bool)
-> (TimeLabel -> TimeLabel -> Bool)
-> (TimeLabel -> TimeLabel -> Bool)
-> (TimeLabel -> TimeLabel -> Bool)
-> (TimeLabel -> TimeLabel -> TimeLabel)
-> (TimeLabel -> TimeLabel -> TimeLabel)
-> Ord TimeLabel
TimeLabel -> TimeLabel -> Bool
TimeLabel -> TimeLabel -> Ordering
TimeLabel -> TimeLabel -> TimeLabel
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 :: TimeLabel -> TimeLabel -> TimeLabel
$cmin :: TimeLabel -> TimeLabel -> TimeLabel
max :: TimeLabel -> TimeLabel -> TimeLabel
$cmax :: TimeLabel -> TimeLabel -> TimeLabel
>= :: TimeLabel -> TimeLabel -> Bool
$c>= :: TimeLabel -> TimeLabel -> Bool
> :: TimeLabel -> TimeLabel -> Bool
$c> :: TimeLabel -> TimeLabel -> Bool
<= :: TimeLabel -> TimeLabel -> Bool
$c<= :: TimeLabel -> TimeLabel -> Bool
< :: TimeLabel -> TimeLabel -> Bool
$c< :: TimeLabel -> TimeLabel -> Bool
compare :: TimeLabel -> TimeLabel -> Ordering
$ccompare :: TimeLabel -> TimeLabel -> Ordering
$cp1Ord :: Eq TimeLabel
Ord, Int -> TimeLabel -> ShowS
[TimeLabel] -> ShowS
TimeLabel -> String
(Int -> TimeLabel -> ShowS)
-> (TimeLabel -> String)
-> ([TimeLabel] -> ShowS)
-> Show TimeLabel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TimeLabel] -> ShowS
$cshowList :: [TimeLabel] -> ShowS
show :: TimeLabel -> String
$cshow :: TimeLabel -> String
showsPrec :: Int -> TimeLabel -> ShowS
$cshowsPrec :: Int -> TimeLabel -> ShowS
Show, String -> TimeLabel
(String -> TimeLabel) -> IsString TimeLabel
forall a. (String -> a) -> IsString a
fromString :: String -> TimeLabel
$cfromString :: String -> TimeLabel
IsString)


-- | Start a timer using <https://developer.mozilla.org/en-US/docs/Web/API/Console/time console.time>
time :: MonadJSM m => TimeLabel -> m ()
time :: TimeLabel -> m ()
time (TimeLabel Text
l) = JSM () -> m ()
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM (JSM () -> m ()) -> JSM () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  JSVal
console <- Text -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg Text
"console"
  () () -> JSM JSVal -> JSM ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ JSVal
console JSVal -> Getting (JSM JSVal) JSVal (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. Text -> Text -> JSF
forall name a0. (ToJSString name, ToJSVal a0) => name -> a0 -> JSF
js1 Text
"time" Text
l


-- | End a timer and print the milliseconds elapsed since it started using <https://developer.mozilla.org/en-US/docs/Web/API/Console/timeEnd console.timeEnd>
timeEnd :: MonadJSM m => TimeLabel -> m ()
timeEnd :: TimeLabel -> m ()
timeEnd (TimeLabel Text
l) = JSM () -> m ()
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM (JSM () -> m ()) -> JSM () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  JSVal
console <- Text -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg Text
"console"
  () () -> JSM JSVal -> JSM ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ JSVal
console JSVal -> Getting (JSM JSVal) JSVal (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. Text -> Text -> JSF
forall name a0. (ToJSString name, ToJSVal a0) => name -> a0 -> JSF
js1 Text
"timeEnd" Text
l