git.iko.soy/elk
on 1238607 help sign in
elk/builder/src/Elm/Diff.hs
284 lines 8.1 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
14import qualified Data.Name as Name
16import qualified Deps.Cache as Cache
17import Deps.Diff (PackageChanges(..), ModuleChanges(..), Changes(..), Magnitude(..))
18import qualified Deps.Diff as Diff
19import qualified Elm.Compiler.Type as Type
20import qualified Elm.Docs as Docs
21import qualified Elm.ModuleName as ModuleName
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 qualified Elm.Version as V
27import Reporting.Doc ((<>), (<+>))
28import qualified Reporting.Doc as D
29import qualified Reporting.Exit as Exit
30import qualified Reporting.Exit.Diff as E
31import qualified Reporting.Exit.Help as Help
32import qualified Reporting.Render.Type.Localizer as L
33import qualified Reporting.Task as Task
37-- DIFF
40data Args
41 = CodeVsLatest
42 | CodeVsExactly V.Version
43 | LocalInquiry V.Version V.Version
44 | GlobalInquiry Pkg.Name V.Version V.Version
47diff :: Args -> Task.Task ()
48diff 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
56 Right vsns ->
57 do oldDocs <- getDocs name vsns (min v1 v2)
58 newDocs <- getDocs name vsns (max v1 v2)
59 writeDiff oldDocs newDocs
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
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
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
80throw :: E.Exit -> Task.Task a
81throw exit =
82 Task.throw $ Exit.Diff exit
86-- DIFF HELPERS
89getDocs :: Pkg.Name -> [V.Version] -> V.Version -> Task.Task Docs.Documentation
90getDocs name allVersions version =
91 if elem version allVersions then
92 Cache.getDocs name version
93 else
94 throw $ E.UnknownVersion name version allVersions
97getPackageInfo :: Task.Task (Summary.Summary, Pkg.Name, [V.Version])
98getPackageInfo =
99 do summary <- Project.getRoot
100 case Summary._project summary of
101 Project.App _ ->
102 throw $ E.Application
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 )
110 Left _ ->
111 throw E.Unpublished
115-- WRITE DOC
118writeDiff :: Docs.Documentation -> Docs.Documentation -> Task.Task ()
119writeDiff 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")
128-- TO DOC
131toDoc :: L.Localizer -> PackageChanges -> D.Doc
132toDoc 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))
140 header =
141 "This is a" <+> D.green magDoc <+> "change."
143 addedChunk =
144 if null added then [] else
145 [ Chunk "ADDED MODULES" MINOR $
146 D.vcat $ map (D.fromUtf8 . ModuleName.nameToString) added
147 ]
149 removedChunk =
150 if null removed then [] else
151 [ Chunk "REMOVED MODULES" MAJOR $
152 D.vcat $ map (D.fromUtf8 . ModuleName.nameToString) removed
153 ]
155 chunks =
156 addedChunk ++ removedChunk ++ map (changesToChunk localizer) (Map.toList changed)
157 in
158 D.vcat (header : "" : map chunkToDoc chunks)
161data Chunk =
162 Chunk
163 { _title :: String
164 , _magnitude :: Magnitude
165 , _details :: D.Doc
166 }
169chunkToDoc :: Chunk -> D.Doc
170chunkToDoc (Chunk title magnitude details) =
171 let
172 magDoc =
173 Diff.magnitudeToString magnitude
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 ]
187changesToChunk :: L.Localizer -> (Name.Name, ModuleChanges) -> Chunk
188changesToChunk localizer (name, changes@(ModuleChanges unions aliases values binops)) =
189 let
190 magnitude =
191 Diff.moduleChangeMagnitude changes
193 (unionAdd, unionChange, unionRemove) =
194 changesToDocTriple (unionToDoc localizer) unions
196 (aliasAdd, aliasChange, aliasRemove) =
197 changesToDocTriple (aliasToDoc localizer) aliases
199 (valueAdd, valueChange, valueRemove) =
200 changesToDocTriple (valueToDoc localizer) values
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 ]
213changesToDocTriple :: (k -> v -> D.Doc) -> Changes k v -> ([D.Doc], [D.Doc], [D.Doc])
214changesToDocTriple entryToDoc (Changes added changed removed) =
215 let
216 indented (name, value) =
217 D.indent 4 (entryToDoc name value)
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 )
232changesToDoc :: String -> [D.Doc] -> [D.Doc] -> [D.Doc] -> [D.Doc] -> Maybe D.Doc
233changesToDoc categoryName unions aliases values binops =
234 if null unions && null aliases && null values && null binops then
235 Nothing
237 else
238 Just $ D.vcat $
239 D.fromChars categoryName <> ":" : unions ++ aliases ++ binops ++ values
242unionToDoc :: L.Localizer -> Name.Name -> Docs.Union -> D.Doc
243unionToDoc localizer name (Docs.Union _ tvars ctors) =
244 let
245 setup =
246 "type" <+> D.fromName name <+> D.hsep (map D.fromName tvars)
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)))
254aliasToDoc :: L.Localizer -> Name.Name -> Docs.Alias -> D.Doc
255aliasToDoc 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 ])
263valueToDoc :: L.Localizer -> Name.Name -> Docs.Value -> D.Doc
264valueToDoc localizer name (Docs.Value _ tipe) =
265 D.hang 4 $ D.sep [ D.fromName name <+> ":", typeDoc localizer tipe ]
268binopToDoc :: L.Localizer -> Name.Name -> Docs.Binop -> D.Doc
269binopToDoc 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 <> ")"
275 assoc =
276 case associativity of
277 Docs.Left -> "left"
278 Docs.Non -> "non"
279 Docs.Right -> "right"
282typeDoc :: L.Localizer -> Type.Type -> D.Doc
283typeDoc localizer tipe =
284 Type.toDoc localizer Type.None tipe