Skip to content

Commit

Permalink
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Fix hlint warnings
Browse files Browse the repository at this point in the history
The nixpkgs update implied an hlint update which enabled new warnings.
aherrmann committed Jul 16, 2020

Verified

This commit was created on GitHub.com and signed with GitHub’s verified signature.
1 parent ebf808d commit 1e72a5c
Showing 19 changed files with 41 additions and 57 deletions.
2 changes: 1 addition & 1 deletion compatibility/bazel_tools/create-daml-app/Main.hs
Original file line number Diff line number Diff line change
@@ -42,7 +42,7 @@ data Tools = Tools

newtype DamlOption = DamlOption FilePath
instance IsOption DamlOption where
defaultValue = DamlOption $ "daml"
defaultValue = DamlOption "daml"
parseValue = Just . DamlOption
optionName = Tagged "daml"
optionHelp = Tagged "runfiles path to the daml executable"
6 changes: 3 additions & 3 deletions compatibility/bazel_tools/daml_ledger/Main.hs
Original file line number Diff line number Diff line change
@@ -33,14 +33,14 @@ data Tools = Tools

newtype DamlOption = DamlOption FilePath
instance IsOption DamlOption where
defaultValue = DamlOption $ "daml"
defaultValue = DamlOption "daml"
parseValue = Just . DamlOption
optionName = Tagged "daml"
optionHelp = Tagged "runfiles path to the daml executable"

newtype SandboxOption = SandboxOption FilePath
instance IsOption SandboxOption where
defaultValue = SandboxOption $ "sandbox"
defaultValue = SandboxOption "sandbox"
parseValue = Just . SandboxOption
optionName = Tagged "sandbox"
optionHelp = Tagged "runfiles path to the sandbox executable"
@@ -56,7 +56,7 @@ instance IsOption SandboxArgsOption where

newtype CertificatesOption = CertificatesOption FilePath
instance IsOption CertificatesOption where
defaultValue = CertificatesOption $ "certificates"
defaultValue = CertificatesOption "certificates"
parseValue = Just . CertificatesOption
optionName = Tagged "certs"
optionHelp = Tagged "runfiles path to the certificates directory"
Original file line number Diff line number Diff line change
@@ -3,7 +3,6 @@

