Skip to content

Commit d6fff9b

Browse files
adithyaovadithyaov
committed
Make the prettification very specific
1 parent b11a50c commit d6fff9b

File tree

4 files changed

+138
-48
lines changed

4 files changed

+138
-48
lines changed

‎cli/Main.hs‎

Lines changed: 30 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -8,13 +8,13 @@ module Main
88

99
import Control.Monad (when)
1010
import Data.Function ((&))
11-
-- import Data.List (isInfixOf, foldl1)
11+
import Data.List (isInfixOf)
1212
import Streamly.Data.Stream (Stream)
1313
import System.Environment (getArgs)
1414

1515
-- import Debug.Trace (trace)
1616

17-
-- import qualified Data.Map as Map
17+
import qualified Data.Map as Map
1818
import qualified Streamly.Data.Fold as Fold
1919
import qualified Streamly.Data.Stream as Stream
2020
import qualified Streamly.Internal.FileSystem.File as File
@@ -70,6 +70,17 @@ fileToLines path =
7070
File.readChunks path & Unicode.decodeUtf8Chunks
7171
& Stream.foldMany (Fold.takeEndBy_ (== '\n') Fold.toList)
7272

73+
isDeprecated :: [Annotation] -> Bool
74+
isDeprecated anns =
75+
let f x =
76+
case x of
77+
Deprecated _ -> True
78+
_ -> False
79+
in not $ null $ filter f anns
80+
81+
isInternal :: ModuleName -> Bool
82+
isInternal x = "Internal" `isInfixOf` x
83+
7384
main :: IO ()
7485
main = do
7586
args <- getArgs
@@ -107,7 +118,23 @@ main = do
107118
, ELTypeAliases
108119
, ELFunctions
109120
]
110-
putStrLn $ prettyAPI elems (diffAPI api1 api2)
121+
let isDeprecatedInBoth (Tagged (Attach (DBoth annl annr) _) _) =
122+
isDeprecated annl && isDeprecated annr
123+
isDeprecatedInBoth _ = False
124+
125+
isDeprecatedInLeft (Tagged (Attach (DLeft anns) _) _) =
126+
isDeprecated anns
127+
isDeprecatedInLeft (Tagged (Attach (DBoth anns _) _) _) =
128+
isDeprecated anns
129+
isDeprecatedInLeft _ = False
130+
131+
let diff =
132+
let filt k v =
133+
not (isInternal k)
134+
&& not (isDeprecatedInBoth v || isDeprecatedInLeft v)
135+
in Map.filterWithKey filt (diffAPI api1 api2)
136+
137+
putStrLn $ prettyAPI elems diff
111138

112139
-- TODO:
113140

‎packdiff.cabal‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -51,5 +51,6 @@ executable packdiff
5151
, streamly-core == 0.1.0.*
5252
, streamly-process == 0.2.0.*
5353
, packdiff
54+
, containers
5455
hs-source-dirs: cli
5556
default-language: Haskell2010

‎src/HoogleFileParser.hs‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -345,7 +345,7 @@ haddockParseFold tag3 tag2 tag1 = extract <$> Fold.foldl' step initial
345345
mCtxAp doc2 api mname (tCtxAp doc1 mctx dname dctx)
346346

347347
initial = ("", PNone Map.empty)
348-
getAfterTypeCtx = reverse . takeWhile (/= '>') . reverse
348+
getAfterTypeCtx = reverse . takeWhile (/= '>') . reverse . dropWord
349349
getW1AfterTypeCtx = takeWord . getAfterTypeCtx
350350
getRestAfterTypeCtx = stripBegin . dropWord . getAfterTypeCtx
351351
getClassName = getW1AfterTypeCtx
@@ -384,7 +384,7 @@ haddockParseFold tag3 tag2 tag1 = extract <$> Fold.foldl' step initial
384384
let singMap =
385385
Tagged (Attach "" tag2)
386386
$ Map.singleton
387-
(getInstanceOf line)
387+
(getInstanceFor line)
388388
(mapperStr doc line)
389389

390390
insertF (Tagged (Attach "" _) a) (Tagged (Attach "" _) b) =
@@ -396,7 +396,7 @@ haddockParseFold tag3 tag2 tag1 = extract <$> Fold.foldl' step initial
396396
{ mInstances =
397397
SMap.insertWith
398398
insertF
399-
(getInstanceFor line)
399+
(getInstanceOf line)
400400
singMap
401401
(mInstances ctx)
402402
}

‎src/Pretty.hs‎

Lines changed: 104 additions & 42 deletions
Original file line numberDiff line numberDiff line change
@@ -30,6 +30,100 @@ prettyTag Removed = "[R]"
3030
prettyTag Same = "[S]"
3131
prettyTag (Changed _) = "[C]"
3232

33+
isDeprecated :: [Annotation] -> Bool
34+
isDeprecated anns =
35+
let f x =
36+
case x of
37+
Deprecated _ -> True
38+
_ -> False
39+
in not $ null $ filter f anns
40+
41+
-- Don't print if deprecated in Left
42+
-- Error out if deprecated in Left and not deprecated in Right
43+
-- Error out if deprecated in Right and Added
44+
prettyD0_ ::
45+
String
46+
-> Tagged (Attach (Diff [Annotation]) (StatusTag EntityContextType)) EntityContextType
47+
-> [String]
48+
prettyD0_ _ (Tagged (Attach (DLeft anns) Removed) b) =
49+
if isDeprecated anns
50+
then [""]
51+
else ["[R] " ++ showECT b]
52+
prettyD0_ _ (Tagged (Attach (DRight anns) Added) b) =
53+
if isDeprecated anns
54+
then [""]
55+
else ["[A] " ++ showECT b]
56+
prettyD0_ k (Tagged (Attach (DBoth annsL annsR) (Changed b1)) b) =
57+
if isDeprecated annsR && isDeprecated annsL
58+
then [""]
59+
else if isDeprecated annsR && not (isDeprecated annsL)
60+
then ["[D] " ++ showECT b1]
61+
else if not (isDeprecated annsR) && isDeprecated annsL
62+
then [""]
63+
else if b1 == b
64+
then [""]
65+
else concat
66+
[ ["[C] " ++ k]
67+
, indenter
68+
4
69+
["[O] " ++ showECT b, "[N] " ++ showECT b1]
70+
]
71+
prettyD0_ _ (Tagged (Attach (DBoth annsL annsR) Same) b) =
72+
if isDeprecated annsR && not (isDeprecated annsL)
73+
then ["[D] " ++ showECT b]
74+
else [""]
75+
76+
prettyD1_ ::
77+
String
78+
-> Tagged (Attach (Diff [Annotation]) (StatusTag ())) (Map String (Tagged (Attach (Diff [Annotation]) (StatusTag EntityContextType)) EntityContextType))
79+
-> [String]
80+
prettyD1_ k (Tagged (Attach (DLeft anns) Removed) b) =
81+
if isDeprecated anns
82+
then [""]
83+
else ["[R] " ++ k]
84+
prettyD1_ k (Tagged (Attach (DRight anns) Added) b) =
85+
if isDeprecated anns
86+
then [""]
87+
else concat [["[A] " ++ k], indenter 4 (prettyD0 b)]
88+
prettyD1_ k (Tagged (Attach (DBoth annsL annsR) (Changed ())) b) =
89+
if isDeprecated annsR && isDeprecated annsL
90+
then [""]
91+
else if isDeprecated annsR && not (isDeprecated annsL)
92+
then concat [["[D] " ++ k], indenter 4 (prettyD0 b)]
93+
else if not (isDeprecated annsR) && isDeprecated annsL
94+
then [""]
95+
else concat [["[C] " ++ k], indenter 4 (prettyD0 b)]
96+
prettyD1_ k (Tagged (Attach (DBoth annsL annsR) Same) b) =
97+
if isDeprecated annsR && not (isDeprecated annsL)
98+
then ["[D] " ++ k]
99+
else [""]
100+
101+
prettyAPI_ ::
102+
[Element]
103+
-> ModuleName
104+
-> Tagged (Attach (Diff [Annotation]) (StatusTag ())) (ModuleContextDefault (Attach (Diff [Annotation]) (StatusTag ())) (Attach (Diff [Annotation]) (StatusTag EntityContextType)))
105+
-> [String]
106+
prettyAPI_ _ k (Tagged (Attach (DLeft anns) Removed) b) =
107+
if isDeprecated anns
108+
then [""]
109+
else ["[R] " ++ k]
110+
prettyAPI_ elems k (Tagged (Attach (DRight anns) Added) b) =
111+
if isDeprecated anns
112+
then [""]
113+
else concat [["[A] " ++ k], indenter 4 (prettyMC elems b)]
114+
prettyAPI_ elems k (Tagged (Attach (DBoth annsL annsR) (Changed ())) b) =
115+
if isDeprecated annsR && isDeprecated annsL
116+
then [""]
117+
else if isDeprecated annsR && not (isDeprecated annsL)
118+
then concat [["[D] " ++ k], indenter 4 (prettyMC elems b)]
119+
else if not (isDeprecated annsR) && isDeprecated annsL
120+
then [""]
121+
else concat [["[C] " ++ k], indenter 4 (prettyMC elems b)]
122+
prettyAPI_ _ k (Tagged (Attach (DBoth annsL annsR) Same) b) =
123+
if isDeprecated annsR && not (isDeprecated annsL)
124+
then ["[D] " ++ k]
125+
else [""]
126+
33127
indenter :: Int -> [String] -> [String]
34128
indenter i = map (replicate i ' ' ++)
35129

