on 42f3721 help sign in
elk/builder/src/Stuff/Verify.hs
120 lines 3.1 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2module Stuff.Verify
3 ( verify
4 )
5 where
8import Control.Monad (liftM2, liftM4)
9import Data.Binary
10import Data.Map (Map)
12import qualified Elm.Compiler.Module as Module
13import Elm.Package (Name, Version)
15import qualified Deps.Verify as Verify
16import qualified Elm.Project.Json as Project
17import qualified Elm.Project.Constraint as Con
18import qualified Elm.Project.Summary as Summary
19import qualified File.IO as IO
20import qualified Reporting.Task as Task
21import qualified Stuff.Paths as Path
25-- VERIFY
28verify :: FilePath -> Project.Project -> Task.Task Summary.Summary
29verify root project =
30 do exists <- IO.exists Path.summary
31 if exists
32 then
33 do (MiniSummary deps exposed ifaces graph) <- IO.readBinary Path.summary
34 if isValidMiniSummary deps project
35 then
36 return (Summary.Summary root project exposed ifaces graph)
37 else
38 do IO.remove Path.summary
39 cacheSummary root project
40 else
41 cacheSummary root project
44cacheSummary :: FilePath -> Project.Project -> Task.Task Summary.Summary
45cacheSummary root project =
46 do summary@(Summary.Summary _ _ exposed ifaces graph) <- Verify.verify root project
47 IO.writeBinary Path.summary (MiniSummary (getDeps project) exposed ifaces graph)
48 return summary
52-- MINI SUMMARY
55data MiniSummary =
56 MiniSummary
57 { _deps :: ProjectDeps
58 , _exposed :: Summary.ExposedModules
59 , _ifaces :: Module.Interfaces
60 , _depsGraph :: Summary.DepsGraph
61 }
64data ProjectDeps
65 = App (Map Name Version) (Map Name Version) (Map Name Version) (Map Name Version)
66 | Pkg (Map Name Con.Constraint) (Map Name Con.Constraint)
69getDeps :: Project.Project -> ProjectDeps
70getDeps project =
71 case project of
72 Project.App (Project.AppInfo _ _ depsDirect depsTrans testDirect testTrans) ->
73 App depsDirect depsTrans testDirect testTrans
75 Project.Pkg (Project.PkgInfo _ _ _ _ _ direct test _) ->
76 Pkg direct test
79isValidMiniSummary :: ProjectDeps -> Project.Project -> Bool
80isValidMiniSummary deps project =
81 case deps of
82 App a b c d ->
83 case project of
84 Project.Pkg _ ->
85 False
87 Project.App (Project.AppInfo _ _ a2 b2 c2 d2) ->
88 a == a2 && b == b2 && c == c2 && d == d2
90 Pkg a b ->
91 case project of
92 Project.Pkg (Project.PkgInfo _ _ _ _ _ a2 b2 _) ->
93 a == a2 && b == b2
95 Project.App _ ->
96 False
100-- BINARY
103instance Binary MiniSummary where
104 get = liftM4 MiniSummary get get get get
105 put (MiniSummary a b c d) = put a >> put b >> put c >> put d
109instance Binary ProjectDeps where
110 put deps =
111 case deps of
112 App a b c d -> putWord8 0 >> put a >> put b >> put c >> put d
113 Pkg a b -> putWord8 1 >> put a >> put b
115 get =
116 do n <- getWord8
117 case n of
118 0 -> liftM4 App get get get get
119 1 -> liftM2 Pkg get get
120 _ -> error "binary encoding of ProjectDeps was corrupted"