Merge pull request #3878 from urbit/pp/admonish

king: fix warnings; establish a stricter and more consistent warning policy

.github/workflows/build.yml

@@ -100,7 +100,7 @@ jobs:
           name: mars
           authToken: ${{ secrets.CACHIX_AUTH_TOKEN }}
 
-      - uses: GoogleCloudPlatform/github-actions/setup-gcloud@0.1.2
+      - uses: google-github-actions/setup-gcloud@v0.2.0
         with:
           version: '290.0.1'
           service_account_key: ${{ secrets.GCS_SERVICE_ACCOUNT_KEY }}

pkg/hs/proto/lib/SimpleNoun.hs

@@ -45,7 +45,8 @@ loob = \case
 
 textToAtom :: Text -> Atom
 textToAtom t = case N.textToUtf8Atom t of
-  N.A a -> a
+  N.A a   -> a
+  N.C _ _ -> error "textToAtom: nani!?"
 
 showA :: Atom -> String
 showA a = show (N.A a)

pkg/hs/proto/lib/Untyped/CST.hs

@@ -38,7 +38,7 @@ hone = go
       Atom a -> H.HAtom a
       Tag tx -> H.HAtom (textToAtom tx)
       Cord tx -> H.HAtom (textToAtom tx)
-      Tape tx -> undefined
+      Tape tx -> error "hone: tapes not implemented"
       Incr c -> H.DotLus (go c)
       IncrIrr c -> H.DotLus (go c)
       AppIrr c d -> H.CenHep (go c) (go d)

pkg/hs/proto/lib/Untyped/Core.hs

@@ -5,11 +5,8 @@ import ClassyPrelude
 import Bound
 import Control.Monad.Writer hiding (fix)
 import Data.Deriving (deriveEq1, deriveOrd1, deriveRead1, deriveShow1)
-import qualified Data.Function as F
-import Data.List (elemIndex)
 import Data.Maybe (fromJust)
 import qualified Data.Set as Set
-import Data.Void
 
 import Dashboard (pattern FastAtom)
 import Nock

pkg/hs/proto/lib/Untyped/Parser.hs

@@ -11,12 +11,7 @@ import Control.Monad.State.Lazy
 import Data.List.NonEmpty (NonEmpty(..))
 import Data.Void          (Void)
 import Prelude            (head)
-import Text.Format.Para   (formatParas)
 
-import qualified Data.MultiMap     as MM
-import qualified Data.Text         as T
-import qualified Data.Text.Lazy    as LT
-import qualified Data.Text.Lazy.IO as LT
 import qualified Prelude
 
 
@@ -325,6 +320,7 @@ cst = irregular <|> rune <|> literal
 
 -- Entry Point -----------------------------------------------------------------
 
+hoonFile :: StateT Mode (Parsec Void Text) CST
 hoonFile = do
   option () whitespace
   h <- cst

pkg/hs/proto/package.yaml

@@ -64,6 +64,7 @@ library:
     - -fwarn-incomplete-patterns
     - -fwarn-unused-binds
     - -fwarn-unused-imports
+    - -Wwarn
     - -O2
 
 executables:

pkg/hs/racquire/lib/Data/RAcquire.hs

@@ -18,9 +18,7 @@ import qualified Control.Exception     as E
 import qualified Control.Monad.Catch   as C ()
 import qualified Data.Acquire.Internal as Act
 
-import Control.Applicative     (Applicative(..))
-import Control.Monad           (ap, liftM)
-import Control.Monad.IO.Unlift (MonadIO(..), MonadUnliftIO, withRunInIO)
+import Control.Monad.IO.Unlift (MonadUnliftIO, withRunInIO)
 import Control.Monad.Reader
 import Data.Typeable           (Typeable)
 

pkg/hs/racquire/package.yaml

@@ -6,9 +6,11 @@ license-file: LICENSE
 library:
   source-dirs: lib
   ghc-options:
-    - -fwarn-incomplete-patterns
-    - -fwarn-unused-binds
-    - -fwarn-unused-imports
+    - -Wall
+    - -Werror
+    - -Wno-type-defaults
+    - -Wno-unused-matches
+    - -Wno-name-shadowing
     - -O2
 
 dependencies:

pkg/hs/urbit-atom/bench/Main.hs

