@@ -21,12 +21,14 @@ import qualified Data.Map as Map
2121import qualified Data.Map.Utils as Map
2222import qualified Data.Map.Merge.Strict as Map
2323import qualified Data.Name as Name
24+import qualified Data.NonEmptyList as NE
2425import qualified Data.OneOrMore as OneOrMore
2526import qualified Data.Set as Set
2627import qualified Data.Utf8 as Utf8
2728import qualified System.Directory as Dir
2829import System.FilePath ((</>), (<.>))
2930
31+import qualified AST.Canonical as Can
3032import qualified AST.Source as Src
3133import qualified AST.Optimized as Opt
3234import qualified Compile
@@ -34,6 +36,7 @@ import qualified Deps.Registry as Registry
3436import qualified Deps.Solver as Solver
3537import qualified Deps.Website as Website
3638import qualified Elm.Constraint as Con
39+import qualified Elm.Docs as Docs
3740import qualified Elm.Interface as I
3841import qualified Elm.Kernel as Kernel
3942import qualified Elm.ModuleName as ModuleName
@@ -43,6 +46,7 @@ import qualified Elm.Version as V
4346import qualified File
4447import qualified Http
4548import qualified Json.Decode as D
49+import qualified Json.Encode as E
4650import qualified Parse.Module as Parse
4751import qualified Reporting
4852import qualified Reporting.Annotation as A
@@ -66,8 +70,8 @@ data Details =
6670
6771
6872data ValidOutline
69− = ValidApp Outline.AppOutline
70− | ValidPkg Outline.PkgOutline (Map.Map Pkg.Name V.Version)
73+ = ValidApp (NE.List FilePath)
74+ | ValidPkg Pkg.Name [ModuleName.Raw]
7175
7276
7377data Local =
@@ -201,24 +205,24 @@ type Task a = Task.Task Exit.Details a
201205
202206
203207verifyPkg :: Env -> File.Time -> Outline.PkgOutline -> Task Details
204−verifyPkg env time outline@(Outline.PkgOutline _ _ _ _ _ direct testDirect elm) =
208+verifyPkg env time (Outline.PkgOutline pkg _ _ _ exposed direct testDirect elm) =
205209 if Con.goodElm elm
206210 then
207211 do solution <- verifyConstraints env =<< union noDups direct testDirect
208− let vsns = Map.map (\(Solver.Details v _) -> v) solution
209− verifyDependencies env time (ValidPkg outline vsns) solution direct
212+ let exposedList = Outline.flattenExposed exposed
213+ verifyDependencies env time (ValidPkg pkg exposedList) solution direct
210214 else
211215 Task.throw $ Exit.DetailsBadElmInPkg elm
212216
213217
214218verifyApp :: Env -> File.Time -> Outline.AppOutline -> Task Details
215−verifyApp env time outline@(Outline.AppOutline elmVersion _ direct _ _ _) =
219+verifyApp env time outline@(Outline.AppOutline elmVersion srcDirs direct _ _ _) =
216220 if elmVersion == V.compiler
217221 then
218222 do stated <- checkAppDeps outline
219223 actual <- verifyConstraints env (Map.map Con.exactly stated)
220224 if Map.size stated == Map.size actual
221− then verifyDependencies env time (ValidApp outline) actual direct
225+ then verifyDependencies env time (ValidApp srcDirs) actual direct
222226 else Task.throw $ Exit.DetailsHandEditedDependencies
223227 else
224228 Task.throw $ Exit.DetailsBadElmInAppOutline elmVersion
@@ -425,8 +429,9 @@ build key cache depsMVar pkg (Solver.Details vsn _) fingerprints =
425429 do let src = Stuff.package cache pkg vsn </> "src"
426430 let foreignDeps = gatherForeignInterfaces directArtifacts
427431 let exposedDict = Map.fromKeys (\_ -> ()) (Outline.flattenExposed exposed)
432+ docsStatus <- getDocsStatus cache pkg vsn
428433 mvar <- newEmptyMVar
429− mvars <- Map.traverseWithKey (const . fork . crawlModule foreignDeps mvar pkg src) exposedDict
434+ mvars <- Map.traverseWithKey (const . fork . crawlModule foreignDeps mvar pkg src docsStatus) exposedDict
430435 putMVar mvar mvars
431436 mapM_ readMVar mvars
432437 maybeStatuses <- traverse readMVar =<< readMVar mvar
@@ -452,7 +457,8 @@ build key cache depsMVar pkg (Solver.Details vsn _) fingerprints =
452457 objects = gatherObjects results
453458 artifacts = Artifacts ifaces objects
454459 in
455− do File.writeBinary path (ArtifactCache fingerprints artifacts)
460+ do writeDocs cache pkg vsn docsStatus results
461+ File.writeBinary path (ArtifactCache fingerprints artifacts)
456462 Reporting.report key Reporting.DBuilt
457463 return (Right artifacts)
458464
@@ -469,7 +475,7 @@ gatherObjects results =
469475addLocalGraph :: ModuleName.Raw -> Result -> Opt.GlobalGraph -> Opt.GlobalGraph
470476addLocalGraph name status graph =
471477 case status of
472− RLocal _ objs -> Opt.addLocalGraph objs graph
478+ RLocal _ objs _ -> Opt.addLocalGraph objs graph
473479 RForeign _ -> graph
474480 RKernelLocal cs -> Opt.addKernel (Name.getKernel name) cs graph
475481 RKernelForeign -> graph
@@ -488,10 +494,10 @@ gatherInterfaces exposed artifacts =
488494toLocalInterface :: (I.Interface -> a) -> Result -> Maybe a
489495toLocalInterface func result =
490496 case result of
491− RLocal iface _ -> Just (func iface)
492− RForeign _ -> Nothing
493− RKernelLocal _ -> Nothing
494− RKernelForeign -> Nothing
497+ RLocal iface _ _ -> Just (func iface)
498+ RForeign _ -> Nothing
499+ RKernelLocal _ -> Nothing
500+ RKernelForeign -> Nothing
495501
496502
497503
@@ -534,14 +540,14 @@ type StatusDict =
534540
535541
536542data Status
537− = SLocal (Map.Map ModuleName.Raw ()) Src.Module
543+ = SLocal DocsStatus (Map.Map ModuleName.Raw ()) Src.Module
538544 | SForeign I.Interface
539545 | SKernelLocal [Kernel.Chunk]
540546 | SKernelForeign
541547
542548
543−crawlModule :: Map.Map ModuleName.Raw ForeignInterface -> MVar StatusDict -> Pkg.Name -> FilePath -> ModuleName.Raw -> IO (Maybe Status)
544−crawlModule foreignDeps mvar pkg src name =
549+crawlModule :: Map.Map ModuleName.Raw ForeignInterface -> MVar StatusDict -> Pkg.Name -> FilePath -> DocsStatus -> ModuleName.Raw -> IO (Maybe Status)
550+crawlModule foreignDeps mvar pkg src docsStatus name =
545551 do let path = src </> ModuleName.toFilePath name <.> "elm"
546552 exists <- File.exists path
547553 case Map.lookup name foreignDeps of
@@ -555,7 +561,7 @@ crawlModule foreignDeps mvar pkg src name =
555561
556562 Nothing ->
557563 if exists then
558− crawlFile foreignDeps mvar pkg src name path
564+ crawlFile foreignDeps mvar pkg src docsStatus name path
559565
560566 else if Pkg.isKernel pkg && Name.isKernel name then
561567 crawlKernel foreignDeps mvar pkg src name
@@ -564,13 +570,13 @@ crawlModule foreignDeps mvar pkg src name =
564570 return Nothing
565571
566572
567−crawlFile :: Map.Map ModuleName.Raw ForeignInterface -> MVar StatusDict -> Pkg.Name -> FilePath -> ModuleName.Raw -> FilePath -> IO (Maybe Status)
568−crawlFile foreignDeps mvar pkg src expectedName path =
573+crawlFile :: Map.Map ModuleName.Raw ForeignInterface -> MVar StatusDict -> Pkg.Name -> FilePath -> DocsStatus -> ModuleName.Raw -> FilePath -> IO (Maybe Status)
574+crawlFile foreignDeps mvar pkg src docsStatus expectedName path =
569575 do bytes <- File.readUtf8 path
570576 case Parse.fromByteString pkg bytes of
571577 Right modul@(Src.Module (Just (A.At _ actualName)) _ _ imports _ _ _ _ _) | expectedName == actualName ->
572578 do deps <- crawlImports foreignDeps mvar pkg src imports
573− return (Just (SLocal deps modul))
579+ return (Just (SLocal docsStatus deps modul))
574580
575581 _ ->
576582 return Nothing
@@ -581,7 +587,7 @@ crawlImports foreignDeps mvar pkg src imports =
581587 do statusDict <- takeMVar mvar
582588 let deps = Map.fromList (map (\i -> (Src.getImportName i, ())) imports)
583589 let news = Map.difference deps statusDict
584− mvars <- Map.traverseWithKey (const . fork . crawlModule foreignDeps mvar pkg src) news
590+ mvars <- Map.traverseWithKey (const . fork . crawlModule foreignDeps mvar pkg src DocsNotNeeded) news
585591 putMVar mvar (Map.union mvars statusDict)
586592 mapM_ readMVar mvars
587593 return deps
@@ -617,7 +623,7 @@ getDepHome fi =
617623
618624
619625data Result
620− = RLocal !I.Interface !Opt.LocalGraph
626+ = RLocal !I.Interface !Opt.LocalGraph (Maybe Docs.Module)
621627 | RForeign I.Interface
622628 | RKernelLocal [Kernel.Chunk]
623629 | RKernelForeign
@@ -626,7 +632,7 @@ data Result
626632compile :: Pkg.Name -> MVar (Map.Map ModuleName.Raw (MVar (Maybe Result))) -> Status -> IO (Maybe Result)
627633compile pkg mvar status =
628634 case status of
629− SLocal deps modul ->
635+ SLocal docsStatus deps modul ->
630636 do resultsDict <- readMVar mvar
631637 maybeResults <- traverse readMVar (Map.intersection resultsDict deps)
632638 case sequence maybeResults of
@@ -639,7 +645,11 @@ compile pkg mvar status =
639645 return Nothing
640646
641647 Right (Compile.Artifacts canonical annotations objects) ->
642− return (Just (RLocal (I.fromModule pkg canonical annotations) objects))
648+ let
649+ ifaces = I.fromModule pkg canonical annotations
650+ docs = makeDocs docsStatus canonical
651+ in
652+ return (Just (RLocal ifaces objects docs))
643653
644654 SForeign iface ->
645655 return (Just (RForeign iface))
@@ -654,10 +664,59 @@ compile pkg mvar status =
654664getInterface :: Result -> Maybe I.Interface
655665getInterface result =
656666 case result of
657− RLocal iface _ -> Just iface
658− RForeign iface -> Just iface
659− RKernelLocal _ -> Nothing
660− RKernelForeign -> Nothing
667+ RLocal iface _ _ -> Just iface
668+ RForeign iface -> Just iface
669+ RKernelLocal _ -> Nothing
670+ RKernelForeign -> Nothing
671+
672+
673+
674+-- MAKE DOCS
675+
676+
677+data DocsStatus
678+ = DocsNeeded
679+ | DocsNotNeeded
680+
681+
682+getDocsStatus :: Stuff.PackageCache -> Pkg.Name -> V.Version -> IO DocsStatus
683+getDocsStatus cache pkg vsn =
684+ do exists <- File.exists (Stuff.package cache pkg vsn </> "docs.json")
685+ if exists
686+ then return DocsNotNeeded
687+ else return DocsNeeded
688+
689+
690+makeDocs :: DocsStatus -> Can.Module -> Maybe Docs.Module
691+makeDocs status modul =
692+ case status of
693+ DocsNeeded ->
694+ case Docs.fromModule modul of
695+ Right docs -> Just docs
696+ Left _ -> Nothing
697+
698+ DocsNotNeeded ->
699+ Nothing
700+
701+
702+writeDocs :: Stuff.PackageCache -> Pkg.Name -> V.Version -> DocsStatus -> Map.Map ModuleName.Raw Result -> IO ()
703+writeDocs cache pkg vsn status results =
704+ case status of
705+ DocsNeeded ->
706+ E.writeUgly (Stuff.package cache pkg vsn </> "docs.json") $
707+ Docs.encode $ Map.mapMaybe toDocs results
708+
709+ DocsNotNeeded ->
710+ return ()
711+
712+
713+toDocs :: Result -> Maybe Docs.Module
714+toDocs result =
715+ case result of
716+ RLocal _ _ docs -> docs
717+ RForeign _ -> Nothing
718+ RKernelLocal _ -> Nothing
719+ RKernelForeign -> Nothing
661720
662721
663722