From 026efbc1ec6befad49b1b26fdcddebd8f2c9a908 Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Tue, 12 Sep 2017 10:26:26 -0700 Subject: [PATCH 1/5] Add pretty-show and hscolour --- semantic-diff.cabal | 2 ++ 1 file changed, 2 insertions(+) diff --git a/semantic-diff.cabal b/semantic-diff.cabal index 486d44913..2d5dce057 100644 --- a/semantic-diff.cabal +++ b/semantic-diff.cabal @@ -125,6 +125,8 @@ library , tree-sitter-python , tree-sitter-ruby , tree-sitter-typescript + , pretty-show + , hscolour default-language: Haskell2010 default-extensions: DeriveFunctor, DeriveFoldable, DeriveTraversable, DeriveGeneric, FlexibleContexts, FlexibleInstances, OverloadedStrings, RecordWildCards, StrictData ghc-options: -Wall -fno-warn-name-shadowing -O -j From 3f7755b9e892db825c7799a0564aa80307621fb5 Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Tue, 12 Sep 2017 13:14:35 -0700 Subject: [PATCH 2/5] Add .ghci-template file --- .ghci-template | 23 +++++++++++++++++++++++ 1 file changed, 23 insertions(+) create mode 100644 .ghci-template diff --git a/.ghci-template b/.ghci-template new file mode 100644 index 000000000..147266626 --- /dev/null +++ b/.ghci-template @@ -0,0 +1,23 @@ +:set prompt "\ESC[1;36m\STXλ: \ESC[m\STX" + +:def pretty \_ -> return ("import Text.Show.Pretty (pPrint, ppShow)\nimport Language.Haskell.HsColour\nimport Language.Haskell.HsColour.Colourise\nlet color = putStrLn . hscolour TTY defaultColourPrefs False False \"\" False . ppShow\n:set -interactive-print color") +:def no-pretty \_ -> return (":set -interactive-print System.IO.print") + +:def re \_ -> return (":r\n:pretty") + +:{ +assignmentExample lang = case lang of + "Python" -> mk "py" "python" + "Go" -> mk "go" "go" + "Ruby" -> mk "rb" "ruby" + "JavaScript" -> mk "js" "typescript" + "TypeScript" -> mk "ts" "typescript" + "Haskell" -> mk "hs" "haskell" + "Markdown" -> mk "md" "markdown" + "JSON" -> mk "json" "json" + _ -> mk "" "" + where mk fileExtension parser = putStrLn ("example: fmap (() <$) . runTask . parse " ++ parser ++ "Parser =<< Semantic.Util.file \"example." ++ fileExtension ++ "\"") >> return ("import Parser\nimport Semantic.Task\nimport Semantic.Util") +:} + +:def assignment assignmentExample + From a6cbdab2e953968ba6b8476c62b5e658cf87ca0e Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Tue, 12 Sep 2017 15:40:24 -0700 Subject: [PATCH 3/5] :fire: prettyprint --- .gitmodules | 3 -- cabal.project | 2 +- semantic-diff.cabal | 2 - src/Category.hs | 4 -- src/Data/Functor/Classes/Pretty/Generic.hs | 49 ---------------------- src/Data/Range.hs | 4 -- src/Data/Record.hs | 8 ---- src/Data/Span.hs | 7 ---- src/Data/Syntax.hs | 18 -------- src/Data/Syntax/Comment.hs | 5 --- src/Data/Syntax/Declaration.hs | 11 ----- src/Data/Syntax/Expression.hs | 10 ----- src/Data/Syntax/Literal.hs | 29 ------------- src/Data/Syntax/Markup.hs | 32 -------------- src/Data/Syntax/Statement.hs | 23 ---------- src/Data/Syntax/Type.hs | 3 -- src/Diff.hs | 9 ---- src/Language/Python/Syntax.hs | 3 -- src/Patch.hs | 6 --- src/Semantic/Util.hs | 4 -- src/Syntax.hs | 3 -- src/Term.hs | 13 ------ vendor/prettyprinter | 1 - 23 files changed, 1 insertion(+), 248 deletions(-) delete mode 100644 src/Data/Functor/Classes/Pretty/Generic.hs delete mode 160000 vendor/prettyprinter diff --git a/.gitmodules b/.gitmodules index 4057676c3..a51ba2fb2 100644 --- a/.gitmodules +++ b/.gitmodules @@ -25,6 +25,3 @@ [submodule "vendor/freer-cofreer"] path = vendor/freer-cofreer url = https://github.com/robrix/freer-cofreer.git -[submodule "vendor/prettyprinter"] - path = vendor/prettyprinter - url = https://github.com/robrix/prettyprinter.git diff --git a/cabal.project b/cabal.project index 76859f12f..dd75d0e82 100644 --- a/cabal.project +++ b/cabal.project @@ -1,3 +1,3 @@ -packages: ./ vendor/*/ vendor/haskell-tree-sitter/languages/*/ vendor/prettyprinter/*/ +packages: ./ vendor/*/ vendor/haskell-tree-sitter/languages/*/ jobs: $ncpus diff --git a/semantic-diff.cabal b/semantic-diff.cabal index 2d5dce057..8388f0aaa 100644 --- a/semantic-diff.cabal +++ b/semantic-diff.cabal @@ -21,7 +21,6 @@ library , Data.Error , Data.Functor.Both , Data.Functor.Classes.Eq.Generic - , Data.Functor.Classes.Pretty.Generic , Data.Functor.Classes.Show.Generic , Data.Functor.Listable , Data.Mergeable @@ -109,7 +108,6 @@ library , optparse-applicative , parallel , parsers - , prettyprinter , recursion-schemes , semigroups , split diff --git a/src/Category.hs b/src/Category.hs index a8c14b8ba..85fea468e 100644 --- a/src/Category.hs +++ b/src/Category.hs @@ -7,7 +7,6 @@ import Control.DeepSeq import Data.Functor.Listable import Data.Hashable import Data.Text (Text) -import Data.Text.Prettyprint.Doc import GHC.Generics -- | A standardized category of AST node. Used to determine the semantics for @@ -364,6 +363,3 @@ instance Listable Category where -- \/ cons0 (Modifier If) \/ cons0 SingletonMethod -- \/ cons0 (Other "other") - -instance Pretty Category where - pretty = pretty . show diff --git a/src/Data/Functor/Classes/Pretty/Generic.hs b/src/Data/Functor/Classes/Pretty/Generic.hs deleted file mode 100644 index 2281beaf8..000000000 --- a/src/Data/Functor/Classes/Pretty/Generic.hs +++ /dev/null @@ -1,49 +0,0 @@ -{-# LANGUAGE TypeOperators #-} -module Data.Functor.Classes.Pretty.Generic -( module Pretty -, genericLiftPretty -) where - -import Data.Text.Prettyprint.Doc as Pretty -import GHC.Generics - -genericLiftPretty :: (Generic1 f, GPretty1 (Rep1 f)) => (a -> Doc ann) -> ([a] -> Doc ann) -> f a -> Doc ann -genericLiftPretty pretty' prettyList' = gliftPretty pretty' prettyList' . from1 - - -class GPretty1 f where - gliftPretty :: (a -> Doc ann) -> ([a] -> Doc ann) -> f a -> Doc ann - gcollectPretty :: (a -> Doc ann) -> ([a] -> Doc ann) -> f a -> [Doc ann] - gcollectPretty p pl a = [gliftPretty p pl a] - -instance GPretty1 U1 where - gliftPretty _ _ _ = emptyDoc - -instance GPretty1 Par1 where - gliftPretty p _ (Par1 a) = p a - -instance Pretty c => GPretty1 (K1 i c) where - gliftPretty _ _ (K1 a) = pretty a - -instance Pretty1 f => GPretty1 (Rec1 f) where - gliftPretty p pl (Rec1 a) = liftPretty p pl a - -instance GPretty1 f => GPretty1 (M1 D c f) where - gliftPretty p pl (M1 a) = gliftPretty p pl a - -instance (Constructor c, GPretty1 f) => GPretty1 (M1 C c f) where - gliftPretty p pl m = nest 2 (vsep (pretty (conName m) : gcollectPretty p pl (unM1 m))) - -instance GPretty1 f => GPretty1 (M1 S c f) where - gliftPretty p pl (M1 a) = gliftPretty p pl a - -instance (GPretty1 f, GPretty1 g) => GPretty1 (f :+: g) where - gliftPretty p pl (L1 l) = gliftPretty p pl l - gliftPretty p pl (R1 r) = gliftPretty p pl r - -instance (GPretty1 f, GPretty1 g) => GPretty1 (f :*: g) where - gliftPretty p pl (a :*: b) = gliftPretty p pl a <+> gliftPretty p pl b - gcollectPretty p pl (a :*: b) = gcollectPretty p pl a <> gcollectPretty p pl b - -instance (Pretty1 f, GPretty1 g) => GPretty1 (f :.: g) where - gliftPretty p pl (Comp1 a) = liftPretty (gliftPretty p pl) (list . map (gliftPretty p pl)) a diff --git a/src/Data/Range.hs b/src/Data/Range.hs index 3eef78cf1..7b77c4c15 100644 --- a/src/Data/Range.hs +++ b/src/Data/Range.hs @@ -8,7 +8,6 @@ module Data.Range import Control.DeepSeq import Data.Semigroup -import Data.Text.Prettyprint.Doc import GHC.Generics import Test.LeanCheck @@ -39,6 +38,3 @@ instance Ord Range where instance Listable Range where tiers = cons2 Range - -instance Pretty Range where - pretty (Range from to) = pretty from <> pretty '-' <> pretty to diff --git a/src/Data/Record.hs b/src/Data/Record.hs index 9c113042f..d61bc5e61 100644 --- a/src/Data/Record.hs +++ b/src/Data/Record.hs @@ -5,7 +5,6 @@ import Control.DeepSeq import Data.Kind import Data.Functor.Listable import Data.Semigroup -import Data.Text.Prettyprint.Doc -- | A type-safe, extensible record structure. -- | @@ -88,10 +87,3 @@ instance (Semigroup head, Semigroup (Record tail)) => Semigroup (Record (head ': instance Semigroup (Record '[]) where _ <> _ = Nil - - -instance ConstrainAll Pretty ts => Pretty (Record ts) where - pretty = tupled . collectPretty - where collectPretty :: ConstrainAll Pretty ts => Record ts -> [Doc ann] - collectPretty Nil = [] - collectPretty (first :. rest) = pretty first : collectPretty rest diff --git a/src/Data/Span.hs b/src/Data/Span.hs index 4ce614ea5..fd050305b 100644 --- a/src/Data/Span.hs +++ b/src/Data/Span.hs @@ -14,7 +14,6 @@ import Data.Aeson ((.=), (.:)) import qualified Data.Aeson as A import Data.Hashable (Hashable) import Data.Semigroup -import Data.Text.Prettyprint.Doc import GHC.Generics import Test.LeanCheck @@ -63,9 +62,3 @@ instance Listable Pos where instance Listable Span where tiers = cons2 Span - -instance Pretty Pos where - pretty Pos{..} = pretty posLine <> colon <> pretty posColumn - -instance Pretty Span where - pretty Span{..} = pretty spanStart <> pretty '-' <> pretty spanEnd diff --git a/src/Data/Syntax.hs b/src/Data/Syntax.hs index cdd72387b..c62f73923 100644 --- a/src/Data/Syntax.hs +++ b/src/Data/Syntax.hs @@ -13,13 +13,11 @@ import Data.Function ((&)) import Data.Ix import Data.List.NonEmpty (NonEmpty(..), nonEmpty) import Data.Functor.Classes.Eq.Generic -import Data.Functor.Classes.Pretty.Generic import Data.Functor.Classes.Show.Generic import Data.Record import Data.Semigroup import Data.Span import qualified Data.Syntax.Assignment as Assignment -import Data.Text.Encoding (decodeUtf8With) import Data.Union import GHC.Generics import GHC.Stack @@ -107,15 +105,11 @@ newtype Leaf a = Leaf { leafContent :: ByteString } instance Eq1 Leaf where liftEq = genericLiftEq instance Show1 Leaf where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Leaf where - liftPretty _ _ (Leaf s) = pretty ("Leaf" :: String) <+> prettyBytes s - newtype Branch a = Branch { branchElements :: [a] } deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable) instance Eq1 Branch where liftEq = genericLiftEq instance Show1 Branch where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Branch where liftPretty = genericLiftPretty -- Common @@ -127,15 +121,11 @@ newtype Identifier a = Identifier ByteString instance Eq1 Identifier where liftEq = genericLiftEq instance Show1 Identifier where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Identifier where - liftPretty _ _ (Identifier s) = pretty ("Identifier" :: String) <+> prettyBytes s - newtype Program a = Program [a] deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable) instance Eq1 Program where liftEq = genericLiftEq instance Show1 Program where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Program where liftPretty = genericLiftPretty -- | Empty syntax, with essentially no-op semantics. @@ -146,7 +136,6 @@ data Empty a = Empty instance Eq1 Empty where liftEq _ _ _ = True instance Show1 Empty where liftShowsPrec _ _ _ _ = showString "Empty" -instance Pretty1 Empty where liftPretty = genericLiftPretty -- | Syntax representing a parsing or assignment error. @@ -156,9 +145,6 @@ data Error a = Error { errorCallStack :: [([Char], SrcLoc)], errorExpected :: [S instance Eq1 Error where liftEq = genericLiftEq instance Show1 Error where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Error where - liftPretty _ pl (Error cs e a c) = nest 2 (concatWith (\ x y -> x <> hardline <> y) [ pretty ("Error" :: String), pretty (Error.showExpectation False e a ""), pretty (Error.showCallStack False (fromCallSiteList cs) ""), pl c]) - errorSyntax :: Error.Error String -> [a] -> Error a errorSyntax Error.Error{..} = Error (getCallStack callStack) errorExpected errorActual @@ -171,7 +157,3 @@ data Context a = Context { contextTerms :: NonEmpty a, contextSubject :: a } instance Eq1 Context where liftEq = genericLiftEq instance Show1 Context where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Context where liftPretty = genericLiftPretty - -prettyBytes :: ByteString -> Doc ann -prettyBytes = pretty . decodeUtf8With (\ _ -> ('\xfffd' <$)) diff --git a/src/Data/Syntax/Comment.hs b/src/Data/Syntax/Comment.hs index 41a991900..1204e95a1 100644 --- a/src/Data/Syntax/Comment.hs +++ b/src/Data/Syntax/Comment.hs @@ -5,9 +5,7 @@ import Algorithm import Data.Align.Generic import Data.ByteString (ByteString) import Data.Functor.Classes.Eq.Generic -import Data.Functor.Classes.Pretty.Generic import Data.Functor.Classes.Show.Generic -import Data.Syntax (prettyBytes) import GHC.Generics -- | An unnested comment (line or block). @@ -17,9 +15,6 @@ newtype Comment a = Comment { commentContent :: ByteString } instance Eq1 Comment where liftEq = genericLiftEq instance Show1 Comment where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Comment where - liftPretty _ _ (Comment c) = pretty ("Comment" :: String) <+> prettyBytes c - -- TODO: nested comment types -- TODO: documentation comment types -- TODO: literate programming comment types? alternatively, consider those as markup diff --git a/src/Data/Syntax/Declaration.hs b/src/Data/Syntax/Declaration.hs index 9c9f1b021..8f5c41e83 100644 --- a/src/Data/Syntax/Declaration.hs +++ b/src/Data/Syntax/Declaration.hs @@ -4,7 +4,6 @@ module Data.Syntax.Declaration where import Algorithm import Data.Align.Generic import Data.Functor.Classes.Eq.Generic -import Data.Functor.Classes.Pretty.Generic import Data.Functor.Classes.Show.Generic import GHC.Generics @@ -13,7 +12,6 @@ data Function a = Function { functionName :: !a, functionParameters :: ![a], fun instance Eq1 Function where liftEq = genericLiftEq instance Show1 Function where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Function where liftPretty = genericLiftPretty -- TODO: How should we represent function types, where applicable? @@ -22,7 +20,6 @@ data Method a = Method { methodReceiver :: !a, methodName :: !a, methodParameter instance Eq1 Method where liftEq = genericLiftEq instance Show1 Method where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Method where liftPretty = genericLiftPretty -- TODO: Should we replace this with Function and differentiate by context? -- TODO: How should we distinguish class/instance methods? @@ -32,7 +29,6 @@ data Variable a = Variable { variableName :: !a, variableType :: !a, variableVal instance Eq1 Variable where liftEq = genericLiftEq instance Show1 Variable where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Variable where liftPretty = genericLiftPretty data Class a = Class { classIdentifier :: !a, classSuperclasses :: ![a], classBody :: ![a] } @@ -40,7 +36,6 @@ data Class a = Class { classIdentifier :: !a, classSuperclasses :: ![a], classBo instance Eq1 Class where liftEq = genericLiftEq instance Show1 Class where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Class where liftPretty = genericLiftPretty data Module a = Module { moduleIdentifier :: !a, moduleScope :: ![a] } @@ -48,7 +43,6 @@ data Module a = Module { moduleIdentifier :: !a, moduleScope :: ![a] } instance Eq1 Module where liftEq = genericLiftEq instance Show1 Module where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Module where liftPretty = genericLiftPretty -- | A decorator in Python @@ -57,7 +51,6 @@ data Decorator a = Decorator { decoratorIdentifier :: !a, decoratorParamaters :: instance Eq1 Decorator where liftEq = genericLiftEq instance Show1 Decorator where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Decorator where liftPretty = genericLiftPretty -- TODO: Generics, constraints. @@ -68,7 +61,6 @@ data Datatype a = Datatype { datatypeName :: !a, datatypeConstructors :: ![a] } instance Eq1 Data.Syntax.Declaration.Datatype where liftEq = genericLiftEq instance Show1 Data.Syntax.Declaration.Datatype where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Data.Syntax.Declaration.Datatype where liftPretty = genericLiftPretty -- | A single constructor in a datatype, or equally a 'struct' in C, Rust, or Swift. data Constructor a = Constructor { constructorName :: !a, constructorFields :: ![a] } @@ -76,7 +68,6 @@ data Constructor a = Constructor { constructorName :: !a, constructorFields :: ! instance Eq1 Data.Syntax.Declaration.Constructor where liftEq = genericLiftEq instance Show1 Data.Syntax.Declaration.Constructor where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Data.Syntax.Declaration.Constructor where liftPretty = genericLiftPretty -- | Comprehension (e.g. ((a for b in c if a()) in Python) @@ -85,7 +76,6 @@ data Comprehension a = Comprehension { comprehensionValue :: !a, comprehensionBo instance Eq1 Comprehension where liftEq = genericLiftEq instance Show1 Comprehension where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Comprehension where liftPretty = genericLiftPretty -- | Import declarations. @@ -94,4 +84,3 @@ data Import a = Import { importContent :: ![a] } instance Eq1 Import where liftEq = genericLiftEq instance Show1 Import where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Import where liftPretty = genericLiftPretty diff --git a/src/Data/Syntax/Expression.hs b/src/Data/Syntax/Expression.hs index 4bf66e959..3fb78ef4d 100644 --- a/src/Data/Syntax/Expression.hs +++ b/src/Data/Syntax/Expression.hs @@ -4,7 +4,6 @@ module Data.Syntax.Expression where import Algorithm import Data.Align.Generic import Data.Functor.Classes.Eq.Generic -import Data.Functor.Classes.Pretty.Generic import Data.Functor.Classes.Show.Generic import GHC.Generics @@ -14,7 +13,6 @@ data Call a = Call { callFunction :: !a, callParams :: ![a], callBlock :: !a } instance Eq1 Call where liftEq = genericLiftEq instance Show1 Call where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Call where liftPretty = genericLiftPretty data Comparison a @@ -28,7 +26,6 @@ data Comparison a instance Eq1 Comparison where liftEq = genericLiftEq instance Show1 Comparison where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Comparison where liftPretty = genericLiftPretty -- | Binary arithmetic operators. @@ -44,7 +41,6 @@ data Arithmetic a instance Eq1 Arithmetic where liftEq = genericLiftEq instance Show1 Arithmetic where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Arithmetic where liftPretty = genericLiftPretty -- | Boolean operators. data Boolean a @@ -55,7 +51,6 @@ data Boolean a instance Eq1 Boolean where liftEq = genericLiftEq instance Show1 Boolean where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Boolean where liftPretty = genericLiftPretty -- | Bitwise operators. data Bitwise a @@ -69,7 +64,6 @@ data Bitwise a instance Eq1 Bitwise where liftEq = genericLiftEq instance Show1 Bitwise where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Bitwise where liftPretty = genericLiftPretty -- | Member Access (e.g. a.b) data MemberAccess a @@ -78,7 +72,6 @@ data MemberAccess a instance Eq1 MemberAccess where liftEq = genericLiftEq instance Show1 MemberAccess where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 MemberAccess where liftPretty = genericLiftPretty -- | Subscript (e.g a[1]) data Subscript a @@ -88,7 +81,6 @@ data Subscript a instance Eq1 Subscript where liftEq = genericLiftEq instance Show1 Subscript where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Subscript where liftPretty = genericLiftPretty -- | Enumeration (e.g. a[1:10:1] in Python (start at index 1, stop at index 10, step 1 element from start to stop)) data Enumeration a = Enumeration { enumerationStart :: !a, enumerationEnd :: !a, enumerationStep :: !a } @@ -96,7 +88,6 @@ data Enumeration a = Enumeration { enumerationStart :: !a, enumerationEnd :: !a, instance Eq1 Enumeration where liftEq = genericLiftEq instance Show1 Enumeration where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Enumeration where liftPretty = genericLiftPretty -- | ScopeResolution (e.g. import a.b in Python or a::b in C++) data ScopeResolution a @@ -105,4 +96,3 @@ data ScopeResolution a instance Eq1 ScopeResolution where liftEq = genericLiftEq instance Show1 ScopeResolution where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 ScopeResolution where liftPretty = genericLiftPretty diff --git a/src/Data/Syntax/Literal.hs b/src/Data/Syntax/Literal.hs index 3da5fd25c..dbdbcf85d 100644 --- a/src/Data/Syntax/Literal.hs +++ b/src/Data/Syntax/Literal.hs @@ -5,9 +5,7 @@ import Algorithm import Data.Align.Generic import Data.ByteString (ByteString) import Data.Functor.Classes.Eq.Generic -import Data.Functor.Classes.Pretty.Generic import Data.Functor.Classes.Show.Generic -import Data.Syntax (prettyBytes) import GHC.Generics import Prelude @@ -24,7 +22,6 @@ false = Boolean False instance Eq1 Boolean where liftEq = genericLiftEq instance Show1 Boolean where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Boolean where liftPretty = genericLiftPretty -- Numeric @@ -36,9 +33,6 @@ newtype Integer a = Integer { integerContent :: ByteString } instance Eq1 Data.Syntax.Literal.Integer where liftEq = genericLiftEq instance Show1 Data.Syntax.Literal.Integer where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Data.Syntax.Literal.Integer where - liftPretty _ _ (Integer s) = pretty ("Integer" :: Prelude.String) <+> prettyBytes s - -- TODO: Should IntegerLiteral hold an Integer instead of a ByteString? -- TODO: Do we care about differentiating between hex/octal/decimal/binary integer literals? -- TODO: Consider a Numeric datatype with FloatingPoint/Integral/etc constructors. @@ -50,9 +44,6 @@ newtype Float a = Float { floatContent :: ByteString } instance Eq1 Data.Syntax.Literal.Float where liftEq = genericLiftEq instance Show1 Data.Syntax.Literal.Float where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Data.Syntax.Literal.Float where - liftPretty _ _ (Float s) = pretty ("Float" :: Prelude.String) <+> prettyBytes s - -- Rational literals e.g. `2/3r` newtype Rational a = Rational ByteString deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable) @@ -60,9 +51,6 @@ newtype Rational a = Rational ByteString instance Eq1 Data.Syntax.Literal.Rational where liftEq = genericLiftEq instance Show1 Data.Syntax.Literal.Rational where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Data.Syntax.Literal.Rational where - liftPretty _ _ (Rational s) = pretty ("Rational" :: Prelude.String) <+> prettyBytes s - -- Complex literals e.g. `3 + 2i` newtype Complex a = Complex ByteString deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable) @@ -70,9 +58,6 @@ newtype Complex a = Complex ByteString instance Eq1 Data.Syntax.Literal.Complex where liftEq = genericLiftEq instance Show1 Data.Syntax.Literal.Complex where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Complex where - liftPretty _ _ (Complex s) = pretty ("Complex" :: Prelude.String) <+> prettyBytes s - -- Strings, symbols @@ -81,7 +66,6 @@ newtype String a = String { stringElements :: [a] } instance Eq1 Data.Syntax.Literal.String where liftEq = genericLiftEq instance Show1 Data.Syntax.Literal.String where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Data.Syntax.Literal.String where liftPretty = genericLiftPretty -- TODO: Should string literal bodies include escapes too? @@ -91,7 +75,6 @@ newtype InterpolationElement a = InterpolationElement { interpolationBody :: a } instance Eq1 InterpolationElement where liftEq = genericLiftEq instance Show1 InterpolationElement where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 InterpolationElement where liftPretty = genericLiftPretty -- | A sequence of textual contents within a string literal. @@ -101,15 +84,11 @@ newtype TextElement a = TextElement { textElementContent :: ByteString } instance Eq1 TextElement where liftEq = genericLiftEq instance Show1 TextElement where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 TextElement where - liftPretty _ _ (TextElement s) = pretty ("TextElement" :: Prelude.String) <+> prettyBytes s - data Null a = Null deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable) instance Eq1 Null where liftEq = genericLiftEq instance Show1 Null where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Null where liftPretty = genericLiftPretty newtype Symbol a = Symbol { symbolContent :: ByteString } deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable) @@ -117,9 +96,6 @@ newtype Symbol a = Symbol { symbolContent :: ByteString } instance Eq1 Symbol where liftEq = genericLiftEq instance Show1 Symbol where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Symbol where - liftPretty _ _ (Symbol s) = pretty ("Symbol" :: Prelude.String) <+> prettyBytes s - -- TODO: Heredoc-style string literals? -- TODO: Character literals. -- TODO: Regular expressions. @@ -132,7 +108,6 @@ newtype Array a = Array { arrayElements :: [a] } instance Eq1 Array where liftEq = genericLiftEq instance Show1 Array where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Array where liftPretty = genericLiftPretty newtype Hash a = Hash { hashElements :: [a] } @@ -140,14 +115,12 @@ newtype Hash a = Hash { hashElements :: [a] } instance Eq1 Hash where liftEq = genericLiftEq instance Show1 Hash where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Hash where liftPretty = genericLiftPretty data KeyValue a = KeyValue { key :: !a, value :: !a } deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable) instance Eq1 KeyValue where liftEq = genericLiftEq instance Show1 KeyValue where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 KeyValue where liftPretty = genericLiftPretty newtype Tuple a = Tuple { tupleContents :: [a]} @@ -155,7 +128,6 @@ newtype Tuple a = Tuple { tupleContents :: [a]} instance Eq1 Tuple where liftEq = genericLiftEq instance Show1 Tuple where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Tuple where liftPretty = genericLiftPretty newtype Set a = Set { setElements :: [a] } @@ -163,7 +135,6 @@ newtype Set a = Set { setElements :: [a] } instance Eq1 Set where liftEq = genericLiftEq instance Show1 Set where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Set where liftPretty = genericLiftPretty -- TODO: Object literals as distinct from hash literals? Or coalesce object/hash literals into “key-value literals”? -- TODO: Function literals (lambdas, procs, anonymous functions, what have you). diff --git a/src/Data/Syntax/Markup.hs b/src/Data/Syntax/Markup.hs index 93bc7e298..953e5b61d 100644 --- a/src/Data/Syntax/Markup.hs +++ b/src/Data/Syntax/Markup.hs @@ -5,10 +5,7 @@ import Algorithm import Data.Align.Generic import Data.ByteString (ByteString) import Data.Functor.Classes.Eq.Generic -import Data.Functor.Classes.Pretty.Generic import Data.Functor.Classes.Show.Generic -import Data.Maybe (catMaybes) -import Data.Syntax (prettyBytes) import GHC.Generics @@ -17,7 +14,6 @@ newtype Document a = Document [a] instance Eq1 Document where liftEq = genericLiftEq instance Show1 Document where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Document where liftPretty = genericLiftPretty -- Block elements @@ -27,49 +23,42 @@ newtype Paragraph a = Paragraph [a] instance Eq1 Paragraph where liftEq = genericLiftEq instance Show1 Paragraph where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Paragraph where liftPretty = genericLiftPretty data Section a = Section { sectionLevel :: Int, sectionHeading :: a, sectionContent :: [a] } deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable) instance Eq1 Section where liftEq = genericLiftEq instance Show1 Section where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Section where liftPretty = genericLiftPretty data Heading a = Heading { headingLevel :: Int, headingContent :: [a] } deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable) instance Eq1 Heading where liftEq = genericLiftEq instance Show1 Heading where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Heading where liftPretty = genericLiftPretty newtype UnorderedList a = UnorderedList [a] deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable) instance Eq1 UnorderedList where liftEq = genericLiftEq instance Show1 UnorderedList where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 UnorderedList where liftPretty = genericLiftPretty newtype OrderedList a = OrderedList [a] deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable) instance Eq1 OrderedList where liftEq = genericLiftEq instance Show1 OrderedList where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 OrderedList where liftPretty = genericLiftPretty newtype BlockQuote a = BlockQuote [a] deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable) instance Eq1 BlockQuote where liftEq = genericLiftEq instance Show1 BlockQuote where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 BlockQuote where liftPretty = genericLiftPretty data ThematicBreak a = ThematicBreak deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable) instance Eq1 ThematicBreak where liftEq = genericLiftEq instance Show1 ThematicBreak where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 ThematicBreak where liftPretty = genericLiftPretty data HTMLBlock a = HTMLBlock ByteString deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable) @@ -77,29 +66,23 @@ data HTMLBlock a = HTMLBlock ByteString instance Eq1 HTMLBlock where liftEq = genericLiftEq instance Show1 HTMLBlock where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 HTMLBlock where - liftPretty _ _ (HTMLBlock s) = pretty ("HTMLBlock" :: String) <+> prettyBytes s - newtype Table a = Table [a] deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable) instance Eq1 Table where liftEq = genericLiftEq instance Show1 Table where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Table where liftPretty = genericLiftPretty newtype TableRow a = TableRow [a] deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable) instance Eq1 TableRow where liftEq = genericLiftEq instance Show1 TableRow where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 TableRow where liftPretty = genericLiftPretty newtype TableCell a = TableCell [a] deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable) instance Eq1 TableCell where liftEq = genericLiftEq instance Show1 TableCell where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 TableCell where liftPretty = genericLiftPretty -- Inline elements @@ -109,14 +92,12 @@ newtype Strong a = Strong [a] instance Eq1 Strong where liftEq = genericLiftEq instance Show1 Strong where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Strong where liftPretty = genericLiftPretty newtype Emphasis a = Emphasis [a] deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable) instance Eq1 Emphasis where liftEq = genericLiftEq instance Show1 Emphasis where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Emphasis where liftPretty = genericLiftPretty newtype Text a = Text ByteString deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable) @@ -124,45 +105,32 @@ newtype Text a = Text ByteString instance Eq1 Text where liftEq = genericLiftEq instance Show1 Text where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Text where - liftPretty _ _ (Text s) = pretty ("Text" :: String) <+> prettyBytes s - data Link a = Link { linkURL :: ByteString, linkTitle :: Maybe ByteString } deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable) instance Eq1 Link where liftEq = genericLiftEq instance Show1 Link where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Link where - liftPretty _ _ (Link u t) = pretty ("Link" :: String) <+> prettyBytes u <+> liftPretty prettyBytes (list . map prettyBytes) t - data Image a = Image { imageURL :: ByteString, imageTitle :: Maybe ByteString } deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable) instance Eq1 Image where liftEq = genericLiftEq instance Show1 Image where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Image where - liftPretty _ _ (Image u t) = pretty ("Image" :: String) <+> prettyBytes u <+> liftPretty prettyBytes (list . map prettyBytes) t - data Code a = Code { codeLanguage :: Maybe ByteString, codeContent :: ByteString } deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable) instance Eq1 Code where liftEq = genericLiftEq instance Show1 Code where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Code where - liftPretty _ _ (Code l c) = nest 2 (vsep (catMaybes [Just (pretty ("Code" :: String)), fmap prettyBytes l, Just (prettyBytes c)])) data LineBreak a = LineBreak deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable) instance Eq1 LineBreak where liftEq = genericLiftEq instance Show1 LineBreak where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 LineBreak where liftPretty = genericLiftPretty newtype Strikethrough a = Strikethrough [a] deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable) instance Eq1 Strikethrough where liftEq = genericLiftEq instance Show1 Strikethrough where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Strikethrough where liftPretty = genericLiftPretty diff --git a/src/Data/Syntax/Statement.hs b/src/Data/Syntax/Statement.hs index f00e4fe65..5d79c4cdf 100644 --- a/src/Data/Syntax/Statement.hs +++ b/src/Data/Syntax/Statement.hs @@ -4,7 +4,6 @@ module Data.Syntax.Statement where import Algorithm import Data.Align.Generic import Data.Functor.Classes.Eq.Generic -import Data.Functor.Classes.Pretty.Generic import Data.Functor.Classes.Show.Generic import GHC.Generics @@ -14,7 +13,6 @@ data If a = If { ifCondition :: !a, ifThenBody :: !a, ifElseBody :: !a } instance Eq1 If where liftEq = genericLiftEq instance Show1 If where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 If where liftPretty = genericLiftPretty -- | Else statement. The else condition is any term, that upon successful completion, continues evaluation to the elseBody, e.g. `for ... else` in Python. data Else a = Else { elseCondition :: !a, elseBody :: !a } @@ -22,7 +20,6 @@ data Else a = Else { elseCondition :: !a, elseBody :: !a } instance Eq1 Else where liftEq = genericLiftEq instance Show1 Else where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Else where liftPretty = genericLiftPretty -- TODO: Alternative definition would flatten if/else if/else chains: data If a = If ![(a, a)] !(Maybe a) @@ -32,7 +29,6 @@ data Match a = Match { matchSubject :: !a, matchPatterns :: !a } instance Eq1 Match where liftEq = genericLiftEq instance Show1 Match where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Match where liftPretty = genericLiftPretty -- | A pattern in a pattern-matching or computed jump control-flow statement, like 'case' in C or JavaScript, 'when' in Ruby, or the left-hand side of '->' in the body of Haskell 'case' expressions. data Pattern a = Pattern { pattern :: !a, patternBody :: !a } @@ -40,7 +36,6 @@ data Pattern a = Pattern { pattern :: !a, patternBody :: !a } instance Eq1 Pattern where liftEq = genericLiftEq instance Show1 Pattern where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Pattern where liftPretty = genericLiftPretty -- | A let statement or local binding, like 'a as b' or 'let a = b'. data Let a = Let { letVariable :: !a, letValue :: !a, letBody :: !a } @@ -48,7 +43,6 @@ data Let a = Let { letVariable :: !a, letValue :: !a, letBody :: !a } instance Eq1 Let where liftEq = genericLiftEq instance Show1 Let where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Let where liftPretty = genericLiftPretty -- Assignment @@ -59,7 +53,6 @@ data Assignment a = Assignment { assignmentTarget :: !a, assignmentValue :: !a } instance Eq1 Assignment where liftEq = genericLiftEq instance Show1 Assignment where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Assignment where liftPretty = genericLiftPretty -- Returns @@ -69,42 +62,36 @@ newtype Return a = Return a instance Eq1 Return where liftEq = genericLiftEq instance Show1 Return where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Return where liftPretty = genericLiftPretty newtype Yield a = Yield a deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable) instance Eq1 Yield where liftEq = genericLiftEq instance Show1 Yield where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Yield where liftPretty = genericLiftPretty newtype Break a = Break a deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable) instance Eq1 Break where liftEq = genericLiftEq instance Show1 Break where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Break where liftPretty = genericLiftPretty newtype Continue a = Continue a deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable) instance Eq1 Continue where liftEq = genericLiftEq instance Show1 Continue where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Continue where liftPretty = genericLiftPretty newtype Retry a = Retry a deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable) instance Eq1 Retry where liftEq = genericLiftEq instance Show1 Retry where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Retry where liftPretty = genericLiftPretty newtype NoOp a = NoOp a deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable) instance Eq1 NoOp where liftEq = genericLiftEq instance Show1 NoOp where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 NoOp where liftPretty = genericLiftPretty -- Loops @@ -114,28 +101,24 @@ data For a = For { forBefore :: !a, forCondition :: !a, forStep :: !a, forBody : instance Eq1 For where liftEq = genericLiftEq instance Show1 For where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 For where liftPretty = genericLiftPretty data ForEach a = ForEach { forEachBinding :: !a, forEachSubject :: !a, forEachBody :: !a } deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable) instance Eq1 ForEach where liftEq = genericLiftEq instance Show1 ForEach where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 ForEach where liftPretty = genericLiftPretty data While a = While { whileCondition :: !a, whileBody :: !a } deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable) instance Eq1 While where liftEq = genericLiftEq instance Show1 While where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 While where liftPretty = genericLiftPretty data DoWhile a = DoWhile { doWhileCondition :: !a, doWhileBody :: !a } deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable) instance Eq1 DoWhile where liftEq = genericLiftEq instance Show1 DoWhile where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 DoWhile where liftPretty = genericLiftPretty -- Exception handling @@ -145,28 +128,24 @@ newtype Throw a = Throw a instance Eq1 Throw where liftEq = genericLiftEq instance Show1 Throw where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Throw where liftPretty = genericLiftPretty data Try a = Try { tryBody :: !a, tryCatch :: ![a] } deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable) instance Eq1 Try where liftEq = genericLiftEq instance Show1 Try where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Try where liftPretty = genericLiftPretty data Catch a = Catch { catchException :: !a, catchBody :: !a } deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable) instance Eq1 Catch where liftEq = genericLiftEq instance Show1 Catch where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Catch where liftPretty = genericLiftPretty newtype Finally a = Finally a deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable) instance Eq1 Finally where liftEq = genericLiftEq instance Show1 Finally where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Finally where liftPretty = genericLiftPretty -- | ScopeEntry (e.g. `BEGIN {}` block in Ruby or Perl). @@ -175,7 +154,6 @@ newtype ScopeEntry a = ScopeEntry [a] instance Eq1 ScopeEntry where liftEq = genericLiftEq instance Show1 ScopeEntry where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 ScopeEntry where liftPretty = genericLiftPretty -- | ScopeExit (e.g. `END {}` block in Ruby or Perl). @@ -184,4 +162,3 @@ newtype ScopeExit a = ScopeExit [a] instance Eq1 ScopeExit where liftEq = genericLiftEq instance Show1 ScopeExit where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 ScopeExit where liftPretty = genericLiftPretty diff --git a/src/Data/Syntax/Type.hs b/src/Data/Syntax/Type.hs index 36d94b576..b2431b4d0 100644 --- a/src/Data/Syntax/Type.hs +++ b/src/Data/Syntax/Type.hs @@ -4,7 +4,6 @@ module Data.Syntax.Type where import Algorithm import Data.Align.Generic import Data.Functor.Classes.Eq.Generic -import Data.Functor.Classes.Pretty.Generic import Data.Functor.Classes.Show.Generic import GHC.Generics @@ -13,11 +12,9 @@ data Annotation a = Annotation { annotationSubject :: !a, annotationType :: !a } instance Eq1 Annotation where liftEq = genericLiftEq instance Show1 Annotation where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Annotation where liftPretty = genericLiftPretty newtype Product a = Product { productElements :: [a] } deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable) instance Eq1 Product where liftEq = genericLiftEq instance Show1 Product where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Product where liftPretty = genericLiftPretty diff --git a/src/Diff.hs b/src/Diff.hs index 444c7979e..d6c6b5388 100644 --- a/src/Diff.hs +++ b/src/Diff.hs @@ -8,7 +8,6 @@ import qualified Control.Monad.Free as Free import qualified Control.Monad.Trans.Free as FreeF import Data.Bifunctor import Data.Functor.Both as Both -import Data.Functor.Classes.Pretty.Generic import Data.Mergeable import Data.Record import Patch @@ -64,11 +63,3 @@ free (FreeF.Pure a) = Free.Pure a runFree :: Free.Free f a -> FreeF.FreeF f a (Free.Free f a) runFree (Free.Free f) = FreeF.Free f runFree (Free.Pure a) = FreeF.Pure a - - -instance Pretty1 f => Pretty1 (Free.Free f) where - liftPretty p pl = go where go (Free.Pure a) = p a - go (Free.Free f) = liftPretty go (list . map (liftPretty p pl)) f - -instance (Pretty1 f, Pretty a) => Pretty (Free.Free f a) where - pretty = liftPretty pretty prettyList diff --git a/src/Language/Python/Syntax.hs b/src/Language/Python/Syntax.hs index c19849e76..22b323311 100644 --- a/src/Language/Python/Syntax.hs +++ b/src/Language/Python/Syntax.hs @@ -10,7 +10,6 @@ import Algorithm import Data.Align.Generic import Data.Functor (void) import Data.Functor.Classes.Eq.Generic -import Data.Functor.Classes.Pretty.Generic import Data.Functor.Classes.Show.Generic import Data.List.NonEmpty (some1) import Data.Maybe (fromMaybe) @@ -94,7 +93,6 @@ data Ellipsis a = Ellipsis instance Eq1 Ellipsis where liftEq = genericLiftEq instance Show1 Ellipsis where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Ellipsis where liftPretty = genericLiftPretty data Redirect a = Redirect !a !a @@ -102,7 +100,6 @@ data Redirect a = Redirect !a !a instance Eq1 Redirect where liftEq = genericLiftEq instance Show1 Redirect where liftShowsPrec = genericLiftShowsPrec -instance Pretty1 Redirect where liftPretty = genericLiftPretty -- | Assignment from AST in Python's grammar onto a program in Python's syntax. assignment :: Assignment diff --git a/src/Patch.hs b/src/Patch.hs index d67ced4a7..40af27f78 100644 --- a/src/Patch.hs +++ b/src/Patch.hs @@ -16,7 +16,6 @@ module Patch import Control.DeepSeq import Data.Align -import Data.Functor.Classes.Pretty.Generic import Data.Functor.Listable import Data.These import GHC.Generics @@ -88,8 +87,3 @@ instance Crosswalk Patch where crosswalk f (Replace a b) = alignWith (these Delete Insert Replace) (f a) (f b) crosswalk f (Insert b) = Insert <$> f b crosswalk f (Delete a) = Delete <$> f a - -instance Pretty1 Patch where liftPretty = genericLiftPretty - -instance Pretty a => Pretty (Patch a) where - pretty = liftPretty pretty prettyList diff --git a/src/Semantic/Util.hs b/src/Semantic/Util.hs index 7f9babef1..853050a4b 100644 --- a/src/Semantic/Util.hs +++ b/src/Semantic/Util.hs @@ -1,12 +1,8 @@ module Semantic.Util where import Data.Blob -import Data.Text.Prettyprint.Doc -import Data.Text.Prettyprint.Doc.Util import Files -pp :: Pretty a => a -> IO () -pp = putDocW 100 . (<> line) . pretty file :: FilePath -> IO Blob file path = Files.readFile path (languageForFilePath path) diff --git a/src/Syntax.hs b/src/Syntax.hs index b04d80f69..ac319f4d4 100644 --- a/src/Syntax.hs +++ b/src/Syntax.hs @@ -6,7 +6,6 @@ import Data.Aeson import Data.Align.Generic import Data.Functor.Classes import Data.Functor.Classes.Eq.Generic -import Data.Functor.Classes.Pretty.Generic import Data.Functor.Listable import Data.Mergeable import Data.Text (pack, Text) @@ -183,5 +182,3 @@ instance Listable recur => Listable (Syntax recur) where instance Eq1 Syntax where liftEq = genericLiftEq - -instance Pretty1 Syntax where liftPretty = genericLiftPretty diff --git a/src/Term.hs b/src/Term.hs index 918d3d304..f9ac226d5 100644 --- a/src/Term.hs +++ b/src/Term.hs @@ -19,13 +19,10 @@ import Control.DeepSeq import Control.Monad.Free import Data.Align.Generic import Data.Functor.Both -import Data.Functor.Classes.Pretty.Generic import Data.Functor.Foldable import Data.Maybe -import Data.Proxy import Data.Record import Data.These -import Data.Union import Syntax -- | A Term with an abstract syntax tree and an annotation. @@ -71,13 +68,3 @@ cofree (a CofreeF.:< f) = a Cofree.:< f runCofree :: Cofree.Cofree f a -> CofreeF.CofreeF f a (Cofree.Cofree f a) runCofree (a Cofree.:< f) = a CofreeF.:< f - - -instance Pretty1 f => Pretty1 (Cofree.Cofree f) where - liftPretty p pl = go where go (a Cofree.:< f) = p a <+> liftPretty go (list . map (liftPretty p pl)) f - -instance (Pretty1 f, Pretty a) => Pretty (Cofree.Cofree f a) where - pretty = liftPretty pretty prettyList - -instance Apply1 Pretty1 fs => Pretty1 (Union fs) where - liftPretty p pl = apply1 (Proxy :: Proxy Pretty1) (liftPretty p pl) diff --git a/vendor/prettyprinter b/vendor/prettyprinter deleted file mode 160000 index ec0e4825b..000000000 --- a/vendor/prettyprinter +++ /dev/null @@ -1 +0,0 @@ -Subproject commit ec0e4825b18b5d43511396b03aac12b388c4ee02 From 9d2469a2bff10c1513059dd417dd86322167ae87 Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Tue, 12 Sep 2017 15:40:44 -0700 Subject: [PATCH 4/5] Add pretty-show / colourised `pp` function --- src/Semantic/Util.hs | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/src/Semantic/Util.hs b/src/Semantic/Util.hs index 853050a4b..57bcd5026 100644 --- a/src/Semantic/Util.hs +++ b/src/Semantic/Util.hs @@ -1,8 +1,14 @@ module Semantic.Util where import Data.Blob +import Language.Haskell.HsColour (hscolour, Output(TTY)) +import Language.Haskell.HsColour.Colourise (defaultColourPrefs) +import Text.Show.Pretty (ppShow) import Files +-- Produces colorized pretty-printed output for the terminal / GHCi. +pp :: Show a => a -> IO () +pp = putStrLn . hscolour TTY defaultColourPrefs False False "" False . ppShow file :: FilePath -> IO Blob file path = Files.readFile path (languageForFilePath path) From 725c2fcd301c900522841eb72c2fda8719cde7d5 Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Tue, 12 Sep 2017 17:47:50 -0700 Subject: [PATCH 5/5] Import Semigroup; remove unused imports --- src/Diff.hs | 2 +- src/Term.hs | 4 +--- 2 files changed, 2 insertions(+), 4 deletions(-) diff --git a/src/Diff.hs b/src/Diff.hs index a0ab71e9b..cc92173da 100644 --- a/src/Diff.hs +++ b/src/Diff.hs @@ -12,7 +12,7 @@ import Data.Functor.Foldable hiding (fold) import Data.JSON.Fields import Data.Mergeable import Data.Record -import Data.Union +import Data.Semigroup((<>)) import Patch import Syntax import Term diff --git a/src/Term.hs b/src/Term.hs index 94e0ec803..1784c23e0 100644 --- a/src/Term.hs +++ b/src/Term.hs @@ -10,7 +10,6 @@ module Term , unwrap , hoistTerm , stripTerm -, liftPrettyUnion ) where import Control.Comonad @@ -22,9 +21,8 @@ import Data.Bitraversable import Data.Functor.Classes import Data.Functor.Foldable import Data.JSON.Fields -import Data.Proxy import Data.Record -import Data.Union +import Data.Semigroup ((<>)) import Syntax import Text.Show