Removing reporting of dependencies, as they're always loaded by the frontend.

Author: robinheghan

builder/src/Gren/Details.hs

@@ -46,7 +46,6 @@ import Gren.Package qualified as Pkg
 import Gren.Platform qualified as P
 import Gren.Version qualified as V
 import Parse.Module qualified as Parse
-import Reporting qualified
 import Reporting.Annotation qualified as A
 import Reporting.Exit qualified as Exit
 import Reporting.Task qualified as Task
@@ -122,24 +121,17 @@ loadInterfaces root (Details _ _ _ _ _ extras) =
 
 -- LOAD -- used by Make, Docs, Repl
 
-load :: Reporting.Style -> Outline.Outline -> Map.Map Pkg.Name Dependency -> IO (Either Exit.Details Details)
-load style outline solution =
-  Reporting.trackDetails style $ \key ->
-    generate key outline solution
-
--- GENERATE
-
-generate :: Reporting.DKey -> Outline.Outline -> Map.Map Pkg.Name Dependency -> IO (Either Exit.Details Details)
-generate key outline solution =
+load :: Outline.Outline -> Map.Map Pkg.Name Dependency -> IO (Either Exit.Details Details)
+load outline solution =
   case outline of
     Outline.Pkg (Outline.PkgOutline pkg _ _ _ exposed direct _ rootPlatform) ->
       Task.run $
         do
           let exposedList = Outline.flattenExposed exposed
-          verifyDependencies key (ValidPkg rootPlatform pkg exposedList) solution direct
+          verifyDependencies (ValidPkg rootPlatform pkg exposedList) solution direct
     Outline.App (Outline.AppOutline _ rootPlatform srcDirs direct _) ->
       Task.run $
-        verifyDependencies key (ValidApp rootPlatform srcDirs) solution direct
+        verifyDependencies (ValidApp rootPlatform srcDirs) solution direct
 
 type Task a = Task.Task Exit.Details a
 
@@ -154,12 +146,12 @@ fork work =
 
 -- VERIFY DEPENDENCIES
 
-verifyDependencies :: Reporting.DKey -> ValidOutline -> Map.Map Pkg.Name Dependency -> Map.Map Pkg.Name a -> Task Details
-verifyDependencies key outline solution directDeps =
+verifyDependencies :: ValidOutline -> Map.Map Pkg.Name Dependency -> Map.Map Pkg.Name a -> Task Details
+verifyDependencies outline solution directDeps =
   Task.eio id $
     do
       mvar <- newEmptyMVar
-      mvars <- Map.traverseWithKey (\k v -> fork (build key mvar k v)) solution
+      mvars <- Map.traverseWithKey (\k v -> fork (build mvar k v)) solution
       putMVar mvar mvars
       deps <- traverse readMVar mvars
       case sequence deps of
@@ -221,12 +213,11 @@ type Fingerprint =
 
 -- BUILD
 
-build :: Reporting.DKey -> MVar (Map.Map Pkg.Name (MVar Dep)) -> Pkg.Name -> Dependency -> IO Dep
-build key depsMVar pkg (Dependency outline sources) =
+build :: MVar (Map.Map Pkg.Name (MVar Dep)) -> Pkg.Name -> Dependency -> IO Dep
+build depsMVar pkg (Dependency outline sources) =
   case outline of
     (Outline.App _) ->
       do
-        Reporting.report key Reporting.DBroken
         return $ Left $ Just $ Exit.BD_BadBuild pkg V.one Map.empty
     (Outline.Pkg (Outline.PkgOutline _ _ _ _ exposed deps _ platform)) ->
       do
@@ -235,7 +226,6 @@ build key depsMVar pkg (Dependency outline sources) =
         case sequence directDeps of
           Left _ ->
             do
-              Reporting.report key Reporting.DBroken
               return $ Left Nothing
           Right directArtifacts ->
             do
@@ -251,11 +241,9 @@ build key depsMVar pkg (Dependency outline sources) =
               case sequence maybeStatuses of
                 Left CrawlCorruption ->
                   do
-                    Reporting.report key Reporting.DBroken
                     return $ Left $ Just $ Exit.BD_BadBuild pkg V.one Map.empty
                 Left CrawlUnsignedKernelCode ->
                   do
-                    Reporting.report key Reporting.DBroken
                     return $ Left $ Just $ Exit.BD_UnsignedBuild pkg V.one
                 Right statuses ->
                   do
@@ -266,14 +254,12 @@ build key depsMVar pkg (Dependency outline sources) =
                     case sequence maybeResults of
                       Nothing ->
                         do
-                          Reporting.report key Reporting.DBroken
                           return $ Left $ Just $ Exit.BD_BadBuild pkg V.one Map.empty
                       Just results ->
                         let ifaces = gatherInterfaces exposedDict results
                             objects = gatherObjects results
                             artifacts = Artifacts ifaces objects
                          in do
