1f01d8c · elk · git.iko.soy

git.iko.soy/elk

on master help sign in

store less info in Elm.Details / add doc generation back

1f01d8cEvan Czaplicki7 years ago

builder/src/Elm/Details.hs+88−29

compare with master

unifiedsplit

@@ -21,12 +21,14 @@ import qualified Data.Map as Map

21import qualified Data.Map.Utils as Map

22import qualified Data.Map.Merge.Strict as Map

23import qualified Data.Name as Name

24+import qualified Data.NonEmptyList as NE

24import qualified Data.OneOrMore as OneOrMore

25import qualified Data.OneOrMore as OneOrMore

25import qualified Data.Set as Set

26import qualified Data.Set as Set

26import qualified Data.Utf8 as Utf8

27import qualified Data.Utf8 as Utf8

27import qualified System.Directory as Dir

28import qualified System.Directory as Dir

28import System.FilePath ((</>), (<.>))

29import System.FilePath ((</>), (<.>))

31+import qualified AST.Canonical as Can

30import qualified AST.Source as Src

32import qualified AST.Source as Src

31import qualified AST.Optimized as Opt

33import qualified AST.Optimized as Opt

32import qualified Compile

34import qualified Compile

@@ -34,6 +36,7 @@ import qualified Deps.Registry as Registry

34import qualified Deps.Solver as Solver

36import qualified Deps.Solver as Solver

35import qualified Deps.Website as Website

37import qualified Deps.Website as Website

36import qualified Elm.Constraint as Con

38import qualified Elm.Constraint as Con

39+import qualified Elm.Docs as Docs

37import qualified Elm.Interface as I

40import qualified Elm.Interface as I

38import qualified Elm.Kernel as Kernel

41import qualified Elm.Kernel as Kernel

39import qualified Elm.ModuleName as ModuleName

42import qualified Elm.ModuleName as ModuleName

@@ -43,6 +46,7 @@ import qualified Elm.Version as V

43import qualified File

46import qualified File

44import qualified Http

47import qualified Http

45import qualified Json.Decode as D

48import qualified Json.Decode as D

49+import qualified Json.Encode as E

46import qualified Parse.Module as Parse

50import qualified Parse.Module as Parse

47import qualified Reporting

51import qualified Reporting

48import qualified Reporting.Annotation as A

52import qualified Reporting.Annotation as A

@@ -66,8 +70,8 @@ data Details =

68data ValidOutline

72data ValidOutline

69− = ValidApp Outline.AppOutline

73+ = ValidApp (NE.List FilePath)

70− | ValidPkg Outline.PkgOutline (Map.Map Pkg.Name V.Version)

74+ | ValidPkg Pkg.Name [ModuleName.Raw]

73data Local =

77data Local =

@@ -201,24 +205,24 @@ type Task a = Task.Task Exit.Details a

201

205

202

206

203verifyPkg :: Env -> File.Time -> Outline.PkgOutline -> Task Details

207verifyPkg :: 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) =

205 if Con.goodElm elm

209 if Con.goodElm elm

206 then

210 then

207 do solution <- verifyConstraints env =<< union noDups direct testDirect

211 do solution <- verifyConstraints env =<< union noDups direct testDirect

208− let vsns = Map.map (\(Solver.Details v _) -> v) solution

212+ let exposedList = Outline.flattenExposed exposed

209− verifyDependencies env time (ValidPkg outline vsns) solution direct

213+ verifyDependencies env time (ValidPkg pkg exposedList) solution direct

210 else

214 else

211 Task.throw $ Exit.DetailsBadElmInPkg elm

215 Task.throw $ Exit.DetailsBadElmInPkg elm

212

216

213

217

214verifyApp :: Env -> File.Time -> Outline.AppOutline -> Task Details

218verifyApp :: 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 _ _ _) =

216 if elmVersion == V.compiler

220 if elmVersion == V.compiler

217 then

221 then

218 do stated <- checkAppDeps outline

222 do stated <- checkAppDeps outline

219 actual <- verifyConstraints env (Map.map Con.exactly stated)

223 actual <- verifyConstraints env (Map.map Con.exactly stated)

220 if Map.size stated == Map.size actual

224 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

222 else Task.throw $ Exit.DetailsHandEditedDependencies

226 else Task.throw $ Exit.DetailsHandEditedDependencies

223 else

227 else

224 Task.throw $ Exit.DetailsBadElmInAppOutline elmVersion

228 Task.throw $ Exit.DetailsBadElmInAppOutline elmVersion

@@ -425,8 +429,9 @@ build key cache depsMVar pkg (Solver.Details vsn _) fingerprints =

425 do let src = Stuff.package cache pkg vsn </> "src"

429 do let src = Stuff.package cache pkg vsn </> "src"

426 let foreignDeps = gatherForeignInterfaces directArtifacts

430 let foreignDeps = gatherForeignInterfaces directArtifacts

427 let exposedDict = Map.fromKeys (\_ -> ()) (Outline.flattenExposed exposed)

431 let exposedDict = Map.fromKeys (\_ -> ()) (Outline.flattenExposed exposed)

432+ docsStatus <- getDocsStatus cache pkg vsn

428 mvar <- newEmptyMVar

433 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

430 putMVar mvar mvars

435 putMVar mvar mvars

431 mapM_ readMVar mvars

436 mapM_ readMVar mvars

432 maybeStatuses <- traverse readMVar =<< readMVar mvar

437 maybeStatuses <- traverse readMVar =<< readMVar mvar

@@ -452,7 +457,8 @@ build key cache depsMVar pkg (Solver.Details vsn _) fingerprints =

452 objects = gatherObjects results

457 objects = gatherObjects results

453 artifacts = Artifacts ifaces objects

458 artifacts = Artifacts ifaces objects

454 in

459 in

460+ do writeDocs cache pkg vsn docsStatus results

455− do File.writeBinary path (ArtifactCache fingerprints artifacts)

461+ File.writeBinary path (ArtifactCache fingerprints artifacts)

456 Reporting.report key Reporting.DBuilt

462 Reporting.report key Reporting.DBuilt

457 return (Right artifacts)

463 return (Right artifacts)

458

464

@@ -469,7 +475,7 @@ gatherObjects results =

469addLocalGraph :: ModuleName.Raw -> Result -> Opt.GlobalGraph -> Opt.GlobalGraph

475addLocalGraph :: ModuleName.Raw -> Result -> Opt.GlobalGraph -> Opt.GlobalGraph

470addLocalGraph name status graph =

476addLocalGraph name status graph =

471 case status of

477 case status of

472− RLocal _ objs -> Opt.addLocalGraph objs graph

478+ RLocal _ objs _ -> Opt.addLocalGraph objs graph

473 RForeign _ -> graph

479 RForeign _ -> graph

474 RKernelLocal cs -> Opt.addKernel (Name.getKernel name) cs graph

480 RKernelLocal cs -> Opt.addKernel (Name.getKernel name) cs graph

475 RKernelForeign -> graph

481 RKernelForeign -> graph

@@ -488,10 +494,10 @@ gatherInterfaces exposed artifacts =

488toLocalInterface :: (I.Interface -> a) -> Result -> Maybe a

494toLocalInterface :: (I.Interface -> a) -> Result -> Maybe a

489toLocalInterface func result =

495toLocalInterface func result =

490 case result of

496 case result of

491− RLocal iface _ -> Just (func iface)

497+ RLocal iface _ _ -> Just (func iface)

492− RForeign _ -> Nothing

498+ RForeign _ -> Nothing

493− RKernelLocal _ -> Nothing

499+ RKernelLocal _ -> Nothing

494− RKernelForeign -> Nothing

500+ RKernelForeign -> Nothing

495

501

496

502

497

503

@@ -534,14 +540,14 @@ type StatusDict =

534

540

535

541

536data Status

542data Status

537− = SLocal (Map.Map ModuleName.Raw ()) Src.Module

