git.iko.soy/elk
on 7dbdaae help sign in
elk/builder/src/Elm/Diff.hs
279 lines 8.0 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Elm.Diff
4 ( Args(..)
5 , diff
6 )
7 where
10import Control.Monad.Except (liftIO)
11import qualified Data.List as List
12import qualified Data.Map as Map
13import qualified Data.Maybe as Maybe
15import qualified Deps.Cache as Cache
16import Deps.Diff (PackageChanges(..), ModuleChanges(..), Changes(..), Magnitude(..))
17import qualified Deps.Diff as Diff
18import qualified Elm.Compiler.Module as Module
19import qualified Elm.Compiler.Type as Type
20import qualified Elm.Docs as Docs
21import qualified Elm.Name as N
22import qualified Elm.Package as Pkg
23import qualified Elm.Project as Project
24import qualified Elm.Project.Json as Project
25import qualified Elm.Project.Summary as Summary
26import Reporting.Doc ((<>), (<+>))
27import qualified Reporting.Doc as D
28import qualified Reporting.Exit as Exit
29import qualified Reporting.Exit.Diff as E
30import qualified Reporting.Exit.Help as Help
31import qualified Reporting.Render.Type.Localizer as L
32import qualified Reporting.Task as Task
36-- DIFF
39data Args
40 = CodeVsLatest
41 | CodeVsExactly Pkg.Version
42 | LocalInquiry Pkg.Version Pkg.Version
43 | GlobalInquiry Pkg.Name Pkg.Version Pkg.Version
46diff :: Args -> Task.Task ()
47diff args =
48 case args of
49 GlobalInquiry name v1 v2 ->
50 do registry <- Cache.mandatoryUpdate
51 case Cache.getVersions name registry of
52 Left suggestions ->
53 throw $ E.UnknownPackage name suggestions
55 Right vsns ->
56 do oldDocs <- getDocs name vsns (min v1 v2)
57 newDocs <- getDocs name vsns (max v1 v2)
58 writeDiff oldDocs newDocs
60 LocalInquiry v1 v2 ->
61 do (_, name, vsns) <- getPackageInfo
62 oldDocs <- getDocs name vsns (min v1 v2)
63 newDocs <- getDocs name vsns (max v1 v2)
64 writeDiff oldDocs newDocs
66 CodeVsLatest ->
67 do (summary, name, vsns) <- getPackageInfo
68 oldDocs <- getDocs name vsns (maximum vsns)
69 newDocs <- Task.silently (Project.generateDocs summary)
70 writeDiff oldDocs newDocs
72 CodeVsExactly version ->
73 do (summary, name, vsns) <- getPackageInfo
74 oldDocs <- getDocs name vsns version
75 newDocs <- Task.silently (Project.generateDocs summary)
76 writeDiff oldDocs newDocs
79throw :: E.Exit -> Task.Task a
80throw exit =
81 Task.throw $ Exit.Diff exit
85-- DIFF HELPERS
88getDocs :: Pkg.Name -> [Pkg.Version] -> Pkg.Version -> Task.Task Docs.Documentation
89getDocs name allVersions version =
90 if elem version allVersions then
91 Cache.getDocs name version
92 else
93 throw $ E.UnknownVersion name version allVersions
96getPackageInfo :: Task.Task (Summary.Summary, Pkg.Name, [Pkg.Version])
97getPackageInfo =
98 do summary <- Project.getRoot
99 case Summary._project summary of
100 Project.App _ ->
101 throw $ E.Application
103 Project.Pkg (Project.PkgInfo name _ _ _ _ _ _ _) ->
104 do registry <- Cache.mandatoryUpdate
105 let vsns = either (const []) id (Cache.getVersions name registry)
106 return ( summary, name, vsns )
110-- WRITE DOC
113writeDiff :: Docs.Documentation -> Docs.Documentation -> Task.Task ()
114writeDiff oldDocs newDocs =
115 let
116 changes = Diff.diff oldDocs newDocs
117 localizer = L.fromNames (Map.union oldDocs newDocs)
118 in
119 liftIO $ Help.toStdout (toDoc localizer changes <> "\n")
123-- TO DOC
126toDoc :: L.Localizer -> PackageChanges -> D.Doc
127toDoc localizer changes@(PackageChanges added changed removed) =
128 if null added && Map.null changed && null removed then
129 "No API changes detected, so this is a" <+> D.green "PATCH" <+> "change."
130 else
131 let
132 magDoc =
133 D.fromString (Diff.magnitudeToString (Diff.toMagnitude changes))
135 header =
136 "This is a" <+> D.green magDoc <+> "change."
138 addedChunk =
139 if null added then [] else
140 [ Chunk "ADDED MODULES" MINOR $
141 D.vcat $ map (D.fromString . Module.nameToString) added
142 ]
144 removedChunk =
145 if null removed then [] else
146 [ Chunk "REMOVED MODULES" MAJOR $
147 D.vcat $ map (D.fromString . Module.nameToString) removed
148 ]
150 chunks =
151 addedChunk ++ removedChunk ++ map (changesToChunk localizer) (Map.toList changed)
152 in
153 D.vcat (header : "" : map chunkToDoc chunks)
156data Chunk =
157 Chunk
158 { _title :: String
159 , _magnitude :: Magnitude
160 , _details :: D.Doc
161 }
164chunkToDoc :: Chunk -> D.Doc
165chunkToDoc (Chunk title magnitude details) =
166 let
167 magDoc =
168 Diff.magnitudeToString magnitude
170 header =
171 "----" <+> D.fromString title <+> "-" <+> D.fromString magDoc <+> "----"
172 in
173 D.vcat
174 [ D.dullcyan header
175 , ""
176 , D.indent 4 details
177 , ""
178 , ""
179 ]
182changesToChunk :: L.Localizer -> (N.Name, ModuleChanges) -> Chunk
183changesToChunk localizer (name, changes@(ModuleChanges unions aliases values binops)) =
184 let
185 magnitude =
186 Diff.moduleChangeMagnitude changes
188 (unionAdd, unionChange, unionRemove) =
189 changesToDocTriple (unionToDoc localizer) unions
191 (aliasAdd, aliasChange, aliasRemove) =
192 changesToDocTriple (aliasToDoc localizer) aliases
194 (valueAdd, valueChange, valueRemove) =
195 changesToDocTriple (valueToDoc localizer) values
197 (binopAdd, binopChange, binopRemove) =
198 changesToDocTriple (binopToDoc localizer) binops
199 in
200 Chunk (N.toString name) magnitude $
201 D.vcat $ List.intersperse "" $ Maybe.catMaybes $
202 [ changesToDoc "Added" unionAdd aliasAdd valueAdd binopAdd
203 , changesToDoc "Removed" unionRemove aliasRemove valueRemove binopRemove
204 , changesToDoc "Changed" unionChange aliasChange valueChange binopChange
205 ]
208changesToDocTriple :: (k -> v -> D.Doc) -> Changes k v -> ([D.Doc], [D.Doc], [D.Doc])
209changesToDocTriple entryToDoc (Changes added changed removed) =
210 let
211 indented (name, value) =
212 D.indent 4 (entryToDoc name value)
214 diffed (name, (oldValue, newValue)) =
215 D.vcat
216 [ " - " <> entryToDoc name oldValue
217 , " + " <> entryToDoc name newValue
218 , ""
219 ]
220 in
221 ( map indented (Map.toList added)
222 , map diffed (Map.toList changed)
223 , map indented (Map.toList removed)
224 )
227changesToDoc :: String -> [D.Doc] -> [D.Doc] -> [D.Doc] -> [D.Doc] -> Maybe D.Doc
228changesToDoc categoryName unions aliases values binops =
229 if null unions && null aliases && null values && null binops then
230 Nothing
232 else
233 Just $ D.vcat $
234 D.fromString categoryName <> ":" : unions ++ aliases ++ binops ++ values
237unionToDoc :: L.Localizer -> N.Name -> Docs.Union -> D.Doc
238unionToDoc localizer name (Docs.Union _ tvars ctors) =
239 let
240 setup =
241 "type" <+> D.fromName name <+> D.hsep (map D.fromName tvars)
243 ctorDoc (ctor, tipes) =
244 typeDoc localizer (Type.Type ctor tipes)
245 in
246 D.hang 4 (D.sep (setup : zipWith (<+>) ("=" : repeat "|") (map ctorDoc ctors)))
249aliasToDoc :: L.Localizer -> N.Name -> Docs.Alias -> D.Doc
250aliasToDoc localizer name (Docs.Alias _ tvars tipe) =
251 let
252 declaration =
253 "type" <+> "alias" <+> D.hsep (map D.fromName (name:tvars)) <+> "="
254 in
255 D.hang 4 (D.sep [ declaration, typeDoc localizer tipe ])
258valueToDoc :: L.Localizer -> N.Name -> Docs.Value -> D.Doc
259valueToDoc localizer name (Docs.Value _ tipe) =
260 D.hang 4 $ D.sep [ D.fromName name <+> ":", typeDoc localizer tipe ]
263binopToDoc :: L.Localizer -> N.Name -> Docs.Binop -> D.Doc
264binopToDoc localizer name (Docs.Binop _ tipe associativity (Docs.Precedence n)) =
265 "(" <> D.fromName name <> ")" <+> ":" <+> typeDoc localizer tipe <> D.black details
266 where
267 details =
268 " (" <> D.fromName assoc <> "/" <> D.fromInt n <> ")"
270 assoc =
271 case associativity of
272 Docs.Left -> "left"
273 Docs.Non -> "non"
274 Docs.Right -> "right"
277typeDoc :: L.Localizer -> Type.Type -> D.Doc
278typeDoc localizer tipe =
279 Type.toDoc localizer Type.None tipe