@@ -48,55 +142,31 @@ data Element
48142
deriving (Eq)
49143

50144
prettyD0 ::
51-
Show d
52-
=> Map String (Tagged (Attach d (StatusTag EntityContextType)) EntityContextType)
145+
Map String (Tagged (Attach (Diff [Annotation]) (StatusTag EntityContextType)) EntityContextType)
53146
-> [String]
54147
prettyD0 = SMap.foldlWithKey step initial
55148

56149
where
57150

58151
initial = []
59152

60-
step a k (Tagged (Attach d Added) b) =
61-
unwords ["[A]", show d, k, ":", showECT b] : a
62-
step a k (Tagged (Attach d Removed) b) =
63-
unwords ["[R]", show d, k, ":", showECT b] : a
64-
-- step a k (Tagged Same b) = unwords ["[S]", k, ":", showECT b] : a
65-
step a _ (Tagged (Attach _ Same) _) = a
66-
step a k (Tagged (Attach d (Changed b1)) b) =
67-
concat
68-
[ [unwords ["[C]", show d, k, ":"]]
69-
, indenter
70-
4
71-
[unwords ["[OLD]", showECT b], unwords ["[NEW]", showECT b1]]
72-
, a
73-
]
153+
step a k t = prettyD0_ k t ++ a
74154

75155
prettyD1 ::
76-
Show d
77-
=> Bool
78-
-> Map String (Tagged (Attach d (StatusTag ())) (Map String (Tagged (Attach d (StatusTag EntityContextType)) EntityContextType)))
156+
Bool
157+
-> Map String (Tagged (Attach (Diff [Annotation]) (StatusTag ())) (Map String (Tagged (Attach (Diff [Annotation]) (StatusTag EntityContextType)) EntityContextType)))
79158
-> [String]
80159
prettyD1 l = SMap.foldlWithKey step initial
81160

82161
where
83162

84163
initial = []
85164

86-
step a _ (Tagged (Attach _d Same) _) = a
87-
step a k (Tagged (Attach d t) b) =
88-
if l
89-
then concat
90-
[ [unwords [prettyTag t, show d, k]]
91-
, indenter 4 (prettyD0 b)
92-
, a
93-
]
94-
else concat [[unwords [prettyTag t, show d, k]], a]
165+
step a k t = prettyD1_ k t ++ a
95166

96167
prettyMC ::
97-
Show d
98-
=> [Element]
99-
-> ModuleContextDefault (Attach d (StatusTag ())) (Attach d (StatusTag EntityContextType))
168+
[Element]
169+
-> ModuleContextDefault (Attach (Diff [Annotation]) (StatusTag ())) (Attach (Diff [Annotation]) (StatusTag EntityContextType))
100170
-> [String]
101171
prettyMC elems ctx = concat $ map displayer $ nub elems
102172

@@ -113,21 +183,13 @@ prettyMC elems ctx = concat $ map displayer $ nub elems
113183

114184

115185
prettyAPI ::
116-
Show d
117-
=> [Element]
118-
-> API (Attach d (StatusTag ())) (Attach d (StatusTag ())) (Attach d (StatusTag EntityContextType))
186+
[Element]
187+
-> API (Attach (Diff [Annotation]) (StatusTag ())) (Attach (Diff [Annotation]) (StatusTag ())) (Attach (Diff [Annotation]) (StatusTag EntityContextType))
119188
-> String
120189
prettyAPI elems = printer . SMap.foldlWithKey step initial
121190

122191
where
123192

124193
initial = []
125194

126-
step a _ (Tagged (Attach _ Same) _) = a
127-
step a k (Tagged (Attach d t) b) =
128-
let ptfy =
129-
concat
130-
[ [unwords [prettyTag t, show d, k]]
131-
, indenter 4 (prettyMC elems b)
132-
]
133-
in concat [ptfy, a]
195+
step a k t = prettyAPI_ elems k t ++ a

0 commit comments

Comments
 (0)