543+ = SLocal DocsStatus (Map.Map ModuleName.Raw ()) Src.Module

538 | SForeign I.Interface

544 | SForeign I.Interface

539 | SKernelLocal [Kernel.Chunk]

545 | SKernelLocal [Kernel.Chunk]

540 | SKernelForeign

546 | SKernelForeign

541

547

542

548

543−crawlModule :: Map.Map ModuleName.Raw ForeignInterface -> MVar StatusDict -> Pkg.Name -> FilePath -> ModuleName.Raw -> IO (Maybe Status)

549+crawlModule :: Map.Map ModuleName.Raw ForeignInterface -> MVar StatusDict -> Pkg.Name -> FilePath -> DocsStatus -> ModuleName.Raw -> IO (Maybe Status)

544−crawlModule foreignDeps mvar pkg src name =

550+crawlModule foreignDeps mvar pkg src docsStatus name =

545 do let path = src </> ModuleName.toFilePath name <.> "elm"

551 do let path = src </> ModuleName.toFilePath name <.> "elm"

546 exists <- File.exists path

552 exists <- File.exists path

547 case Map.lookup name foreignDeps of

553 case Map.lookup name foreignDeps of

@@ -555,7 +561,7 @@ crawlModule foreignDeps mvar pkg src name =

555

561

556 Nothing ->

562 Nothing ->

557 if exists then

563 if exists then

558− crawlFile foreignDeps mvar pkg src name path

564+ crawlFile foreignDeps mvar pkg src docsStatus name path

559

565

560 else if Pkg.isKernel pkg && Name.isKernel name then

566 else if Pkg.isKernel pkg && Name.isKernel name then

561 crawlKernel foreignDeps mvar pkg src name

567 crawlKernel foreignDeps mvar pkg src name

@@ -564,13 +570,13 @@ crawlModule foreignDeps mvar pkg src name =

564 return Nothing

570 return Nothing

565

571

566

572

567−crawlFile :: Map.Map ModuleName.Raw ForeignInterface -> MVar StatusDict -> Pkg.Name -> FilePath -> ModuleName.Raw -> FilePath -> IO (Maybe Status)

573+crawlFile :: Map.Map ModuleName.Raw ForeignInterface -> MVar StatusDict -> Pkg.Name -> FilePath -> DocsStatus -> ModuleName.Raw -> FilePath -> IO (Maybe Status)

568−crawlFile foreignDeps mvar pkg src expectedName path =

574+crawlFile foreignDeps mvar pkg src docsStatus expectedName path =

569 do bytes <- File.readUtf8 path

575 do bytes <- File.readUtf8 path

570 case Parse.fromByteString pkg bytes of

576 case Parse.fromByteString pkg bytes of

571 Right modul@(Src.Module (Just (A.At _ actualName)) _ _ imports _ _ _ _ _) | expectedName == actualName ->

577 Right modul@(Src.Module (Just (A.At _ actualName)) _ _ imports _ _ _ _ _) | expectedName == actualName ->

572 do deps <- crawlImports foreignDeps mvar pkg src imports

578 do deps <- crawlImports foreignDeps mvar pkg src imports

573− return (Just (SLocal deps modul))

579+ return (Just (SLocal docsStatus deps modul))

574

580

575 _ ->

581 _ ->

576 return Nothing

582 return Nothing

@@ -581,7 +587,7 @@ crawlImports foreignDeps mvar pkg src imports =

581 do statusDict <- takeMVar mvar

587 do statusDict <- takeMVar mvar

582 let deps = Map.fromList (map (\i -> (Src.getImportName i, ())) imports)

588 let deps = Map.fromList (map (\i -> (Src.getImportName i, ())) imports)

583 let news = Map.difference deps statusDict

589 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

585 putMVar mvar (Map.union mvars statusDict)

591 putMVar mvar (Map.union mvars statusDict)

586 mapM_ readMVar mvars

592 mapM_ readMVar mvars

587 return deps

