@@ -20,13 +20,8 @@ import Gren.Outline qualified as Outline
2020import Gren.Package qualified as Pkg
2121import Gren.Version qualified as V
2222import Reporting qualified
23- import Reporting.Doc ((<+>) )
24- import Reporting.Doc qualified as D
2523import Reporting.Exit qualified as Exit
26- import Reporting.Exit.Help qualified as Help
2724import Reporting.Task qualified as Task
28- import System.IO qualified as IO
29- import System.Info qualified as Info
3025
3126data Flags = Flags
3227 { _project_path :: String ,
@@ -64,9 +59,7 @@ validate (Flags root knownVersions (Command.ProjectInfo currentOutline currentSo
6459
6560verifyBuild :: FilePath -> Outline. PkgOutline -> Build. Sources -> Map Pkg. Name Details. Dependency -> Task. Task Exit. Validate Docs. Documentation
6661verifyBuild root outline sources solution =
67- reportBuildCheck $
68- Task. run $
69- buildProject root outline sources solution
62+ buildProject root outline sources solution
7063
7164buildProject :: FilePath -> Outline. PkgOutline -> Build. Sources -> Map Pkg. Name Details. Dependency -> Task. Task Exit. Validate Docs. Documentation
7265buildProject root pkgOutline@ (Outline. PkgOutline _ _ _ _ _ _ _ _) sources solution =
@@ -111,52 +104,3 @@ verifyBump vsn newDocs oldDocs knownVersions =
111104 return $
112105 Left $
113106 Exit. ValidateBadBump old new magnitude realNew (Diff. toMagnitude changes)
114-
115- -- REPORTING PHASES
116-
117- reportBuildCheck :: IO (Either x a ) -> Task. Task x a
118- reportBuildCheck =
119- reportCheck
120- " Verifying documentation..."
121- " Verified documentation"
122- " Problem with documentation"
123-
124- reportCheck :: String -> String -> String -> IO (Either x a ) -> Task. Task x a
125- reportCheck waiting success failure work =
126- reportCustomCheck waiting (\ _ -> success) failure work
127-
128- reportCustomCheck :: String -> (a -> String ) -> String -> IO (Either x a ) -> Task. Task x a
129- reportCustomCheck waiting success failure work =
130- let putFlush doc =
131- Help. toStdout doc >> IO. hFlush IO. stdout
132-
133- padded message =
134- message ++ replicate (length waiting - length message) ' '
135- in Task. eio id $
136- do
137- putFlush $ " " <> waitingMark <+> D. fromChars waiting
138- result <- work
139- putFlush $
140- case result of
141- Right a -> " \r " <> goodMark <+> D. fromChars (padded (success a) ++ " \n " )
142- Left _ -> " \r " <> badMark <+> D. fromChars (padded failure ++ " \n\n " )
143-
144- return result
145-
146- -- MARKS
147-
148- goodMark :: D. Doc
149- goodMark =
150- D. green $ if isWindows then " +" else " ●"
151-
152- badMark :: D. Doc
153- badMark =
154- D. red $ if isWindows then " X" else " ✗"
155-
156- waitingMark :: D. Doc
157- waitingMark =
158- D. dullyellow $ if isWindows then " -" else " →"
159-
160- isWindows :: Bool
161- isWindows =
162- Info. os == " mingw32"
0 commit comments