{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE PatternSynonyms #-}
module Migration.Divulgence (test) where

import Control.Monad
6 changes: 3 additions & 3 deletions compiler/daml-lf-ast/src/DA/Daml/LF/Ast/Optics.hs
Original file line number Diff line number Diff line change
@@ -76,9 +76,9 @@ templateExpr f (Template loc tpl param precond signatories observers agreement c
<*> (traverse . templateKeyExpr) f key

templateKeyExpr :: Traversal' TemplateKey Expr
templateKeyExpr f (TemplateKey typ body maintainers) = TemplateKey
<$> pure typ
<*> f body
templateKeyExpr f (TemplateKey typ body maintainers) =
TemplateKey typ
<$> f body
<*> f maintainers

moduleExpr :: Traversal' Module Expr
1 change: 0 additions & 1 deletion compiler/daml-lf-ast/src/DA/Daml/LF/Ast/Pretty.hs
Original file line number Diff line number Diff line change
@@ -3,7 +3,6 @@

{-# OPTIONS_GHC -Wno-orphans #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE PatternSynonyms #-}
module DA.Daml.LF.Ast.Pretty(
(<:>)
) where
1 change: 0 additions & 1 deletion compiler/daml-lf-ast/src/DA/Daml/LF/Ast/TypeLevelNat.hs
Original file line number Diff line number Diff line change
@@ -1,7 +1,6 @@
-- Copyright (c) 2020 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved.
-- SPDX-License-Identifier: Apache-2.0

{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE PatternSynonyms #-}

1 change: 0 additions & 1 deletion compiler/daml-lf-ast/src/DA/Daml/LF/Ast/Util.hs
Original file line number Diff line number Diff line change
@@ -1,7 +1,6 @@
-- Copyright (c) 2020 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved.
-- SPDX-License-Identifier: Apache-2.0

{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE PatternSynonyms #-}
module DA.Daml.LF.Ast.Util(module DA.Daml.LF.Ast.Util) where

8 changes: 4 additions & 4 deletions compiler/daml-lf-proto/src/DA/Daml/LF/Proto3/EncodeV1.hs
Original file line number Diff line number Diff line change
@@ -142,8 +142,8 @@ encodeNames = encodeInternableStrings . fmap mangleName
encodeDottedName :: Util.EitherLike P.DottedName Int32 e
=> (a -> [T.Text]) -> a -> Encode (Just e)
encodeDottedName unwrapDottedName (unwrapDottedName -> unmangled) =
Just <$>
Util.fromEither @P.DottedName @Int32 <$>
Just .
Util.fromEither @P.DottedName @Int32 .
Bf.first P.DottedName <$>
encodeDottedName' unmangled

@@ -193,7 +193,7 @@ encodeList encodeElem = fmap V.fromList . mapM encodeElem
encodeNameMap :: NM.Named a => (a -> Encode b) -> NM.NameMap a -> Encode (V.Vector b)
encodeNameMap encodeElem = fmap V.fromList . mapM encodeElem . NM.toList

encodeQualTypeSynName' :: Qualified TypeSynName -> Encode (P.TypeSynName)
encodeQualTypeSynName' :: Qualified TypeSynName -> Encode P.TypeSynName
encodeQualTypeSynName' (Qualified pref mname syn) = do
typeSynNameModule <- encodeModuleRef pref mname
typeSynNameName <- encodeDottedName unTypeSynName syn
@@ -202,7 +202,7 @@ encodeQualTypeSynName' (Qualified pref mname syn) = do
encodeQualTypeSynName :: Qualified TypeSynName -> Encode (Just P.TypeSynName)
encodeQualTypeSynName tysyn = Just <$> encodeQualTypeSynName' tysyn

encodeQualTypeConName' :: Qualified TypeConName -> Encode (P.TypeConName)
encodeQualTypeConName' :: Qualified TypeConName -> Encode P.TypeConName
encodeQualTypeConName' (Qualified pref mname con) = do
typeConNameModule <- encodeModuleRef pref mname
typeConNameName <- encodeDottedName unTypeConName con
3 changes: 1 addition & 2 deletions compiler/damlc/daml-doc/src/DA/Daml/Doc/Driver.hs
Original file line number Diff line number Diff line change
@@ -112,8 +112,7 @@ loadExternalAnchors path = do
tryLoadAnchors = \case
Just path -> runExceptT $ do
bytes <- ExceptT $ first readErr <$> try @IOError (LBS.fromStrict <$> BS.readFile path)
anchors <- ExceptT $ pure (first decodeErr (AE.eitherDecode @AnchorMap bytes))
pure $ anchors
ExceptT $ pure (first decodeErr (AE.eitherDecode @AnchorMap bytes))
where
readErr = const $ "Failed to read anchor table '" ++ path ++ "'"
decodeErr err = unlines ["Failed to decode anchor table '" ++ path ++ "':", err]
Original file line number Diff line number Diff line change
@@ -467,7 +467,7 @@ matchGoToDefinitionPattern :: GoToDefinitionPattern -> Maybe D.Location -> Bool
matchGoToDefinitionPattern = \case
Missing -> isNothing
At c -> maybe False ((c ==) . locationStartCursor)
In m -> \l -> fromMaybe False $ do
In m -> \l -> (Just True ==) $ do
l' <- l
let uri = D._uri l'
fp <- D.uriToFilePath' uri
53 changes: 25 additions & 28 deletions compiler/damlc/daml-lf-conversion/src/DA/Daml/LFConversion.hs
Original file line number Diff line number Diff line change
@@ -2,7 +2,6 @@
-- SPDX-License-Identifier: Apache-2.0

{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE PatternSynonyms #-}
{-# OPTIONS_GHC -Wno-unused-matches #-}
{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
{-# OPTIONS_GHC -Wno-overlapping-patterns #-} -- Because the pattern match checker is garbage
@@ -265,18 +264,17 @@ convertRationalDecimal env num denom
-- num % denom * 10^10 needs to fit within a 128bit signed number.
-- note that we can also get negative rationals here, hence we ask for upperBound128Bit - 1 as
-- upper limit.
if | 10 ^ maxPrecision `mod` denom == 0 &&
abs (r * 10 ^ maxPrecision) <= upperBound128Bit - 1 ->
pure $ EBuiltin $
if envLfVersion env `supports` featureNumeric
then BENumeric $ numericFromDecimal $ fromRational r
else BEDecimal $ fromRational r
| otherwise ->
unsupported
("Rational is out of bounds: " ++
show ((fromInteger num / fromInteger denom) :: Double) ++
". Maximal supported precision is e^-10, maximal range after multiplying with 10^10 is [10^38 -1, -10^38 + 1]")
(num, denom)
if 10 ^ maxPrecision `mod` denom == 0 && abs (r * 10 ^ maxPrecision) <= upperBound128Bit - 1 then
pure $ EBuiltin $
if envLfVersion env `supports` featureNumeric
then BENumeric $ numericFromDecimal $ fromRational r
else BEDecimal $ fromRational r
else
unsupported
("Rational is out of bounds: " ++
show ((fromInteger num / fromInteger denom) :: Double) ++
". Maximal supported precision is e^-10, maximal range after multiplying with 10^10 is [10^38 -1, -10^38 + 1]")
(num, denom)
where
r = num % denom
upperBound128Bit = 10 ^ (38 :: Integer)
@@ -613,7 +611,7 @@ convertChoice env tbinds (ChoiceData ty expr)
let choiceName = ChoiceName (T.intercalate "." $ unTypeConName $ qualObject choiceTyCon)
ERecCon _ [(_, controllers), (_, action), _] <- convertExpr env expr
consuming <- case consumingTy of
TConApp (Qualified { qualObject = TypeConName con }) _
TConApp Qualified { qualObject = TypeConName con } _
| con == ["NonConsuming"] -> pure NonConsuming
| con == ["PreConsuming"] -> pure PreConsuming
| con == ["Consuming"] -> pure Consuming
@@ -626,8 +624,7 @@ convertChoice env tbinds (ChoiceData ty expr)
Consuming -> update
NonConsuming -> update
PreConsuming ->
EUpdate $ UBind (Binding (mkVar "_", TUnit) archiveSelf) $
update
EUpdate $ UBind (Binding (mkVar "_", TUnit) archiveSelf) update
PostConsuming ->
EUpdate $ UBind (Binding (res, choiceRetTy) update) $
EUpdate $ UBind (Binding (mkVar "_", TUnit) archiveSelf) $
@@ -636,7 +633,7 @@ convertChoice env tbinds (ChoiceData ty expr)
{ chcLocation = Nothing
, chcName = choiceName
, chcConsuming = consuming == Consuming
, chcControllers = controllers `ETmApp` EVar this `ETmApp` EVar (arg)
, chcControllers = controllers `ETmApp` EVar this `ETmApp` EVar arg
, chcSelfBinder = self
, chcArgBinder = (arg, choiceTy)
, chcReturnType = choiceRetTy
@@ -795,9 +792,9 @@ convertExpr env0 e = do
go env (VarIn GHC_CString "fromString") (LExpr x : args)
= fmap (, args) $ convertExpr env x
go env (VarIn GHC_CString "unpackCString#") (LExpr (Lit (LitString x)) : args)
= fmap (, args) $ pure $ EBuiltin $ BEText $ unpackCString x
= pure $ (, args) $ EBuiltin $ BEText $ unpackCString x
go env (VarIn GHC_CString "unpackCStringUtf8#") (LExpr (Lit (LitString x)) : args)
= fmap (, args) $ pure $ EBuiltin $ BEText $ unpackCStringUtf8 x
= pure $ (, args) $ EBuiltin $ BEText $ unpackCStringUtf8 x
go env x@(VarIn Control_Exception_Base _) (LType t1 : LType t2 : LExpr (untick -> Lit (LitString s)) : args)
= fmap (, args) $ do
x' <- convertExpr env x
@@ -928,7 +925,7 @@ convertExpr env0 e = do
pure $ mkEApps bind' [TyArg monad', TmArg dict', TyArg t1', TyArg t2', TmArg x', TmArg (ETmLam (mkVar "_", t1') y')]

go env (VarIn GHC_Types "[]") (LType (TypeCon (Is "Char") []) : args)
= fmap (, args) $ pure $ EBuiltin (BEText T.empty)
= pure $ (, args) $ EBuiltin (BEText T.empty)
go env (VarIn GHC_Types "[]") args
= withTyArg env varT1 args $ \t args -> pure (ENil t, args)
go env (VarIn GHC_Types ":") args =
@@ -943,10 +940,10 @@ convertExpr env0 e = do
withTmArg env (varV1, t) args $ \x args ->
pure (ESome t x, args)

go env (VarIn GHC_Tuple "()") args = fmap (, args) $ pure EUnit
go env (VarIn GHC_Types "True") args = fmap (, args) $ pure $ mkBool True
go env (VarIn GHC_Types "False") args = fmap (, args) $ pure $ mkBool False
go env (VarIn GHC_Types "I#") args = fmap (, args) $ pure $ mkIdentity TInt64
go env (VarIn GHC_Tuple "()") args = pure (EUnit, args)
go env (VarIn GHC_Types "True") args = pure (mkBool True, args)
go env (VarIn GHC_Types "False") args = pure (mkBool False, args)
go env (VarIn GHC_Types "I#") args = pure (mkIdentity TInt64, args)
-- we pretend Int and Int# are the same thing

go env (Var x) args
@@ -966,8 +963,8 @@ convertExpr env0 e = do
pkgRef <- nameToPkgRef env $ varName x
pure $ EVal $ Qualified pkgRef (envLFModuleName env) $ convVal x
-- some things are global, but not with a module name, so give them the current one
| Just y <- envLookupAlias x env = fmap (, args) $ pure y
| otherwise = fmap (, args) $ pure $ EVar $ convVar x
| Just y <- envLookupAlias x env = pure (y, args)
| otherwise = pure $ (, args) $ EVar $ convVar x

go env (Lam name x) args
| isTyVar name = fmap (, args) $ do
@@ -1052,7 +1049,7 @@ convertExpr env0 e = do

-- | Is this a constraint tuple?
isConstraintTupleTyCon :: TyCon -> Bool
isConstraintTupleTyCon = maybe False (== ConstraintTuple) . tyConTuple_maybe
isConstraintTupleTyCon = (Just ConstraintTuple ==) . tyConTuple_maybe

-- | Is this an enum type?
isEnumTyCon :: TyCon -> Bool
@@ -1723,7 +1720,7 @@ bindTypeVars :: Env -> [Var] -> ConvertM (Env, [(TypeVarName, LF.Kind)])
bindTypeVars env vs = do
let (ns, env') = envBindTypeVars vs env
ks <- mapM (convertKind . tyVarKind) vs
pure (env', (zipExact ns ks))
pure (env', zipExact ns ks)

convTypeVar :: Env -> Var -> ConvertM (TypeVarName, LF.Kind)
convTypeVar env v = do
Original file line number Diff line number Diff line change
@@ -1,7 +1,6 @@
-- Copyright (c) 2020 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved.
-- SPDX-License-Identifier: Apache-2.0

{-# LANGUAGE PatternSynonyms #-}
{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
{-# OPTIONS_GHC -Wno-overlapping-patterns #-} -- Because the pattern match checker is garbage

1 change: 0 additions & 1 deletion compiler/damlc/daml-opts/daml-opts/DA/Daml/Options.hs
Original file line number Diff line number Diff line change
@@ -2,7 +2,6 @@
-- SPDX-License-Identifier: Apache-2.0

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE PatternSynonyms #-}
{-# OPTIONS_GHC -Wno-missing-fields #-} -- to enable prettyPrint
{-# OPTIONS_GHC -Wno-orphans #-}

2 changes: 0 additions & 2 deletions compiler/damlc/tests/src/DA/Test/DamlcIntegration.hs
Original file line number Diff line number Diff line change
@@ -1,8 +1,6 @@
-- Copyright (c) 2020 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved.
-- SPDX-License-Identifier: Apache-2.0

{-# LANGUAGE MultiWayIf #-}

-- | Test driver for DAML-GHC CompilerService.
-- For each file, compile it with GHC, convert it,
-- typecheck with LF, test it. Test annotations are documented as 'Ann'.
1 change: 0 additions & 1 deletion compiler/repl-service/client/src/DA/Daml/LF/ReplClient.hs
Original file line number Diff line number Diff line change
@@ -3,7 +3,6 @@
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiWayIf #-}
module DA.Daml.LF.ReplClient
( Options(..)
, MaxInboundMessageSize(..)
Original file line number Diff line number Diff line change
@@ -3,7 +3,6 @@

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiWayIf #-}
module DA.Daml.LF.ScenarioServiceClient.LowLevel
( Options(..)
, TimeoutSeconds
1 change: 0 additions & 1 deletion daml-assistant/daml-helper/src/DA/Daml/Helper/Start.hs
Original file line number Diff line number Diff line change
@@ -1,6 +1,5 @@
-- Copyright (c) 2020 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved.
-- SPDX-License-Identifier: Apache-2.0
{-# LANGUAGE MultiWayIf #-}
module DA.Daml.Helper.Start
( runStart
, runPlatformJar
2 changes: 1 addition & 1 deletion daml-assistant/src/DA/Daml/Assistant/Util.hs
Original file line number Diff line number Diff line change
@@ -25,7 +25,7 @@ throwErr msg = throwIO (assistantError msg)
wrapErr :: Text -> IO a -> IO a
wrapErr ctx m = m `catches`
[ Handler $ throwIO @IO @ExitCode
, Handler $ \(ExitCodeException{eceExitCode}) -> exitWith eceExitCode
, Handler $ \ExitCodeException{eceExitCode} -> exitWith eceExitCode
, Handler $ throwIO . addErrorContext
, Handler $ throwIO . wrapException
]
5 changes: 2 additions & 3 deletions libs-haskell/da-hs-base/src/DA/Service/Logger/Impl/GCP.hs
Original file line number Diff line number Diff line change
@@ -2,7 +2,6 @@
-- SPDX-License-Identifier: Apache-2.0

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE GADTs #-}
{-|
@@ -317,7 +316,7 @@ sendLogs gcp (unzip -> (entries, finalizers)) = unless (null entries) $ do
Nothing -> Lgr.logJson (gcpFallbackLogger gcp) Lgr.Info ("Timeout while sending log request" :: T.Text)
Just (HttpError e) -> logException gcp e
Just ReachedDataLimit -> pure ()
Just SendSuccess -> sequence_ (map (void . tryAny) finalizers)
Just SendSuccess -> mapM_ tryAny finalizers

logsHost :: BS.ByteString
logsHost = "logs.daml.com"
@@ -456,6 +455,6 @@ sendData gcp sendRequest payload = withSentDataFile gcp $ \sentDataFile -> do
test :: IO ()
test = withGcpLogger (GCPConfig "test" Nothing) (Lgr.Error ==) Lgr.Pure.makeNopHandle $ \_gcp hnd -> do
let lg = Lgr.logError hnd
let (ls :: [T.Text]) = replicate 13 $ "I like short songs!"
let (ls :: [T.Text]) = replicate 13 "I like short songs!"
mapM_ lg ls
putStrLn "Done!"

0 comments on commit 1e72a5c

Please sign in to comment.