diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,3 @@ +# 0.1.0.0 + +Initial version. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,202 @@ + + Apache License + Version 2.0, January 2004 + http://www.apache.org/licenses/ + + TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION + + 1. Definitions. + + "License" shall mean the terms and conditions for use, reproduction, + and distribution as defined by Sections 1 through 9 of this document. + + "Licensor" shall mean the copyright owner or entity authorized by + the copyright owner that is granting the License. + + "Legal Entity" shall mean the union of the acting entity and all + other entities that control, are controlled by, or are under common + control with that entity. For the purposes of this definition, + "control" means (i) the power, direct or indirect, to cause the + direction or management of such entity, whether by contract or + otherwise, or (ii) ownership of fifty percent (50%) or more of the + outstanding shares, or (iii) beneficial ownership of such entity. + + "You" (or "Your") shall mean an individual or Legal Entity + exercising permissions granted by this License. + + "Source" form shall mean the preferred form for making modifications, + including but not limited to software source code, documentation + source, and configuration files. + + "Object" form shall mean any form resulting from mechanical + transformation or translation of a Source form, including but + not limited to compiled object code, generated documentation, + and conversions to other media types. + + "Work" shall mean the work of authorship, whether in Source or + Object form, made available under the License, as indicated by a + copyright notice that is included in or attached to the work + (an example is provided in the Appendix below). + + "Derivative Works" shall mean any work, whether in Source or Object + form, that is based on (or derived from) the Work and for which the + editorial revisions, annotations, elaborations, or other modifications + represent, as a whole, an original work of authorship. For the purposes + of this License, Derivative Works shall not include works that remain + separable from, or merely link (or bind by name) to the interfaces of, + the Work and Derivative Works thereof. + + "Contribution" shall mean any work of authorship, including + the original version of the Work and any modifications or additions + to that Work or Derivative Works thereof, that is intentionally + submitted to Licensor for inclusion in the Work by the copyright owner + or by an individual or Legal Entity authorized to submit on behalf of + the copyright owner. For the purposes of this definition, "submitted" + means any form of electronic, verbal, or written communication sent + to the Licensor or its representatives, including but not limited to + communication on electronic mailing lists, source code control systems, + and issue tracking systems that are managed by, or on behalf of, the + Licensor for the purpose of discussing and improving the Work, but + excluding communication that is conspicuously marked or otherwise + designated in writing by the copyright owner as "Not a Contribution." + + "Contributor" shall mean Licensor and any individual or Legal Entity + on behalf of whom a Contribution has been received by Licensor and + subsequently incorporated within the Work. + + 2. Grant of Copyright License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + copyright license to reproduce, prepare Derivative Works of, + publicly display, publicly perform, sublicense, and distribute the + Work and such Derivative Works in Source or Object form. + + 3. Grant of Patent License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + (except as stated in this section) patent license to make, have made, + use, offer to sell, sell, import, and otherwise transfer the Work, + where such license applies only to those patent claims licensable + by such Contributor that are necessarily infringed by their + Contribution(s) alone or by combination of their Contribution(s) + with the Work to which such Contribution(s) was submitted. If You + institute patent litigation against any entity (including a + cross-claim or counterclaim in a lawsuit) alleging that the Work + or a Contribution incorporated within the Work constitutes direct + or contributory patent infringement, then any patent licenses + granted to You under this License for that Work shall terminate + as of the date such litigation is filed. + + 4. Redistribution. You may reproduce and distribute copies of the + Work or Derivative Works thereof in any medium, with or without + modifications, and in Source or Object form, provided that You + meet the following conditions: + + (a) You must give any other recipients of the Work or + Derivative Works a copy of this License; and + + (b) You must cause any modified files to carry prominent notices + stating that You changed the files; and + + (c) You must retain, in the Source form of any Derivative Works + that You distribute, all copyright, patent, trademark, and + attribution notices from the Source form of the Work, + excluding those notices that do not pertain to any part of + the Derivative Works; and + + (d) If the Work includes a "NOTICE" text file as part of its + distribution, then any Derivative Works that You distribute must + include a readable copy of the attribution notices contained + within such NOTICE file, excluding those notices that do not + pertain to any part of the Derivative Works, in at least one + of the following places: within a NOTICE text file distributed + as part of the Derivative Works; within the Source form or + documentation, if provided along with the Derivative Works; or, + within a display generated by the Derivative Works, if and + wherever such third-party notices normally appear. The contents + of the NOTICE file are for informational purposes only and + do not modify the License. You may add Your own attribution + notices within Derivative Works that You distribute, alongside + or as an addendum to the NOTICE text from the Work, provided + that such additional attribution notices cannot be construed + as modifying the License. + + You may add Your own copyright statement to Your modifications and + may provide additional or different license terms and conditions + for use, reproduction, or distribution of Your modifications, or + for any such Derivative Works as a whole, provided Your use, + reproduction, and distribution of the Work otherwise complies with + the conditions stated in this License. + + 5. Submission of Contributions. Unless You explicitly state otherwise, + any Contribution intentionally submitted for inclusion in the Work + by You to the Licensor shall be under the terms and conditions of + this License, without any additional terms or conditions. + Notwithstanding the above, nothing herein shall supersede or modify + the terms of any separate license agreement you may have executed + with Licensor regarding such Contributions. + + 6. Trademarks. This License does not grant permission to use the trade + names, trademarks, service marks, or product names of the Licensor, + except as required for reasonable and customary use in describing the + origin of the Work and reproducing the content of the NOTICE file. + + 7. Disclaimer of Warranty. Unless required by applicable law or + agreed to in writing, Licensor provides the Work (and each + Contributor provides its Contributions) on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or + implied, including, without limitation, any warranties or conditions + of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A + PARTICULAR PURPOSE. You are solely responsible for determining the + appropriateness of using or redistributing the Work and assume any + risks associated with Your exercise of permissions under this License. + + 8. Limitation of Liability. In no event and under no legal theory, + whether in tort (including negligence), contract, or otherwise, + unless required by applicable law (such as deliberate and grossly + negligent acts) or agreed to in writing, shall any Contributor be + liable to You for damages, including any direct, indirect, special, + incidental, or consequential damages of any character arising as a + result of this License or out of the use or inability to use the + Work (including but not limited to damages for loss of goodwill, + work stoppage, computer failure or malfunction, or any and all + other commercial damages or losses), even if such Contributor + has been advised of the possibility of such damages. + + 9. Accepting Warranty or Additional Liability. While redistributing + the Work or Derivative Works thereof, You may choose to offer, + and charge a fee for, acceptance of support, warranty, indemnity, + or other liability obligations and/or rights consistent with this + License. However, in accepting such obligations, You may act only + on Your own behalf and on Your sole responsibility, not on behalf + of any other Contributor, and only if You agree to indemnify, + defend, and hold each Contributor harmless for any liability + incurred by, or claims asserted against, such Contributor by reason + of your accepting any such warranty or additional liability. + + END OF TERMS AND CONDITIONS + + APPENDIX: How to apply the Apache License to your work. + + To apply the Apache License to your work, attach the following + boilerplate notice, with the fields enclosed by brackets "[]" + replaced with your own identifying information. (Don't include + the brackets!) The text should be enclosed in the appropriate + comment syntax for the file format. We also recommend that a + file or class name and description of purpose be included on the + same "printed page" as the copyright notice for easier + identification within third-party archives. + + Copyright [yyyy] [name of copyright owner] + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. diff --git a/portray-diff.cabal b/portray-diff.cabal new file mode 100644 --- /dev/null +++ b/portray-diff.cabal @@ -0,0 +1,46 @@ +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.33.0. +-- +-- see: https://github.com/sol/hpack +-- +-- hash: f9a64f5729d39cde1994044ecdc55d87ed5625e7186133b0920fcb34e939149b + +name: portray-diff +version: 0.1.0.0 +synopsis: Visualize the structural differences between two values. +description: This uses @GHC.Generics@ to provide structural diffs between two values in + pretty-printed form. This is primarily useful for test assertions and manual + inspection of values. +category: Data +homepage: https://github.com/google/hs-portray#readme +bug-reports: https://github.com/google/hs-portray/issues +author: Reiner Pope , Andrew Pritchard +maintainer: Reiner Pope , Andrew Pritchard +copyright: 2018-2021 Google LLC +license: Apache-2.0 +license-file: LICENSE +build-type: Simple +extra-source-files: + CHANGELOG.md + +source-repository head + type: git + location: https://github.com/google/hs-portray + subdir: portray-diff + +library + exposed-modules: + Data.Portray.Diff + other-modules: + Paths_portray_diff + hs-source-dirs: + src + build-depends: + base >=4.12 && <4.16 + , containers >=0.6 && <0.7 + , dlist >=0.6 && <1.1 + , portray >=0.1 && <0.2 + , text >=0.1 && <1.3 + , wrapped >=0.1 && <0.2 + default-language: Haskell2010 diff --git a/src/Data/Portray/Diff.hs b/src/Data/Portray/Diff.hs new file mode 100644 --- /dev/null +++ b/src/Data/Portray/Diff.hs @@ -0,0 +1,293 @@ +-- Copyright 2018-2021 Google LLC +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. + +-- | Typeclass for pretty-printed diffs between two instances of a type. +-- +-- Derive it for arbitrary sum-of-products types as follows: +-- +-- @ +-- data Foo = Foo Int | Bar Bool +-- deriving Generic +-- deriving (Portray, Diff) via Wrapped Generic Foo +-- @ +-- +-- If the type of the compared values has a custom Eq instance, the equality +-- comparison used by the Generic derived Diff instance *will differ* from the +-- custom one implemented for the type. It will only check to make sure that +-- the representations of the two types are the same. If you still want the diff +-- algorithm to look into the type, you will need to implement a custom Diff +-- instance alongside the custom Eq instance. If you don't want the diff +-- algorithm to look inside a type, and instead use the custom Eq instance, use: +-- +-- @ +-- data Foo = ... +-- instance Diff Foo where diff = diffAtom +-- @ + +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuantifiedConstraints #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} + +module Data.Portray.Diff (Diff(..), diffAtom, DiffAtom(..), diffVs) where + +import Prelude hiding (zipWith) + +import qualified Data.Foldable as F (toList) +import Data.Function (on) +import Data.Functor.Const (Const(..)) +import Data.Functor.Identity (Identity(..)) +import Data.Int (Int8, Int16, Int32, Int64) +import qualified Data.IntMap.Strict as IM +import Data.List.NonEmpty (NonEmpty) +import Data.Maybe (fromMaybe, isNothing) +import Data.Ratio (Ratio) +import Data.Semigroup (Any(..)) +import Data.Sequence (Seq) +import Data.Text (Text) +import qualified Data.Text as T +import Data.Type.Equality ((:~:)(..)) +import Data.Word (Word8, Word16, Word32, Word64) +import GHC.Exts (IsList(..)) +import qualified GHC.Exts as Exts (toList) +import GHC.Generics +import GHC.TypeLits (KnownSymbol, symbolVal) +import Type.Reflection (TypeRep, SomeTypeRep(..)) + +import Data.Portray + ( Portray(..), Portrayal(..), PortrayalF(..), Fix(..) + , Infixity(..), Assoc(..), FactorPortrayal(..) + , showAtom, portrayType + ) +import qualified Data.DList as D +import Data.Wrapped (Wrapped(..), Wrapped1(..)) + +class Diff a where + -- | Returns 'Nothing' when equal; or a 'Portrayal' showing the differences. + diff :: a -> a -> Maybe Portrayal + default diff :: (Generic a, GDiff a (Rep a)) => a -> a -> Maybe Portrayal + diff = diff `on` Wrapped @Generic + +instance (Generic a, GDiff a (Rep a)) => Diff (Wrapped Generic a) where + diff (Wrapped x) (Wrapped y) = gdiff x y (from x) (from y) + +vs, diffVs :: Portrayal -> Portrayal -> Portrayal +vs a b = Binop "/=" (Infixity AssocNope 4) a b +diffVs = vs + +-- | Diff on an atomic type, just by using the Eq and Portray instances without +-- using any internal structure of the type. +diffAtom :: (Eq a, Portray a) => a -> a -> Maybe Portrayal +diffAtom a b + | a == b = Nothing + | otherwise = Just (portray a `vs` portray b) + +-- Diff record fields, creating docs only for fields that differ. +class GDiffRecord f where + gdiffRecord :: f x -> f x -> D.DList (FactorPortrayal Portrayal) + +-- Note: no instance GDiffRecord U1 because empty "records" like +-- @data Rec = Rec {}@ are not considered to be records by Generic; they'll go +-- through GDiffCtor instead. + +instance (Selector s, Diff a) => GDiffRecord (S1 s (K1 i a)) where + gdiffRecord (M1 (K1 a)) (M1 (K1 b)) = + foldMap D.singleton $ -- Maybe diff to DList of (zero or one) diffs. + FactorPortrayal (T.pack $ selName @s undefined) <$> + diff a b + +instance (GDiffRecord f, GDiffRecord g) => GDiffRecord (f :*: g) where + gdiffRecord (fa :*: ga) (fb :*: gb) = gdiffRecord fa fb <> gdiffRecord ga gb + +-- Diff constructor fields, filling equal fields with "_" and reporting whether +-- any diffs were detected. +-- +-- N.B. this works fine on record constructors, too, in case we want to support +-- configuring whether to use record syntax or constructor application syntax. +-- +-- This is a separate class from GDiffRecord because it'd be wasteful to +-- accumulate tons of "_" docs for records with lots of fields and then discard +-- them. +class GDiffCtor f where + gdiffCtor :: f x -> f x -> (Any, D.DList Portrayal) + +-- Nullary constructors have no diffs compared against themselves. +instance GDiffCtor U1 where + gdiffCtor U1 U1 = mempty + +instance Diff a => GDiffCtor (S1 s (K1 i a)) where + gdiffCtor (M1 (K1 a)) (M1 (K1 b)) = case diff a b of + Nothing -> (mempty, D.singleton "_") + Just d -> (Any True, D.singleton d) + +instance (GDiffCtor f, GDiffCtor g) => GDiffCtor (f :*: g) where + gdiffCtor (fa :*: ga) (fb :*: gb) = gdiffCtor fa fb <> gdiffCtor ga gb + +class GDiff a f where + gdiff :: a -> a -> f x -> f x -> Maybe Portrayal + +instance (KnownSymbol n, GDiffRecord f) + => GDiff a (C1 ('MetaCons n fx 'True) f) where + gdiff _ _ (M1 a) (M1 b) = case D.toList (gdiffRecord a b) of + [] -> Nothing + ds -> Just $ Record (Atom $ T.pack $ symbolVal @n undefined) ds + +instance (KnownSymbol n, GDiffCtor f) + => GDiff a (C1 ('MetaCons n fx 'False) f) where + gdiff _ _ (M1 a) (M1 b) = case gdiffCtor a b of + (Any False, _ ) -> Nothing + (Any True , ds) -> Just $ case nm of + -- Print tuple constructors with tuple syntax. + '(':',':_ -> Tuple (D.toList ds) + _ -> Apply (Atom $ T.pack nm) (D.toList ds) + where + nm = symbolVal @n undefined + +instance (Portray a, GDiff a f, GDiff a g) => GDiff a (f :+: g) where + gdiff origA origB a b = case (a, b) of + (L1 fa, L1 fb) -> gdiff origA origB fa fb + (R1 ga, R1 gb) -> gdiff origA origB ga gb + _ -> Just (portray origA `vs` portray origB) + +instance GDiff a f => GDiff a (D1 d f) where + gdiff origA origB (M1 a) (M1 b) = gdiff origA origB a b + +instance Diff () +instance (Portray a, Portray b, Diff a, Diff b) => Diff (a, b) +instance (Portray a, Portray b, Portray c, Diff a, Diff b, Diff c) + => Diff (a, b, c) +instance ( Portray a, Portray b, Portray c, Portray d + , Diff a, Diff b, Diff c, Diff d + ) + => Diff (a, b, c, d) +instance ( Portray a, Portray b, Portray c, Portray d, Portray e + , Diff a, Diff b, Diff c, Diff d, Diff e + ) + => Diff (a, b, c, d, e) +instance (Portray a, Portray b, Diff a, Diff b) => Diff (Either a b) +instance (Portray a, Diff a) => Diff (Maybe a) + +instance Diff Bool +instance Diff Int where diff = diffAtom +instance Diff Int8 where diff = diffAtom +instance Diff Int16 where diff = diffAtom +instance Diff Int32 where diff = diffAtom +instance Diff Int64 where diff = diffAtom +instance Diff Word where diff = diffAtom +instance Diff Word8 where diff = diffAtom +instance Diff Word16 where diff = diffAtom +instance Diff Word32 where diff = diffAtom +instance Diff Word64 where diff = diffAtom +instance Diff Char where diff = diffAtom +instance Diff Integer where diff = diffAtom +instance Diff Float where diff = diffAtom +instance Diff Double where diff = diffAtom +instance Diff Text where diff = diffAtom +instance (Eq a, Portray a) => Diff (Ratio a) where diff = diffAtom + +newtype DiffAtom a = DiffAtom a + deriving newtype (Eq, Portray) + +instance (Eq a, Portray a) => Diff (DiffAtom a) where diff = diffAtom + +-- | Diff on lists does a diff on the zip, plus special handling for the +-- mismatched lengths. +instance (Portray a, Diff a) => Diff [a] where + diff as0 bs0 = + if all isNothing d + then Nothing + else Just $ List $ fromMaybe "_" <$> d + where + -- Extended @zipWith diff@ which doesn't drop on mismatched lengths. + go :: [a] -> [a] -> [Maybe Portrayal] + go [] [] = [] + go (a:as) [] = + Just (portray a `vs` "_") : go as [] + go [] (b:bs) = + Just ("_" `vs` portray b) : go [] bs + go (a:as) (b:bs) = diff a b : go as bs + + d = go as0 bs0 + +-- | Diff as if the type were a list, via 'Exts.toList'. +instance (IsList a, Portray (Item a), Diff (Item a)) + => Diff (Wrapped IsList a) where + diff = diff `on` Exts.toList + +-- | Diff as if the type were a list, via 'F.toList'. +instance (Portray a, Foldable f, Diff a) + => Diff (Wrapped1 Foldable f a) where + diff = diff `on` F.toList + +deriving via Wrapped IsList (NonEmpty a) + instance (Portray a, Diff a) => Diff (NonEmpty a) +deriving via Wrapped IsList (Seq a) + instance (Portray a, Diff a) => Diff (Seq a) + +instance (Portray a, Diff a) => Diff (IM.IntMap a) where + diff as bs = + if IM.null allDiffs + then Nothing + else Just $ List [Tuple [showAtom k, v] | (k, v) <- IM.toList allDiffs] + where + -- Note: we could have used 'align', but "these" has a ton of dependencies + -- and it'd only save a few lines of code. + aOnly, bOnly, valDiffs, allDiffs :: IM.IntMap Portrayal + aOnly = IM.map (\a -> portray a `vs` "_") $ IM.difference as bs + bOnly = IM.map (\b -> "_" `vs` portray b) $ IM.difference bs as + valDiffs = IM.mapMaybe id $ IM.intersectionWith diff as bs + allDiffs = IM.unions [aOnly, bOnly, valDiffs] + +deriving via Wrapped Generic Assoc instance Diff Assoc +deriving via Wrapped Generic Infixity instance Diff Infixity +deriving via Wrapped Generic (FactorPortrayal a) + instance Diff a => Diff (FactorPortrayal a) +deriving via Wrapped Generic (PortrayalF a) + instance (Portray a, Diff a) => Diff (PortrayalF a) +deriving newtype + instance ( forall a. (Portray a, Diff a) => Diff (f a) + , forall a. Portray a => Portray (f a) + ) + => Diff (Fix f) +deriving newtype instance Diff Portrayal + +deriving via Wrapped Generic (Identity a) instance Diff a => Diff (Identity a) +deriving via Wrapped Generic (Const a b) instance Diff a => Diff (Const a b) + +instance Diff (TypeRep a) where + diff x y + | x == y = Nothing + | otherwise = Just $ portray x `diffVs` portray y + +instance Diff SomeTypeRep where + diff x@(SomeTypeRep tx) y@(SomeTypeRep ty) + | x == y = Nothing + | otherwise = + Just $ Apply + (TyApp "SomeTypeRep" (portrayType tx `diffVs` portrayType ty)) + ["typeRep"] + +instance Diff (a :~: b) where diff Refl Refl = Nothing