593 return deps

@@ -617,7 +623,7 @@ getDepHome fi =

617

623

618

624

619data Result

625data Result

620− = RLocal !I.Interface !Opt.LocalGraph

626+ = RLocal !I.Interface !Opt.LocalGraph (Maybe Docs.Module)

621 | RForeign I.Interface

627 | RForeign I.Interface

622 | RKernelLocal [Kernel.Chunk]

628 | RKernelLocal [Kernel.Chunk]

623 | RKernelForeign

629 | RKernelForeign

@@ -626,7 +632,7 @@ data Result

626compile :: Pkg.Name -> MVar (Map.Map ModuleName.Raw (MVar (Maybe Result))) -> Status -> IO (Maybe Result)

632compile :: Pkg.Name -> MVar (Map.Map ModuleName.Raw (MVar (Maybe Result))) -> Status -> IO (Maybe Result)

627compile pkg mvar status =

633compile pkg mvar status =

628 case status of

634 case status of

629− SLocal deps modul ->

635+ SLocal docsStatus deps modul ->

630 do resultsDict <- readMVar mvar

636 do resultsDict <- readMVar mvar

631 maybeResults <- traverse readMVar (Map.intersection resultsDict deps)

637 maybeResults <- traverse readMVar (Map.intersection resultsDict deps)

632 case sequence maybeResults of

638 case sequence maybeResults of

@@ -639,7 +645,11 @@ compile pkg mvar status =

639 return Nothing

645 return Nothing

640

646

641 Right (Compile.Artifacts canonical annotations objects) ->

647 Right (Compile.Artifacts canonical annotations objects) ->

648+ let

642− return (Just (RLocal (I.fromModule pkg canonical annotations) objects))

649+ ifaces = I.fromModule pkg canonical annotations

650+ docs = makeDocs docsStatus canonical

651+ in

652+ return (Just (RLocal ifaces objects docs))

643

653

644 SForeign iface ->

654 SForeign iface ->

645 return (Just (RForeign iface))

655 return (Just (RForeign iface))

@@ -654,10 +664,59 @@ compile pkg mvar status =

654getInterface :: Result -> Maybe I.Interface

664getInterface :: Result -> Maybe I.Interface

655getInterface result =

665getInterface result =

656 case result of

666 case result of

657− RLocal iface _ -> Just iface

667+ RLocal iface _ _ -> Just iface

658− RForeign iface -> Just iface

668+ RForeign iface -> Just iface

659− RKernelLocal _ -> Nothing

669+ RKernelLocal _ -> Nothing

660− RKernelForeign -> 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

661

720

662

721

663

722

compiler/src/Json/Encode.hs+22−5

@@ -70,11 +70,6 @@ name nm =

70 String (B.char7 '"' <> Name.toBuilder nm <> B.char7 '"')

73−chars :: [Char] -> Value

74−chars chrs =

75− String (B.char7 '"' <> error "TODO escape this properly. Who is using this?" chrs <> B.char7 '"')

76−

77−

78bool :: Bool -> Value

73bool :: Bool -> Value

79bool =

74bool =

80 Boolean

75 Boolean

@@ -106,6 +101,28 @@ list encodeEntry entries =

106

101

107

102

108

103

104+-- CHARS

105+

106+

107+chars :: [Char] -> Value -- TODO can this be done better? Look for examples.

108+chars chrs =

109+ String (B.char7 '"' <> B.stringUtf8 (escape chrs) <> B.char7 '"')

110+

111+

112+escape :: [Char] -> [Char] -- TODO is this correct?

113+escape chrs =

114+ case chrs of

115+ [] ->

116+ []

117+

118+ c:cs

119+ | c == '\n' -> '\\' : 'n' : escape cs

120+ | c == '\"' -> '\\' : '"' : escape cs

121+ | c == '\'' -> '\\' : '\'' : escape cs

122+ | otherwise -> c : escape cs

123+

124+

125+

109-- HELPERS

126-- HELPERS

110

127

111

128