-                              Reporting.report key Reporting.DBuilt
                               return (Right artifacts)
 
 -- GATHER

builder/src/Reporting.hs

@@ -15,10 +15,6 @@ module Reporting
     ignorer,
     ask,
     --
-    DKey,
-    DMsg (..),
-    trackDetails,
-    --
     BKey,
     BMsg (..),
     trackBuild,
@@ -31,14 +27,10 @@ where
 
 import Control.Concurrent
 import Control.Exception (AsyncException (UserInterrupt), SomeException, catch, fromException, throw)
-import Control.Monad (when)
 import Data.ByteString.Builder qualified as B
 import Data.NonEmptyList qualified as NE
 import Gren.ModuleName qualified as ModuleName
-import Gren.Package qualified as Pkg
-import Gren.Version qualified as V
 import Json.Encode qualified as Encode
-import Reporting.Doc ((<+>))
 import Reporting.Doc qualified as D
 import Reporting.Exit qualified as Exit
 import Reporting.Exit.Help qualified as Help
@@ -102,14 +94,6 @@ attemptWithStyle style toReport work =
 
 -- MARKS
 
-goodMark :: D.Doc
-goodMark =
-  D.green $ if isWindows then "+" else "●"
-
-badMark :: D.Doc
-badMark =
-  D.red $ if isWindows then "X" else "✗"
-
 isWindows :: Bool
 isWindows =
   Info.os == "mingw32"
@@ -151,122 +135,6 @@ askHelp =
           putStr "Must type 'y' for yes or 'n' for no: "
           askHelp
 
--- DETAILS
-
-type DKey = Key DMsg
-
-trackDetails :: Style -> (DKey -> IO a) -> IO a
-trackDetails style callback =
-  case style of
-    Silent ->
-      callback (Key (\_ -> return ()))
-    Json ->
-      callback (Key (\_ -> return ()))
-    Terminal mvar ->
-      do
-        chan <- newChan
-
-        _ <- forkIO $
-          do
-            takeMVar mvar
-            detailsLoop chan (DState 0 0 0 0 0 0 0)
-            putMVar mvar ()
-
-        answer <- callback (Key (writeChan chan . Just))
-        writeChan chan Nothing
-        return answer
-
-detailsLoop :: Chan (Maybe DMsg) -> DState -> IO ()
-detailsLoop chan state@(DState total _ _ _ _ built _) =
-  do
-    msg <- readChan chan
-    case msg of
-      Just dmsg ->
-        detailsLoop chan =<< detailsStep dmsg state
-      Nothing ->
-        putStrLn $
-          clear (toBuildProgress total total) $
-            if built == total
-              then "Dependencies ready!"
-              else "Dependency problem!"
-
-data DState = DState
-  { _total :: !Int,
-    _cached :: !Int,
-    _requested :: !Int,
-    _received :: !Int,
-    _failed :: !Int,
-    _built :: !Int,
-    _broken :: !Int
-  }
-
-data DMsg
-  = DStart Int
-  | DCached
-  | DRequested
-  | DReceived Pkg.Name V.Version
-  | DFailed Pkg.Name V.Version
-  | DBuilt
-  | DBroken
-
-detailsStep :: DMsg -> DState -> IO DState
-detailsStep msg (DState total cached rqst rcvd failed built broken) =
-  case msg of
-    DStart numDependencies ->
-      return (DState numDependencies 0 0 0 0 0 0)
-    DCached ->
-      putTransition (DState total (cached + 1) rqst rcvd failed built broken)
-    DRequested ->
-      do
-        when (rqst == 0) (putStrLn "Starting downloads...\n")
-        return (DState total cached (rqst + 1) rcvd failed built broken)
-    DReceived pkg vsn ->
-      do
-        putDownload goodMark pkg vsn
-        putTransition (DState total cached rqst (rcvd + 1) failed built broken)
-    DFailed pkg vsn ->
-      do
-        putDownload badMark pkg vsn
-        putTransition (DState total cached rqst rcvd (failed + 1) built broken)
-    DBuilt ->
-      putBuilt (DState total cached rqst rcvd failed (built + 1) broken)
-    DBroken ->
-      putBuilt (DState total cached rqst rcvd failed built (broken + 1))
-
-putDownload :: D.Doc -> Pkg.Name -> V.Version -> IO ()
-putDownload mark pkg vsn =
-  Help.toStdout $
-    D.indent 2 $
-      mark
-        <+> D.fromPackage pkg
-        <+> D.fromVersion vsn
-        <> "\n"
-
-putTransition :: DState -> IO DState
-putTransition state@(DState total cached _ rcvd failed built broken) =
-  if cached + rcvd + failed < total
-    then return state
-    else do
-      let char = if rcvd + failed == 0 then '\r' else '\n'
-      putStrFlush (char : toBuildProgress (built + broken + failed) total)
-      return state
-
-putBuilt :: DState -> IO DState
-putBuilt state@(DState total cached _ rcvd failed built broken) =
-  do
-    when (total == cached + rcvd + failed) $
-      putStrFlush $
-        '\r' : toBuildProgress (built + broken + failed) total
-    return state
-
-toBuildProgress :: Int -> Int -> [Char]
-toBuildProgress built total =
-  "Verifying dependencies (" ++ show built ++ "/" ++ show total ++ ")"
-
-clear :: [Char] -> [Char] -> [Char]
-clear before after =
-  '\r' : replicate (length before) ' ' ++ '\r' : after
-
 -- BUILD
 
 type BKey = Key BMsg

