Skip to content

Commit e1033f3

Browse files
committed
fix incomplete-uni-patterns warning, ignore some others
the `flake.nix` build fails on these warnings: haskell#1154
1 parent 9774da5 commit e1033f3

File tree

3 files changed

+13
-5
lines changed

3 files changed

+13
-5
lines changed

exes/Main.hs

Lines changed: 7 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -357,15 +357,19 @@ runAction opts = do
357357
-> return n
358358
_ -> fail $ "bad port number " ++ show str
359359

360+
checkHostURI :: ServerConfig -> Maybe String -> Int -> IO URI
360361
checkHostURI defaults Nothing port = do
361362
let guessURI = confHostUri defaults
362-
Just authority = uriAuthority guessURI
363+
case uriAuthority guessURI of
364+
Nothing -> fail "No URI Authority"
365+
Just authority -> let
363366
portStr | port == 80 = ""
364367
| otherwise = ':' : show port
365368
guessURI' = guessURI { uriAuthority = Just authority { uriPort = portStr } }
366-
lognotice verbosity $ "Guessing public URI as " ++ show guessURI'
369+
in do
370+
lognotice verbosity $ "Guessing public URI as " ++ show guessURI'
367371
++ "\n(you can override with the --base-uri= flag)"
368-
return guessURI'
372+
return guessURI'
369373

370374
checkHostURI _ (Just str) _ = case parseAbsoluteURI str of
371375
Nothing -> fail $ "Cannot parse as a URI: " ++ str ++ "\n"

src/Distribution/Server/Features/AdminFrontend.hs

Lines changed: 5 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
11
{-# OPTIONS_GHC -fno-warn-orphans #-}
2+
{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}
23
{-# LANGUAGE NamedFieldPuns, RecordWildCards #-}
34
module Distribution.Server.Features.AdminFrontend (
45
initAdminFrontendFeature
@@ -190,7 +191,8 @@ adminFrontendFeature _env templates
190191
ok $ toResponse $ template
191192
[ "resets" $= [ resetRequestToTemplate resetInfo uinfo
192193
| resetInfo@ResetInfo {resetUserId} <- allResetInfo
193-
, let Just uinfo = Users.lookupUserId resetUserId usersdb ]
194+
, let Just uinfo = Users.lookupUserId resetUserId usersdb
195+
]
194196
]
195197

196198
serveAdminLegacyGet :: DynamicPath -> ServerPartE Response
@@ -203,7 +205,8 @@ adminFrontendFeature _env templates
203205
ok $ toResponse $ template
204206
[ "accounts" $= [ accountBasicInfoToTemplate uid uinfo
205207
| uid <- legacyUsers
206-
, let Just uinfo = Users.lookupUserId uid usersdb ]
208+
, let Just uinfo = Users.lookupUserId uid usersdb
209+
]
207210
]
208211

209212
resetRequestToTemplate :: SignupResetInfo -> UserInfo -> TemplateVal

src/Distribution/Server/Features/UserSignup.hs

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,4 @@
1+
{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}
12
{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving,
23
TypeFamilies, TemplateHaskell,
34
RankNTypes, NamedFieldPuns, RecordWildCards, BangPatterns #-}

0 commit comments

Comments
 (0)