git.iko.soy/elk
on master help sign in
Move the diff logic mostly into terminal/ and get it towards working again
commit3973751bc523547b299a701a047c79d04aff30fd authorEvan Czaplicki <evancz@users.noreply.github.com> dateTue 4 Jun 2019, 11:19 (7 years ago) parent7d402d6
3 files changed+315−291
compare with master
unifiedsplit
builder/src/Deps/Diff.hs+1−1 builder/src/Elm/Diff.hs−284 terminal/src/Diff.hs+314−6
builder/src/Deps/Diff.hs+1−1
@@ -204,7 +204,7 @@ isSameName :: Name.Name -> Name.Name -> Bool
204204isSameName oldFullName newFullName =
205205 let
206206 dedot name =
207− reverse (Utf8.split 0x2E {-.-} (Name.toUtf8 name))
207+ reverse (Name.splitDots name)
208208 in
209209 case ( dedot oldFullName, dedot newFullName ) of
210210 (oldName:[], newName:_) ->
builder/src/Elm/Diff.hsdeleted−284
@@ -1,284 +0,0 @@
1−{-# OPTIONS_GHC -Wall #-}
2−{-# LANGUAGE OverloadedStrings #-}
3−module Elm.Diff
4− ( Args(..)
5− , diff
6− )
7− where
8−
9−
10−import Control.Monad.Except (liftIO)
11−import qualified Data.List as List
12−import qualified Data.Map as Map
13−import qualified Data.Maybe as Maybe
14−import qualified Data.Name as Name
15−
16−import qualified Deps.Cache as Cache
17−import Deps.Diff (PackageChanges(..), ModuleChanges(..), Changes(..), Magnitude(..))
18−import qualified Deps.Diff as Diff
19−import qualified Elm.Compiler.Type as Type
20−import qualified Elm.Docs as Docs
21−import qualified Elm.ModuleName as ModuleName
22−import qualified Elm.Package as Pkg
23−import qualified Elm.Project as Project
24−import qualified Elm.Project.Json as Project
25−import qualified Elm.Project.Summary as Summary
26−import qualified Elm.Version as V
27−import Reporting.Doc ((<>), (<+>))
28−import qualified Reporting.Doc as D
29−import qualified Reporting.Exit as Exit
30−import qualified Reporting.Exit.Diff as E
31−import qualified Reporting.Exit.Help as Help
32−import qualified Reporting.Render.Type.Localizer as L
33−import qualified Reporting.Task as Task
34−
35−
36−
37−-- DIFF
38−
39−
40−data Args
41− = CodeVsLatest
42− | CodeVsExactly V.Version
43− | LocalInquiry V.Version V.Version
44− | GlobalInquiry Pkg.Name V.Version V.Version
45−
46−
47−diff :: Args -> Task.Task ()
48−diff args =
49− case args of
50− GlobalInquiry name v1 v2 ->
51− do registry <- Cache.mandatoryUpdate
52− case Cache.getVersions name registry of
53− Left suggestions ->
54− throw $ E.UnknownPackage name suggestions
55−
56− Right vsns ->
57− do oldDocs <- getDocs name vsns (min v1 v2)
58− newDocs <- getDocs name vsns (max v1 v2)
59− writeDiff oldDocs newDocs
60−
61− LocalInquiry v1 v2 ->
62− do (_, name, vsns) <- getPackageInfo
63− oldDocs <- getDocs name vsns (min v1 v2)
64− newDocs <- getDocs name vsns (max v1 v2)
65− writeDiff oldDocs newDocs
66−
67− CodeVsLatest ->
68− do (summary, name, vsns) <- getPackageInfo
69− oldDocs <- getDocs name vsns (maximum vsns)
70− newDocs <- Task.silently (error "TODO Project.generateDocs summary" summary)
71− writeDiff oldDocs newDocs
72−
73− CodeVsExactly version ->
74− do (summary, name, vsns) <- getPackageInfo
75− oldDocs <- getDocs name vsns version
76− newDocs <- Task.silently (error "TODO Project.generateDocs summary" summary)
77− writeDiff oldDocs newDocs
78−
79−
80−throw :: E.Exit -> Task.Task a
81−throw exit =
82− Task.throw $ Exit.Diff exit
83−
84−
85−
86−-- DIFF HELPERS
87−
88−
89−getDocs :: Pkg.Name -> [V.Version] -> V.Version -> Task.Task Docs.Documentation
90−getDocs name allVersions version =
91− if elem version allVersions then
92− Cache.getDocs name version
93− else
94− throw $ E.UnknownVersion name version allVersions
95−
96−
97−getPackageInfo :: Task.Task (Summary.Summary, Pkg.Name, [V.Version])
98−getPackageInfo =
99− do summary <- Project.getRoot
100− case Summary._project summary of
101− Project.App _ ->
102− throw $ E.Application
103−
104− Project.Pkg (Project.PkgInfo name _ _ _ _ _ _ _) ->
105− do registry <- Cache.mandatoryUpdate
106− case Cache.getVersions name registry of
107− Right vsns ->
108− return ( summary, name, vsns )
109−
110− Left _ ->
111− throw E.Unpublished
112−
113−
114−
115−-- WRITE DOC
116−
117−
118−writeDiff :: Docs.Documentation -> Docs.Documentation -> Task.Task ()
119−writeDiff oldDocs newDocs =
120− let
121− changes = Diff.diff oldDocs newDocs
122− localizer = L.fromNames (Map.union oldDocs newDocs)
123− in
124− liftIO $ Help.toStdout (toDoc localizer changes <> "\n")
125−
126−
127−
128−-- TO DOC
129−
130−
131−toDoc :: L.Localizer -> PackageChanges -> D.Doc
132−toDoc localizer changes@(PackageChanges added changed removed) =
133− if null added && Map.null changed && null removed then
134− "No API changes detected, so this is a" <+> D.green "PATCH" <+> "change."
135− else
136− let
137− magDoc =
138− D.fromChars (Diff.magnitudeToString (Diff.toMagnitude changes))
139−
140− header =
141− "This is a" <+> D.green magDoc <+> "change."
142−
143− addedChunk =
144− if null added then [] else
145− [ Chunk "ADDED MODULES" MINOR $
146− D.vcat $ map (D.fromUtf8 . ModuleName.nameToString) added
147− ]
148−
149− removedChunk =
150− if null removed then [] else
151− [ Chunk "REMOVED MODULES" MAJOR $
152− D.vcat $ map (D.fromUtf8 . ModuleName.nameToString) removed
153− ]
154−
155− chunks =
156− addedChunk ++ removedChunk ++ map (changesToChunk localizer) (Map.toList changed)
157− in
158− D.vcat (header : "" : map chunkToDoc chunks)
159−
160−
161−data Chunk =
162− Chunk
163− { _title :: String
164− , _magnitude :: Magnitude
165− , _details :: D.Doc
166− }
167−
168−
169−chunkToDoc :: Chunk -> D.Doc
170−chunkToDoc (Chunk title magnitude details) =
171− let
172− magDoc =
173− Diff.magnitudeToString magnitude
174−
175− header =
176− "----" <+> D.fromChars title <+> "-" <+> D.fromChars magDoc <+> "----"
177− in
178− D.vcat
179− [ D.dullcyan header
180− , ""
181− , D.indent 4 details
182− , ""
183− , ""
184− ]
185−
186−
187−changesToChunk :: L.Localizer -> (Name.Name, ModuleChanges) -> Chunk
188−changesToChunk localizer (name, changes@(ModuleChanges unions aliases values binops)) =
189− let
190− magnitude =
191− Diff.moduleChangeMagnitude changes
192−
193− (unionAdd, unionChange, unionRemove) =
194− changesToDocTriple (unionToDoc localizer) unions
195−
196− (aliasAdd, aliasChange, aliasRemove) =
197− changesToDocTriple (aliasToDoc localizer) aliases
198−
199− (valueAdd, valueChange, valueRemove) =
200− changesToDocTriple (valueToDoc localizer) values
201−
202− (binopAdd, binopChange, binopRemove) =
203− changesToDocTriple (binopToDoc localizer) binops
204− in
205− Chunk (Name.toChars name) magnitude $
206− D.vcat $ List.intersperse "" $ Maybe.catMaybes $
207− [ changesToDoc "Added" unionAdd aliasAdd valueAdd binopAdd
208− , changesToDoc "Removed" unionRemove aliasRemove valueRemove binopRemove
209− , changesToDoc "Changed" unionChange aliasChange valueChange binopChange
210− ]
211−
212−
213−changesToDocTriple :: (k -> v -> D.Doc) -> Changes k v -> ([D.Doc], [D.Doc], [D.Doc])
214−changesToDocTriple entryToDoc (Changes added changed removed) =
215− let
216− indented (name, value) =
217− D.indent 4 (entryToDoc name value)
218−
219− diffed (name, (oldValue, newValue)) =
220− D.vcat
221− [ " - " <> entryToDoc name oldValue
222− , " + " <> entryToDoc name newValue
223− , ""
224− ]
225− in
226− ( map indented (Map.toList added)
227− , map diffed (Map.toList changed)
228− , map indented (Map.toList removed)
229− )
230−
231−
232−changesToDoc :: String -> [D.Doc] -> [D.Doc] -> [D.Doc] -> [D.Doc] -> Maybe D.Doc
233−changesToDoc categoryName unions aliases values binops =
234− if null unions && null aliases && null values && null binops then
235− Nothing
236−
237− else
238− Just $ D.vcat $
239− D.fromChars categoryName <> ":" : unions ++ aliases ++ binops ++ values
240−
241−
242−unionToDoc :: L.Localizer -> Name.Name -> Docs.Union -> D.Doc
243−unionToDoc localizer name (Docs.Union _ tvars ctors) =
244− let
245− setup =
246− "type" <+> D.fromName name <+> D.hsep (map D.fromName tvars)
247−
248− ctorDoc (ctor, tipes) =
249− typeDoc localizer (Type.Type ctor tipes)
250− in
251− D.hang 4 (D.sep (setup : zipWith (<+>) ("=" : repeat "|") (map ctorDoc ctors)))
252−
253−
254−aliasToDoc :: L.Localizer -> Name.Name -> Docs.Alias -> D.Doc
255−aliasToDoc localizer name (Docs.Alias _ tvars tipe) =
256− let
257− declaration =
258− "type" <+> "alias" <+> D.hsep (map D.fromName (name:tvars)) <+> "="
259− in
260− D.hang 4 (D.sep [ declaration, typeDoc localizer tipe ])
261−
262−
263−valueToDoc :: L.Localizer -> Name.Name -> Docs.Value -> D.Doc
264−valueToDoc localizer name (Docs.Value _ tipe) =
265− D.hang 4 $ D.sep [ D.fromName name <+> ":", typeDoc localizer tipe ]
266−
267−
268−binopToDoc :: L.Localizer -> Name.Name -> Docs.Binop -> D.Doc
269−binopToDoc localizer name (Docs.Binop _ tipe associativity (Docs.Precedence n)) =
270− "(" <> D.fromName name <> ")" <+> ":" <+> typeDoc localizer tipe <> D.black details
271− where
272− details =
273− " (" <> D.fromName assoc <> "/" <> D.fromInt n <> ")"
274−
275− assoc =
276− case associativity of
277− Docs.Left -> "left"
278− Docs.Non -> "non"
279− Docs.Right -> "right"
280−
281−
282−typeDoc :: L.Localizer -> Type.Type -> D.Doc
283−typeDoc localizer tipe =
284− Type.toDoc localizer Type.None tipe
terminal/src/Diff.hs+314−6
@@ -1,17 +1,325 @@
11{-# OPTIONS_GHC -Wall #-}
2−module Diff (run) where
2+{-# LANGUAGE OverloadedStrings #-}
3+module Diff
4+ ( Args(..)
5+ , run
6+ )
7+ where
38
49
5−import qualified Elm.Diff as Diff
10+import qualified Data.List as List
11+import qualified Data.Map as Map
12+import qualified Data.Maybe as Maybe
13+import qualified Data.Name as Name
14+
15+import qualified Build
16+import Deps.Diff (PackageChanges(..), ModuleChanges(..), Changes(..))
17+import qualified Deps.Diff as DD
18+import qualified Deps.Registry as Registry
19+import qualified Elm.Compiler.Type as Type
20+import qualified Elm.Details as Details
21+import qualified Elm.Docs as Docs
22+import qualified Elm.Magnitude as M
23+import qualified Elm.Package as Pkg
24+import qualified Elm.Version as V
25+import qualified Http
26+import qualified Reporting
27+import Reporting.Doc ((<>), (<+>))
28+import qualified Reporting.Doc as D
29+import qualified Reporting.Exit as Exit
30+import qualified Reporting.Exit.Help as Help
31+import qualified Reporting.Render.Type.Localizer as L
632import qualified Reporting.Task as Task
7−import qualified Reporting.Progress.Terminal as Terminal
33+import qualified Stuff
834
935
1036
1137-- RUN
1238
1339
14−run :: Diff.Args -> () -> IO ()
40+data Args
41+ = CodeVsLatest
42+ | CodeVsExactly V.Version
43+ | LocalInquiry V.Version V.Version
44+ | GlobalInquiry Pkg.Name V.Version V.Version
45+
46+
47+run :: Args -> () -> IO ()
1548run args () =
16− do reporter <- Terminal.create
17− Task.run reporter $ Diff.diff args
49+ Reporting.attempt Exit.diffToReport $
50+ Task.run $
51+ do env <- getEnv
52+ diff env args
53+
54+
55+
56+-- ENVIRONMENT
57+
58+
59+data Env =
60+ Env
61+ { _root :: Maybe FilePath
62+ , _cache :: Stuff.PackageCache
63+ , _manager :: Http.Manager
64+ , _registry :: Registry.Registry
65+ }
66+
67+
68+getEnv :: Task Env
69+getEnv =
70+ do root <- Task.io $ Stuff.findRoot
71+ cache <- Task.io $ Stuff.getPackageCache
72+ manager <- Task.io $ Http.getManager
73+ registry <- Task.eio Exit.DiffBadRegistry $ Registry.latest manager cache
74+ return (Env root cache manager registry)
75+
76+
77+
78+-- DIFF
79+
80+
81+type Task a =
82+ Task.Task Exit.Diff a
83+
84+
85+diff :: Env -> Args -> Task ()
86+diff env@(Env _ _ _ registry) args =
87+ case args of
88+ GlobalInquiry name v1 v2 ->
89+ case Registry.getVersions' name registry of
90+ Right vsns ->
91+ do oldDocs <- getDocs env name vsns (min v1 v2)
92+ newDocs <- getDocs env name vsns (max v1 v2)
93+ writeDiff oldDocs newDocs
94+
95+ Left suggestions ->
96+ Task.throw $ Exit.DiffUnknownPackage name suggestions
97+
98+ LocalInquiry v1 v2 ->
99+ do (_, name, vsns) <- getDetails env
100+ oldDocs <- getDocs env name vsns (min v1 v2)
101+ newDocs <- getDocs env name vsns (max v1 v2)
102+ writeDiff oldDocs newDocs
103+
104+ CodeVsLatest ->
105+ do (details, name, vsns) <- getDetails env
106+ oldDocs <- getLatestDocs env name vsns
107+ newDocs <- Build.generateDocs details
108+ writeDiff oldDocs newDocs
109+
110+ CodeVsExactly version ->
111+ do (details, name, vsns) <- getDetails env
112+ oldDocs <- getDocs env name vsns version
113+ newDocs <- Build.generateDocs details
114+ writeDiff oldDocs newDocs
115+
116+
117+
118+-- GET DOCS
119+
120+
121+getDocs :: Env -> Pkg.Name -> Registry.KnownVersions -> V.Version -> Task Docs.Documentation
122+getDocs (Env _ cache manager _) name (Registry.KnownVersions latest previous) version =
123+ if latest == version || elem version previous
124+ then Task.eio Exit.DiffDocsProblem $ DD.getDocs cache manager name version
125+ else Task.throw $ Exit.DiffUnknownVersion name version (latest:previous)
126+
127+
128+getLatestDocs :: Env -> Pkg.Name -> Registry.KnownVersions -> Task Docs.Documentation
129+getLatestDocs (Env _ cache manager _) name (Registry.KnownVersions latest _) =
130+ Task.eio Exit.DiffDocsProblem $ DD.getDocs cache manager name latest
131+
132+
133+
134+-- GET DETAILS
135+
136+
137+getDetails :: Env -> Task (Details.Details, Pkg.Name, Registry.KnownVersions)
138+getDetails (Env maybeRoot _ _ registry) =
139+ case maybeRoot of
140+ Nothing ->
141+ Task.throw $ Exit.DiffNoOutline
142+
143+ Just root ->
144+ do details <- Task.eio Exit.DiffBadDetails $ Details.load Reporting.silent root
145+ case Details._outline details of
146+ Details.ValidApp _ ->
147+ Task.throw $ Exit.DiffApplication
148+
149+ Details.ValidPkg pkg _ ->
150+ case Registry.getVersions pkg registry of
151+ Just vsns ->
152+ return (details, pkg, vsns)
153+
154+ Nothing ->
155+ Task.throw Exit.DiffUnpublished
156+
157+
158+
159+-- WRITE DOC
160+
161+
162+writeDiff :: Docs.Documentation -> Docs.Documentation -> Task ()
163+writeDiff oldDocs newDocs =
164+ let
165+ changes = DD.diff oldDocs newDocs
166+ localizer = L.fromNames (Map.union oldDocs newDocs)
167+ in
168+ Task.io $ Help.toStdout $ toDoc localizer changes <> "\n"
169+
170+
171+
172+-- TO DOC
173+
174+
175+toDoc :: L.Localizer -> PackageChanges -> D.Doc
176+toDoc localizer changes@(PackageChanges added changed removed) =
177+ if null added && Map.null changed && null removed then
178+ "No API changes detected, so this is a" <+> D.green "PATCH" <+> "change."
179+ else
180+ let
181+ magDoc =
182+ D.fromChars (M.toChars (DD.toMagnitude changes))
183+
184+ header =
185+ "This is a" <+> D.green magDoc <+> "change."
186+
187+ addedChunk =
188+ if null added then [] else
189+ [ Chunk "ADDED MODULES" M.MINOR $
190+ D.vcat $ map D.fromName added
191+ ]
192+
193+ removedChunk =
194+ if null removed then [] else
195+ [ Chunk "REMOVED MODULES" M.MAJOR $
196+ D.vcat $ map D.fromName removed
197+ ]
198+
199+ chunks =
200+ addedChunk ++ removedChunk ++ map (changesToChunk localizer) (Map.toList changed)
201+ in
202+ D.vcat (header : "" : map chunkToDoc chunks)
203+
204+
205+data Chunk =
206+ Chunk
207+ { _title :: String
208+ , _magnitude :: M.Magnitude
209+ , _details :: D.Doc
210+ }
211+
212+
213+chunkToDoc :: Chunk -> D.Doc
214+chunkToDoc (Chunk title magnitude details) =
215+ let
216+ header =
217+ "----" <+> D.fromChars title <+> "-" <+> D.fromChars (M.toChars magnitude) <+> "----"
218+ in
219+ D.vcat
220+ [ D.dullcyan header
221+ , ""
222+ , D.indent 4 details
223+ , ""
224+ , ""
225+ ]
226+
227+
228+changesToChunk :: L.Localizer -> (Name.Name, ModuleChanges) -> Chunk
229+changesToChunk localizer (name, changes@(ModuleChanges unions aliases values binops)) =
230+ let
231+ magnitude =
232+ DD.moduleChangeMagnitude changes
233+
234+ (unionAdd, unionChange, unionRemove) =
235+ changesToDocTriple (unionToDoc localizer) unions
236+
237+ (aliasAdd, aliasChange, aliasRemove) =
238+ changesToDocTriple (aliasToDoc localizer) aliases
239+
240+ (valueAdd, valueChange, valueRemove) =
241+ changesToDocTriple (valueToDoc localizer) values
242+
243+ (binopAdd, binopChange, binopRemove) =
244+ changesToDocTriple (binopToDoc localizer) binops
245+ in
246+ Chunk (Name.toChars name) magnitude $
247+ D.vcat $ List.intersperse "" $ Maybe.catMaybes $
248+ [ changesToDoc "Added" unionAdd aliasAdd valueAdd binopAdd
249+ , changesToDoc "Removed" unionRemove aliasRemove valueRemove binopRemove
250+ , changesToDoc "Changed" unionChange aliasChange valueChange binopChange
251+ ]
252+
253+
254+changesToDocTriple :: (k -> v -> D.Doc) -> Changes k v -> ([D.Doc], [D.Doc], [D.Doc])
255+changesToDocTriple entryToDoc (Changes added changed removed) =
256+ let
257+ indented (name, value) =
258+ D.indent 4 (entryToDoc name value)
259+
260+ diffed (name, (oldValue, newValue)) =
261+ D.vcat
262+ [ " - " <> entryToDoc name oldValue
263+ , " + " <> entryToDoc name newValue
264+ , ""
265+ ]
266+ in
267+ ( map indented (Map.toList added)
268+ , map diffed (Map.toList changed)
269+ , map indented (Map.toList removed)
270+ )
271+
272+
273+changesToDoc :: String -> [D.Doc] -> [D.Doc] -> [D.Doc] -> [D.Doc] -> Maybe D.Doc
274+changesToDoc categoryName unions aliases values binops =
275+ if null unions && null aliases && null values && null binops then
276+ Nothing
277+
278+ else
279+ Just $ D.vcat $
280+ D.fromChars categoryName <> ":" : unions ++ aliases ++ binops ++ values
281+
282+
283+unionToDoc :: L.Localizer -> Name.Name -> Docs.Union -> D.Doc
284+unionToDoc localizer name (Docs.Union _ tvars ctors) =
285+ let
286+ setup =
287+ "type" <+> D.fromName name <+> D.hsep (map D.fromName tvars)
288+
289+ ctorDoc (ctor, tipes) =
290+ typeDoc localizer (Type.Type ctor tipes)
291+ in
292+ D.hang 4 (D.sep (setup : zipWith (<+>) ("=" : repeat "|") (map ctorDoc ctors)))
293+
294+
295+aliasToDoc :: L.Localizer -> Name.Name -> Docs.Alias -> D.Doc
296+aliasToDoc localizer name (Docs.Alias _ tvars tipe) =
297+ let
298+ declaration =
299+ "type" <+> "alias" <+> D.hsep (map D.fromName (name:tvars)) <+> "="
300+ in
301+ D.hang 4 (D.sep [ declaration, typeDoc localizer tipe ])
302+
303+
304+valueToDoc :: L.Localizer -> Name.Name -> Docs.Value -> D.Doc
305+valueToDoc localizer name (Docs.Value _ tipe) =
306+ D.hang 4 $ D.sep [ D.fromName name <+> ":", typeDoc localizer tipe ]
307+
308+
309+binopToDoc :: L.Localizer -> Name.Name -> Docs.Binop -> D.Doc
310+binopToDoc localizer name (Docs.Binop _ tipe associativity (Docs.Precedence n)) =
311+ "(" <> D.fromName name <> ")" <+> ":" <+> typeDoc localizer tipe <> D.black details
312+ where
313+ details =
314+ " (" <> D.fromName assoc <> "/" <> D.fromInt n <> ")"
315+
316+ assoc =
317+ case associativity of
318+ Docs.Left -> "left"
319+ Docs.Non -> "non"
320+ Docs.Right -> "right"
321+
322+
323+typeDoc :: L.Localizer -> Type.Type -> D.Doc
324+typeDoc localizer tipe =
325+ Type.toDoc localizer Type.None tipe