terminal/Docs.hs

@@ -55,7 +55,7 @@ runHelp :: Reporting.Style -> Flags -> IO (Either Exit.Docs ())
 runHelp style (Flags maybeOutput _ root outline sources dependencies) =
   Task.run $
     do
-      details <- Task.eio Exit.DocsBadDetails (Details.load style outline dependencies)
+      details <- Task.eio Exit.DocsBadDetails (Details.load outline dependencies)
       exposed <- getExposed details
       case maybeOutput of
         Just DevNull ->

terminal/Make.hs

@@ -66,7 +66,6 @@ run flags@(Flags _ _ maybeOutput report _ _ _ _ _) =
   do
     style <- getStyle maybeOutput report
     -- TODO: File locking in frontend
-    -- TODO: Show error for Exit.MakeNoOutline in frontend
     Reporting.attemptWithStyle style Exit.makeToReport $
       runHelp style flags
 
@@ -75,7 +74,7 @@ runHelp style flags@(Flags optimize withSourceMaps maybeOutput _ modules root ou
   Task.run $
     do
       desiredMode <- getMode optimize
-      details <- Task.eio Exit.MakeBadDetails (Details.load style outline deps)
+      details <- Task.eio Exit.MakeBadDetails (Details.load outline deps)
       let platform = getPlatform details
       case modules of
         [] ->

terminal/Package/Bump.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_GHC -Wno-x-partial #-}
 
 module Package.Bump
   ( run,
@@ -51,7 +52,7 @@ run flags@(Flags _ _ _ currentVersion publishedVersion) =
 -- BUMP
 
 bump :: Flags -> Outline.PkgOutline -> Outline.PkgOutline -> Task.Task Exit.Bump ()
-bump flags@(Flags _ root knownVersions _ _) currentOutline@(Outline.PkgOutline _ _ _ vsn _ _ _ _) publishedOutline =
+bump flags@(Flags _ _ knownVersions _ _) currentOutline@(Outline.PkgOutline _ _ _ vsn _ _ _ _) publishedOutline =
   Task.eio id $
     case reverse knownVersions of
       (v : vs) ->
@@ -67,21 +68,6 @@ bump flags@(Flags _ root knownVersions _ _) currentOutline@(Outline.PkgOutline _
       [] ->
         error "known versions was empty"
 
--- CHECK NEW PACKAGE
-
-checkNewPackage :: Flags -> FilePath -> Outline.PkgOutline -> IO ()
-checkNewPackage flags root outline@(Outline.PkgOutline _ _ _ version _ _ _ _) =
-  do
-    putStrLn Exit.newPackageOverview
-    if version == V.one
-      then putStrLn "The version number in gren.json is correct so you are all set!"
-      else
-        changeVersion flags root outline V.one $
-          "It looks like the version in gren.json has been changed though!\n\
-          \Would you like me to change it back to "
-            <> D.fromVersion V.one
-            <> "? [Y/n] "
-
 -- SUGGEST VERSION
 
 suggestVersion :: Flags -> Outline.PkgOutline -> Outline.PkgOutline -> Task.Task Exit.Bump ()
@@ -116,7 +102,7 @@ generateDocs root outline@(Outline.PkgOutline _ _ _ _ exposed _ _ _) sources sol
   do
     details <-
       Task.eio Exit.BumpBadDetails $
-        Details.load Reporting.silent (Outline.Pkg outline) solution
+        Details.load (Outline.Pkg outline) solution
 
     case Outline.flattenExposed exposed of
       [] ->

terminal/Package/Diff.hs

@@ -70,7 +70,7 @@ generateDocs root outline@(Outline.PkgOutline _ _ _ _ exposed _ _ _) sources sol
   do
     details <-
       Task.eio Exit.DiffBadDetails $
-        Details.load Reporting.silent (Outline.Pkg outline) solution
+        Details.load (Outline.Pkg outline) solution
 
     case Outline.flattenExposed exposed of
       [] ->