diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,5 @@ +## [_Unreleased_](https://github.com/freckle/debug-print/compare/v0.0.0.0...main) + +## [v0.0.0.0](https://github.com/freckle/debug-print/tree/v0.0.0.0) + +First tagged release. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,21 @@ +The MIT License (MIT) + +Copyright (c) 2025 Renaissance Learning Inc + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/README.lhs b/README.lhs new file mode 100644 --- /dev/null +++ b/README.lhs @@ -0,0 +1,48 @@ +# debug-print + +Offers `ToDebugPrintValue`, a structured alternative to `Show` +for printing values for testing and debugging purposes. + + + +```haskell +import DebugPrint +import DebugPrint.Aeson +import Data.Aeson qualified as Aeson +``` + +```haskell +data Report = Report + { milliseconds :: Int + , errors :: [Text] + } + deriving stock Generic + deriving anyclass (ToDebugPrintRecord, ToDebugPrintValue) + +report :: Report +report = Report{ milliseconds = 5_824 + , errors = ["Warning! Problems."] } +``` + +```haskell +main :: IO () +main = hspec $ do + it "" $ do + Aeson.encode (debugPrintValueToAeson report) `shouldBe` + "{\"errors\":[\"Warning! Problems.\"],\"milliseconds\":5824}" +``` + +--- + +[LICENSE](./LICENSE) | [CHANGELOG](./CHANGELOG.md) diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,48 @@ +# debug-print + +Offers `ToDebugPrintValue`, a structured alternative to `Show` +for printing values for testing and debugging purposes. + + + +```haskell +import DebugPrint +import DebugPrint.Aeson +import Data.Aeson qualified as Aeson +``` + +```haskell +data Report = Report + { milliseconds :: Int + , errors :: [Text] + } + deriving stock Generic + deriving anyclass (ToDebugPrintRecord, ToDebugPrintValue) + +report :: Report +report = Report{ milliseconds = 5_824 + , errors = ["Warning! Problems."] } +``` + +```haskell +main :: IO () +main = hspec $ do + it "" $ do + Aeson.encode (debugPrintValueToAeson report) `shouldBe` + "{\"errors\":[\"Warning! Problems.\"],\"milliseconds\":5824}" +``` + +--- + +[LICENSE](./LICENSE) | [CHANGELOG](./CHANGELOG.md) diff --git a/debug-print.cabal b/debug-print.cabal new file mode 100644 --- /dev/null +++ b/debug-print.cabal @@ -0,0 +1,79 @@ +cabal-version: 1.18 +name: debug-print +version: 0.0.0.0 +license: MIT +license-file: LICENSE +maintainer: Freckle Education +homepage: https://github.com/freckle/debug-print#readme +bug-reports: https://github.com/freckle/debug-print/issues +synopsis: A structured alternative to Show +category: Debug +build-type: Simple +extra-doc-files: + README.md + CHANGELOG.md + +source-repository head + type: git + location: https://github.com/freckle/debug-print + +library + exposed-modules: + DebugPrint + DebugPrint.Aeson + DebugPrint.Class + DebugPrint.Show + DebugPrint.Tagged + DebugPrint.Types + + hs-source-dirs: library + other-modules: Paths_debug_print + default-language: GHC2021 + default-extensions: + DefaultSignatures DeriveAnyClass DerivingVia NoFieldSelectors + NoImplicitPrelude NoMonomorphismRestriction OverloadedStrings + StrictData + + ghc-options: + -Weverything -Wno-all-missed-specialisations + -Wno-missing-import-lists -Wno-missing-kind-signatures + -Wno-missing-safe-haskell-mode -Wno-safe -Wno-unsafe + + build-depends: + aeson >=2.2.3.0, + base >=4.19.2.0 && <5, + containers >=0.6.8, + text >=2.1.1, + vector >=0.13.2.0 + + if impl(ghc >=9.8) + ghc-options: + -Wno-missing-role-annotations -Wno-missing-poly-kind-signatures + +test-suite readme + type: exitcode-stdio-1.0 + main-is: README.lhs + other-modules: Paths_debug_print + default-language: GHC2021 + default-extensions: + DefaultSignatures DeriveAnyClass DerivingVia NoFieldSelectors + NoImplicitPrelude NoMonomorphismRestriction OverloadedStrings + StrictData + + ghc-options: + -Weverything -Wno-all-missed-specialisations + -Wno-missing-import-lists -Wno-missing-kind-signatures + -Wno-missing-safe-haskell-mode -Wno-safe -Wno-unsafe -pgmL + markdown-unlit + + build-depends: + aeson >=2.2.3.0, + base >=4.19.2.0 && <5, + debug-print, + hspec >=2.11.11, + markdown-unlit >=0.6.0, + text >=2.1.1 + + if impl(ghc >=9.8) + ghc-options: + -Wno-missing-role-annotations -Wno-missing-poly-kind-signatures diff --git a/library/DebugPrint.hs b/library/DebugPrint.hs new file mode 100644 --- /dev/null +++ b/library/DebugPrint.hs @@ -0,0 +1,9 @@ +module DebugPrint + ( DebugPrintValue (..) + , DebugPrintRecord (..) + , ToDebugPrintValue (..) + , ToDebugPrintRecord (..) + ) where + +import DebugPrint.Class +import DebugPrint.Types diff --git a/library/DebugPrint/Aeson.hs b/library/DebugPrint/Aeson.hs new file mode 100644 --- /dev/null +++ b/library/DebugPrint/Aeson.hs @@ -0,0 +1,29 @@ +module DebugPrint.Aeson + ( debugPrintRecordToAeson + , debugPrintValueToAeson + ) where + +import Prelude + +import Data.Aeson qualified as Aeson +import Data.Aeson.Key qualified as Key +import Data.Aeson.KeyMap qualified as KeyMap +import Data.Bifunctor (bimap) +import Data.Map.Strict qualified as Map +import DebugPrint.Class +import DebugPrint.Types + +debugPrintRecordToAeson :: ToDebugPrintRecord a => a -> Aeson.Object +debugPrintRecordToAeson a = + let DebugPrintRecord m = toDebugPrintRecord a + in KeyMap.fromList + $ bimap Key.fromText debugPrintValueToAeson + <$> Map.toList m + +debugPrintValueToAeson :: ToDebugPrintValue a => a -> Aeson.Value +debugPrintValueToAeson a = case toDebugPrintValue a of + DebugPrintValueInt x -> Aeson.Number $ fromIntegral x + DebugPrintValueText x -> Aeson.String x + DebugPrintValueBool x -> Aeson.Bool x + DebugPrintValueVector x -> Aeson.Array $ fmap debugPrintValueToAeson x + DebugPrintValueRecord x -> Aeson.Object $ debugPrintRecordToAeson x diff --git a/library/DebugPrint/Class.hs b/library/DebugPrint/Class.hs new file mode 100644 --- /dev/null +++ b/library/DebugPrint/Class.hs @@ -0,0 +1,109 @@ +-- | Generic-derivable classes for converting to 'DebugPrintRecord' and 'Value' +-- +-- These classes are designed to be used only for pretty-printing in tests +-- and logging. They should generally be used anywhere you would derive 'Show'. +module DebugPrint.Class + ( ToDebugPrintValue (..) + , ToDebugPrintRecord (..) + , ToDebugPrintValueRep + , ToDebugPrintRecordRep + ) where + +import Prelude + +import Data.Foldable (toList) +import Data.Kind (Type) +import Data.List.NonEmpty (NonEmpty) +import Data.Map.Strict qualified as Map +import Data.Sequence (Seq) +import Data.Text qualified as T +import Data.Text.Lazy qualified as TL +import Data.Vector (Vector) +import Data.Vector qualified as V +import DebugPrint.Types +import GHC.Generics +import Numeric.Natural (Natural) + +class ToDebugPrintValue a where + toDebugPrintValue :: a -> DebugPrintValue + default toDebugPrintValue + :: (Generic a, ToDebugPrintRecordRep (Rep a)) => a -> DebugPrintValue + toDebugPrintValue = DebugPrintValueRecord . gToRecord . from + +instance ToDebugPrintValue DebugPrintValue where + toDebugPrintValue = id + +instance ToDebugPrintValue Int where + toDebugPrintValue = DebugPrintValueInt + +instance ToDebugPrintValue Char where + toDebugPrintValue = DebugPrintValueText . T.singleton + +instance ToDebugPrintValue Natural where + toDebugPrintValue = DebugPrintValueInt . fromIntegral + +instance ToDebugPrintValue T.Text where + toDebugPrintValue = DebugPrintValueText + +instance ToDebugPrintValue TL.Text where + toDebugPrintValue = DebugPrintValueText . TL.toStrict + +instance ToDebugPrintValue Bool where + toDebugPrintValue = DebugPrintValueBool + +instance ToDebugPrintValue a => ToDebugPrintValue (Maybe a) where + toDebugPrintValue = toDebugPrintValue . toList + +instance ToDebugPrintValue a => ToDebugPrintValue [a] where + toDebugPrintValue = toDebugPrintValue . V.fromList + +instance ToDebugPrintValue a => ToDebugPrintValue (NonEmpty a) where + toDebugPrintValue = toDebugPrintValue . toList + +instance ToDebugPrintValue a => ToDebugPrintValue (Seq a) where + toDebugPrintValue = toDebugPrintValue . toList + +instance ToDebugPrintValue a => ToDebugPrintValue (Vector a) where + toDebugPrintValue = DebugPrintValueVector . fmap toDebugPrintValue + +--- + +class ToDebugPrintRecord a where + toDebugPrintRecord :: a -> DebugPrintRecord + default toDebugPrintRecord + :: (Generic a, ToDebugPrintRecordRep (Rep a)) => a -> DebugPrintRecord + toDebugPrintRecord = gToRecord . from + +instance ToDebugPrintRecord DebugPrintRecord where + toDebugPrintRecord = id + +--- + +class ToDebugPrintValueRep (f :: Type -> Type) where + gToValue :: f a -> DebugPrintValue + +instance ToDebugPrintValue a => ToDebugPrintValueRep (K1 i a) where + gToValue (K1 x) = toDebugPrintValue x + +--- + +class ToDebugPrintRecordRep (f :: Type -> Type) where + gToRecord :: f a -> DebugPrintRecord + +instance ToDebugPrintRecordRep U1 where + gToRecord _ = DebugPrintRecord mempty + +instance + (ToDebugPrintRecordRep f, ToDebugPrintRecordRep g) + => ToDebugPrintRecordRep (f :*: g) + where + gToRecord (x :*: y) = gToRecord x <> gToRecord y + +instance ToDebugPrintRecordRep f => ToDebugPrintRecordRep (D1 i f) where + gToRecord (M1 x) = gToRecord x + +instance ToDebugPrintRecordRep f => ToDebugPrintRecordRep (C1 i f) where + gToRecord (M1 x) = gToRecord x + +instance (Selector s, ToDebugPrintValueRep f) => ToDebugPrintRecordRep (S1 s f) where + gToRecord s1@(M1 x) = DebugPrintRecord $ Map.singleton (T.pack (selName s1)) (gToValue x) diff --git a/library/DebugPrint/Show.hs b/library/DebugPrint/Show.hs new file mode 100644 --- /dev/null +++ b/library/DebugPrint/Show.hs @@ -0,0 +1,16 @@ +module DebugPrint.Show + ( DebugShow (..) + ) where + +import Prelude + +import Data.Text qualified as T +import DebugPrint.Class + +-- | For use with deriving-via, provides a simple 'ToDebugPrintValue' +-- instance based on 'Show' which renders as text +newtype DebugShow a = DebugShow a + +instance Show a => ToDebugPrintValue (DebugShow a) where + toDebugPrintValue (DebugShow x) = + toDebugPrintValue $ T.pack $ show x diff --git a/library/DebugPrint/Tagged.hs b/library/DebugPrint/Tagged.hs new file mode 100644 --- /dev/null +++ b/library/DebugPrint/Tagged.hs @@ -0,0 +1,19 @@ +module DebugPrint.Tagged + ( tag + , Tagged (..) + ) where + +import Prelude + +import Data.Text qualified as T +import DebugPrint.Class +import DebugPrint.Types +import GHC.Generics (Generic) + +-- | Useful for debug-printing discriminated unions +data Tagged = Tagged {tag :: T.Text, value :: DebugPrintValue} + deriving stock (Generic) + deriving anyclass (ToDebugPrintRecord, ToDebugPrintValue) + +tag :: ToDebugPrintValue a => T.Text -> a -> DebugPrintValue +tag t = toDebugPrintValue . Tagged t . toDebugPrintValue diff --git a/library/DebugPrint/Types.hs b/library/DebugPrint/Types.hs new file mode 100644 --- /dev/null +++ b/library/DebugPrint/Types.hs @@ -0,0 +1,29 @@ +-- | A general structure to which data values may be converted +-- +-- This is often useful for testing and logging to get an output that is +-- more structured and better pretty-printed than what 'show' can offer. +module DebugPrint.Types + ( DebugPrintRecord (..) + , DebugPrintValue (..) + ) where + +import Prelude + +import Data.Map (Map) +import Data.String (IsString (..)) +import Data.Text (Text) +import Data.Text qualified as T +import Data.Vector (Vector) + +newtype DebugPrintRecord = DebugPrintRecord (Map Text DebugPrintValue) + deriving newtype (Monoid, Semigroup) + +data DebugPrintValue + = DebugPrintValueInt Int + | DebugPrintValueText Text + | DebugPrintValueBool Bool + | DebugPrintValueVector (Vector DebugPrintValue) + | DebugPrintValueRecord DebugPrintRecord + +instance IsString DebugPrintValue where + fromString = DebugPrintValueText . T.pack