@@ -1,3 +1,5 @@
+{-# OPTIONS_GHC -Wno-missing-signatures #-}
+
 module Main (main) where
 
 import Prelude

pkg/hs/urbit-atom/package.yaml

@@ -4,10 +4,12 @@ license: MIT
 license-file: LICENSE
 
 ghc-options:
-  - -fwarn-incomplete-patterns
-  - -fwarn-unused-binds
-  - -fwarn-unused-imports
+  - -Wall
   - -Werror
+  - -Wno-type-defaults
+  - -Wno-unused-matches
+  - -Wno-name-shadowing
+  - -Wno-unbanged-strict-patterns
   - -O2
 
 library:

pkg/hs/urbit-atom/test/Main.hs

@@ -1,4 +1,4 @@
-{-# OPTIONS_GHC -Wno-deprecations #-}
+{-# OPTIONS_GHC -Wno-deprecations -Wno-orphans #-}
 
 
 module Main (main) where

pkg/hs/urbit-king/lib/Urbit/Arvo/Common.hs

@@ -4,6 +4,9 @@
 -- combination with 'deriveNoun' which generates an unreachable pattern.
 {-# OPTIONS_GHC -Wno-overlapping-patterns #-}
 
+-- Hack. See comment above instance ToNoun H.StdMethod
+{-# OPTIONS_GHC -Wno-orphans #-}
+
 {-|
     Types used in both Events and Effects.
 -}
@@ -15,7 +18,7 @@ module Urbit.Arvo.Common
   , HttpServerConf(..), PEM(..), Key, Cert
   , HttpEvent(..), Method, Header(..), ResponseHeader(..)
   , ReOrg(..), reorgThroughNoun
-  , AmesDest(..), Ipv4(..), Ipv6(..), Patp(..), Galaxy, AmesAddress(..)
+  , AmesDest, Ipv4(..), Ipv6(..), Patp(..), Galaxy, AmesAddress(..)
   ) where
 
 import Urbit.Prelude hiding (Term)

pkg/hs/urbit-king/lib/Urbit/Vere/Ames.hs

@@ -10,7 +10,7 @@ module Urbit.Vere.Ames (ames, ames', PacketOutcome(..)) where
 
 import Urbit.Prelude
 
-import Network.Socket              hiding (recvFrom, sendTo)
+import Network.Socket
 import Urbit.Arvo                  hiding (Fake)
 import Urbit.King.Config
 import Urbit.King.Scry

pkg/hs/urbit-king/lib/Urbit/Vere/Ames/DNS.hs

@@ -61,7 +61,7 @@ where
 
 import Urbit.Prelude
 
-import Network.Socket        hiding (recvFrom, sendTo)
+import Network.Socket
 import Urbit.Arvo            hiding (Fake)
 
 import qualified Data.Map.Strict as M

pkg/hs/urbit-king/lib/Urbit/Vere/Ames/UDP.hs

@@ -35,7 +35,7 @@ where
 import Urbit.Prelude
 import Urbit.Vere.Ports
 
-import Network.Socket hiding (recvFrom, sendTo)
+import Network.Socket
 
 import Control.Monad.STM         (retry)
 import Network.Socket.ByteString (recvFrom, sendTo)

pkg/hs/urbit-king/lib/Urbit/Vere/Behn.hs

@@ -8,6 +8,8 @@
 
 module Urbit.Vere.Behn (behn, DriverApi(..), behn') where
 
+import Data.Time.Clock.System (SystemTime)
+
 import Urbit.Arvo            hiding (Behn)
 import Urbit.Prelude
 import Urbit.Vere.Pier.Types
@@ -39,6 +41,7 @@ bornEv king = EvBlip $ BlipEvBehn $ BehnEvBorn (king, ()) ()
 wakeEv :: Ev
 wakeEv = EvBlip $ BlipEvBehn $ BehnEvWake () ()
 
+sysTime :: Wen -> SystemTime
 sysTime = view Time.systemTime
 
 wakeErr :: WorkError -> IO ()

pkg/hs/urbit-king/lib/Urbit/Vere/Clay.hs

@@ -8,7 +8,7 @@ module Urbit.Vere.Clay
   )
 where
 
-import Urbit.Arvo            hiding (Term)
+import Urbit.Arvo
 import Urbit.King.App
 import Urbit.Prelude
 import Urbit.Vere.Pier.Types
@@ -32,6 +32,7 @@ deskToPath :: Desk -> FilePath
 deskToPath (Desk (Cord t)) = unpack t
 
 -- | The hard coded mime type of every file.
+textPlain :: Path
 textPlain = Path [(MkKnot "text"), (MkKnot "plain")]
 
 -- | Filter for dotfiles, tempfiles and backup files.

pkg/hs/urbit-king/lib/Urbit/Vere/Dawn.hs

@@ -17,7 +17,7 @@ module Urbit.Vere.Dawn ( dawnVent
 
 import Urbit.Arvo.Common
 import Urbit.Arvo.Event  hiding (Address)
-import Urbit.Prelude     hiding (Call, rights, to, (.=))
+import Urbit.Prelude     hiding (rights, to, (.=))
 
 import Data.Bits                     (xor)
 import Data.List                     (nub)

pkg/hs/urbit-king/lib/Urbit/Vere/Eyre.hs

@@ -10,7 +10,7 @@ where
 
 import Urbit.Prelude hiding (Builder)
 
-import Urbit.Arvo                hiding (ServerId, reqUrl, secure)
+import Urbit.Arvo                hiding (ServerId, reqUrl)
 import Urbit.King.App            (HasKingId(..), HasMultiEyreApi(..), HasPierEnv(..))
 import Urbit.King.Config
 import Urbit.Vere.Eyre.Multi

pkg/hs/urbit-king/lib/Urbit/Vere/Eyre/Multi.hs

@@ -16,7 +16,7 @@ where
 
 import Urbit.Prelude hiding (Builder)
 
-import Urbit.Arvo           hiding (ServerId, reqUrl, secure)
+import Urbit.Arvo           hiding (ServerId, reqUrl)
 import Urbit.Vere.Eyre.Serv
 import Urbit.Vere.Eyre.Wai
 

pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs

@@ -18,7 +18,7 @@ import Foreign.Storable
 import RIO.FilePath
 import System.Posix.IO
 import System.Posix.Terminal
-import Urbit.Arvo            hiding (Term)
+import Urbit.Arvo
 import Urbit.King.App
 import Urbit.Noun.Time
 import Urbit.Prelude         hiding (getCurrentTime)
@@ -71,8 +71,10 @@ data Private = Private
 
 -- Utils -----------------------------------------------------------------------
 
+blewEvent :: Word -> Word -> Ev
 blewEvent w h = EvBlip $ BlipEvTerm $ TermEvBlew (UD 1, ()) w h
 
+initialHail :: Ev
 initialHail = EvBlip $ BlipEvTerm $ TermEvHail (UD 1, ()) ()
 
 -- Version one of this is punting on the ops_u.dem flag: whether we're running
@@ -162,6 +164,7 @@ leftBracket, rightBracket :: Text
 leftBracket = "«"
 rightBracket = "»"
 
+_spin_cool_us, _spin_warm_us, _spin_rate_us, _spin_idle_us :: Integral i => i
 _spin_cool_us = 500000
 _spin_warm_us = 50000
 _spin_rate_us = 250000

pkg/hs/urbit-king/package.yaml

@@ -9,10 +9,12 @@ data-files:
 library:
   source-dirs: lib
   ghc-options:
-    - -fwarn-incomplete-patterns
-    - -fwarn-unused-binds
-    - -fwarn-unused-imports
+    - -Wall
     - -Werror
+    - -Wno-type-defaults
+    - -Wno-unused-matches
+    - -Wno-name-shadowing
+    - -Wno-unused-do-bind
     - -O2
 
 tests:

pkg/hs/urbit-noun-core/lib/Urbit/Noun/Core.hs

@@ -37,11 +37,17 @@ data Noun
     = NCell Int Word !Noun !Noun
     | NAtom Int !Atom
 
+pattern Cell :: Noun -> Noun -> Noun
+pattern Atom :: Atom -> Noun
+
 pattern Cell x y <- NCell _ _ x y where Cell = mkCell
 pattern Atom a   <- NAtom _ a     where Atom = mkAtom
 
 {-# COMPLETE Cell, Atom #-}
 
+pattern C :: Noun -> Noun -> Noun
+pattern A :: Atom -> Noun
+
 pattern C x y <- NCell _ _ x y where C = mkCell
 pattern A a   <- NAtom _ a     where A = mkAtom
 

pkg/hs/urbit-noun-core/package.yaml

@@ -6,10 +6,11 @@ license-file: LICENSE
 library:
   source-dirs: lib
   ghc-options:
-    - -fwarn-incomplete-patterns
-    - -fwarn-unused-binds
-    - -fwarn-unused-imports
+    - -Wall
     - -Werror
+    - -Wno-type-defaults
+    - -Wno-unused-matches
+    - -Wno-name-shadowing
     - -O2
 
 dependencies:

pkg/hs/urbit-noun/lib/Urbit/Noun/Tree.hs

@@ -41,6 +41,7 @@ data HoonTreeNode a = NTN
 data HoonTree a = E | Node (HoonTreeNode a)
   deriving (Eq, Ord, Show)
 
+pattern N :: NounVal a -> HoonTree a -> HoonTree a -> HoonTree a
 pattern N n l r = Node (NTN n l r)
 
 newtype HoonSet a = HoonSet { unHoonSet :: HoonTree a }

pkg/hs/urbit-noun/package.yaml

@@ -6,10 +6,12 @@ license-file: LICENSE
 library:
   source-dirs: lib
   ghc-options:
-    - -fwarn-incomplete-patterns
-    - -fwarn-unused-binds
-    - -fwarn-unused-imports
+    - -Wall
     - -Werror
+    - -Wno-type-defaults
+    - -Wno-unused-matches
+    - -Wno-name-shadowing
+    - -Wno-orphans
     - -O2
 
 dependencies:

pkg/hs/urbit-termsize/app/Main.hs

@@ -3,7 +3,6 @@ module Main where
 import Prelude
 
 import Urbit.TermSize (liveTermSize)
-import System.IO (getLine)
 
 main :: IO ()
 main = do

pkg/hs/urbit-termsize/package.yaml

@@ -9,9 +9,12 @@ dependencies:
   - unix
 
 ghc-options:
-  - -fwarn-incomplete-patterns
-  - -fwarn-unused-binds
-  - -fwarn-unused-imports
+  - -Wall
+  - -Werror
+  - -Wno-type-defaults
+  - -Wno-unused-matches
+  - -Wno-name-shadowing
+  - -Wno-unused-do-bind
   - -O2
 
 library: