Port Debug from purescript-debugged to Prelude

CHANGELOG.md

@@ -7,6 +7,7 @@ Notable changes to this project are documented in this file. The format is based
 Breaking changes:
 
 New features:
+- Ported the `Debug` type class from `purescript-debugged` into `purescript-prelude` (#273 by @JordanMartinez)
 
 Bugfixes:
 

src/Data/Debug.js

@@ -0,0 +1,10 @@
+export const cons = function (head) {
+  return function (tail) {
+    const arr = new Array(tail.length + 1);
+    arr[0] = head;
+    for (let i = 0; i++; i < tail.length) {
+      arr[i + 1] = tail[i];
+    }
+    return arr;
+  };
+};

src/Data/Debug.purs

@@ -0,0 +1,114 @@
+-- | This module provides the `Debug` type class, for converting values into
+-- | their `Debug` representations.
+module Data.Debug
+  ( class Debug
+  , debug
+  , class DebugRowList
+  , debugRowList
+  ) where
+
+import Control.Semigroupoid ((<<<))
+import Data.Functor (map)
+import Data.Debug.Type as D
+import Data.Ordering (Ordering(..))
+import Data.Symbol (class IsSymbol, reflectSymbol)
+import Data.Unit (Unit)
+import Data.Void (Void, absurd)
+import Prim.Row as Row
+import Prim.RowList (class RowToList, RowList, Nil, Cons)
+import Record.Unsafe (unsafeDelete, unsafeGet)
+import Type.Proxy (Proxy(..))
+
+-- | Ideally, all types of kind `Type` should have an instance of this class.
+-- | If you are defining a type where it's difficult/impossible to do anything
+-- | useful here (e.g. `Ref` or `(->)`) then you should use the `opaque`
+-- | constructor.
+-- |
+-- | If a type has an `Eq` instance, then the `debug` function in its `Debug`
+-- | instance should be *injective*, that is:
+-- |
+-- | ```purescript
+-- | x /= y `implies` debug x /= debug y
+-- | ```
+class Debug :: Type -> Constraint
+class Debug a where
+  debug :: a -> D.Repr
+
+-------------------------------------------------------------------------------
+-- Prim
+
+instance debugInt :: Debug Int where
+  debug = D.int
+
+instance debugNumber :: Debug Number where
+  debug = D.number
+
+instance debugBoolean :: Debug Boolean where
+  debug = D.boolean
+
+instance debugString :: Debug String where
+  debug = D.string
+
+instance debugChar :: Debug Char where
+  debug = D.char
+
+instance debugArray :: Debug a => Debug (Array a) where
+  debug = D.array <<< map debug
+
+instance debugFunction :: Debug (a -> b) where
+  debug _ = D.opaque_ "function"
+
+-- | This class is part of the machinery for the `Debug (Record r)` instance;
+-- | it is not intended to be used directly.
+class DebugRowList :: RowList Type -> Row Type -> Constraint
+class DebugRowList list row | list -> row where
+  debugRowList :: Proxy list -> Record row -> Array { key :: String, value :: D.Repr }
+
+instance debugRowListNil :: DebugRowList Nil () where
+  debugRowList _ _ = []
+
+instance debugRowListCons ::
+  ( Debug a
+  , DebugRowList listRest rowRest
+  , Row.Cons  key a rowRest rowFull
+  , Row.Lacks key rowRest
+  , RowToList rowFull (Cons key a listRest)
+  , IsSymbol key
+  ) => DebugRowList (Cons key a listRest) rowFull where
+  debugRowList _ rec =
+    cons { key, value: debug val } rest
+    where
+    key = reflectSymbol (Proxy :: Proxy key)
+    val = unsafeGet key rec :: a
+    rest = debugRowList (Proxy :: Proxy listRest) (unsafeDelete key rec)
+
+instance debugRecord ::
+  ( RowToList row list
+  , DebugRowList list row
+  ) => Debug (Record row) where
+  debug r =
+    D.record (debugRowList prx r)
+    where
+    prx = Proxy :: Proxy list
+
+-------------------------------------------------------------------------------
+-- Prelude
+
+instance debugOrdering :: Debug Ordering where
+  debug LT = D.constructor "LT" []
+  debug EQ = D.constructor "EQ" []
+  debug GT = D.constructor "GT" []
+
+instance debugUnit :: Debug Unit where
+  debug _ = D.constructor "unit" []
+
+instance debugVoid :: Debug Void where
+  debug = absurd
+
+instance debugProxy :: Debug (Proxy a) where
+  debug _ = D.opaque_ "Proxy"
+
+foreign import cons :: forall a. a -> Array a -> Array a
+
+instance debugRepr :: Debug D.Repr where
+  debug r = D.opaque "Repr" r

src/Data/Debug/Generic.purs

@@ -0,0 +1,69 @@
+-- | This module provides a mechanism for deriving `Debug` instances for types
+-- | which export their constructors. To use it, simply derive a `Generic`
+-- | instance and then use `genericDebug` in the `Debug` instance. For example:
+-- |
+-- | ```
+-- | data MyType = [...]
+-- | derive instance genericMyType :: Generic MyType _
+-- | instance debugMyType :: Debug MyType where
+-- |   debug genericDebug
+-- | ```
+-- |
+-- | Note that the resulting `Debug` instance will expose details of the
+-- | constructors. Therefore, this mechanism is not suitable for types which
+-- | hide their constructors.
+module Data.Debug.Generic
+  ( genericDebug
+  , class GenericDebug
+  , genericDebug'
+  , class GenericDebugArgs
+  , genericDebugArgs
+  ) where
+
+import Control.Semigroupoid ((<<<))
+import Data.Semigroup ((<>))
+import Data.Debug (class Debug, debug)
+import Data.Debug.Type as D
+import Data.Generic.Rep (class Generic, Argument(..), Constructor(..), NoArguments(..), NoConstructors, Product(..), Sum(..), from)
+import Data.Symbol (class IsSymbol, reflectSymbol)
+import Type.Proxy (Proxy(..))
+
+-- | A generic implementation of the `Debug` type class.
+genericDebug :: forall a rep.
+  Generic a rep =>
+  GenericDebug rep =>
+  a -> D.Repr
+genericDebug = genericDebug' <<< from
+
+-- | This class is part of the machinery for deriving `Debug` instances; it is
+-- | not intended to be used directly.
+class GenericDebug rep where
+  genericDebug' :: rep -> D.Repr
+
+instance genericDebugNoConstructors :: GenericDebug NoConstructors where
+  genericDebug' x = genericDebug' x
+
+instance genericDebugConstructor
+  :: (GenericDebugArgs a, IsSymbol name) => GenericDebug (Constructor name a) where
+  genericDebug' (Constructor a) =
+    D.constructor
+      (reflectSymbol (Proxy :: Proxy name))
+      (genericDebugArgs a)
+
+instance genericDebugSum :: (GenericDebug a, GenericDebug b) => GenericDebug (Sum a b) where
+  genericDebug' (Inl a) = genericDebug' a
+  genericDebug' (Inr b) = genericDebug' b
+
+-- | This class is part of the machinery for deriving `Debug` instances; it is
+-- | not intended to be used directly.
+class GenericDebugArgs rep where
+  genericDebugArgs :: rep -> Array D.Repr
+
+instance genericDebugArgsArgument :: Debug a => GenericDebugArgs (Argument a) where
+  genericDebugArgs (Argument a) = [debug a]
+
+instance genericDebugArgsProduct :: (GenericDebugArgs a, GenericDebugArgs b) => GenericDebugArgs (Product a b) where
+  genericDebugArgs (Product a b) = genericDebugArgs a <> genericDebugArgs b
+
+instance genericDebugArgsNoArguments :: GenericDebugArgs NoArguments where
+  genericDebugArgs NoArguments = []