Skip to content

Commit

Permalink
Clean up a bunch of hlint suggestions
Browse files Browse the repository at this point in the history
  • Loading branch information
snoyberg committed Feb 16, 2017
1 parent 2ef8709 commit b5c5184
Show file tree
Hide file tree
Showing 14 changed files with 37 additions and 55 deletions.
2 changes: 1 addition & 1 deletion src/Stack/Build.hs
Original file line number Diff line number Diff line change
Expand Up @@ -178,7 +178,7 @@ checkCabalVersion = do
versionString cabalVer ++
" was found."

data CabalVersionException = CabalVersionException { unCabalVersionException :: String }
newtype CabalVersionException = CabalVersionException { unCabalVersionException :: String }
deriving (Typeable)

instance Show CabalVersionException where show = unCabalVersionException
Expand Down
2 changes: 1 addition & 1 deletion src/Stack/SDist.hs
Original file line number Diff line number Diff line change
Expand Up @@ -68,7 +68,7 @@ import qualified System.FilePath as FP
-- | Special exception to throw when you want to fail because of bad results
-- of package check.

data CheckException
newtype CheckException
= CheckException (NonEmpty Check.PackageCheck)
deriving (Typeable)

Expand Down
4 changes: 2 additions & 2 deletions src/Stack/Types/Build.hs
Original file line number Diff line number Diff line change
Expand Up @@ -367,8 +367,8 @@ newtype PkgDepsOracle =
deriving (Show,Typeable,Eq,Hashable,Store,NFData)

-- | Stored on disk to know whether the files have changed.
data BuildCache = BuildCache
{ buildCacheTimes :: !(Map FilePath FileCacheInfo)
newtype BuildCache = BuildCache
{ buildCacheTimes :: Map FilePath FileCacheInfo
-- ^ Modification times of files.
}
deriving (Generic, Eq, Show, Data, Typeable)
Expand Down
4 changes: 2 additions & 2 deletions src/Stack/Types/Config.hs
Original file line number Diff line number Diff line change
Expand Up @@ -1690,8 +1690,8 @@ explicitSetupDeps name = do
Nothing -> False -- default value

-- | Data passed into Docker container for the Docker entrypoint's use
data DockerEntrypoint = DockerEntrypoint
{ deUser :: !(Maybe DockerUser)
newtype DockerEntrypoint = DockerEntrypoint
{ deUser :: Maybe DockerUser
-- ^ UID/GID/etc of host user, if we wish to perform UID/GID switch in container
} deriving (Read,Show)

Expand Down
8 changes: 4 additions & 4 deletions src/Stack/Types/Config/Build.hs
Original file line number Diff line number Diff line change
Expand Up @@ -319,12 +319,12 @@ instance Monoid TestOptsMonoid where


-- | Haddock Options
data HaddockOpts =
HaddockOpts { hoAdditionalArgs :: ![String] -- ^ Arguments passed to haddock program
newtype HaddockOpts =
HaddockOpts { hoAdditionalArgs :: [String] -- ^ Arguments passed to haddock program
} deriving (Eq,Show)

data HaddockOptsMonoid =
HaddockOptsMonoid {hoMonoidAdditionalArgs :: ![String]
newtype HaddockOptsMonoid =
HaddockOptsMonoid {hoMonoidAdditionalArgs :: [String]
} deriving (Show, Generic)

defaultHaddockOpts :: HaddockOpts
Expand Down
2 changes: 1 addition & 1 deletion src/Stack/Types/FlagName.hs
Original file line number Diff line number Diff line change
Expand Up @@ -40,7 +40,7 @@ import Language.Haskell.TH
import Language.Haskell.TH.Syntax

-- | A parse fail.
data FlagNameParseFail
newtype FlagNameParseFail
= FlagNameParseFail Text
deriving (Typeable)
instance Exception FlagNameParseFail
Expand Down
2 changes: 1 addition & 1 deletion src/Stack/Types/GhcPkgId.hs
Original file line number Diff line number Diff line change
Expand Up @@ -26,7 +26,7 @@ import GHC.Generics
import Prelude -- Fix AMP warning

-- | A parse fail.
data GhcPkgIdParseFail
newtype GhcPkgIdParseFail
= GhcPkgIdParseFail Text
deriving Typeable
instance Show GhcPkgIdParseFail where
Expand Down
8 changes: 4 additions & 4 deletions src/Stack/Types/Image.hs
Original file line number Diff line number Diff line change
Expand Up @@ -18,8 +18,8 @@ import Path
import Prelude -- Fix redundant import warnings

-- | Image options. Currently only Docker image options.
data ImageOpts = ImageOpts
{ imgDockers :: ![ImageDockerOpts]
newtype ImageOpts = ImageOpts
{ imgDockers :: [ImageDockerOpts]
-- ^ One or more stanzas for docker image settings.
} deriving (Show)

Expand All @@ -39,8 +39,8 @@ data ImageDockerOpts = ImageDockerOpts
-- ^ Filenames of executables to add (if Nothing, add them all)
} deriving (Show)

data ImageOptsMonoid = ImageOptsMonoid
{ imgMonoidDockers :: ![ImageDockerOpts]
newtype ImageOptsMonoid = ImageOptsMonoid
{ imgMonoidDockers :: [ImageDockerOpts]
} deriving (Show, Generic)

instance FromJSON (WithJSONWarnings ImageOptsMonoid) where
Expand Down
2 changes: 1 addition & 1 deletion src/Stack/Types/PackageIdentifier.hs
Original file line number Diff line number Diff line change
Expand Up @@ -35,7 +35,7 @@ import Stack.Types.PackageName
import Stack.Types.Version

-- | A parse fail.
data PackageIdentifierParseFail
newtype PackageIdentifierParseFail
= PackageIdentifierParseFail Text
deriving (Typeable)
instance Show PackageIdentifierParseFail where
Expand Down
2 changes: 1 addition & 1 deletion src/Stack/Types/Version.hs
Original file line number Diff line number Diff line change
Expand Up @@ -57,7 +57,7 @@ import Prelude -- Fix warning: Word in Prelude from base-4.8.
import Text.PrettyPrint (render)

-- | A parse fail.
data VersionParseFail =
newtype VersionParseFail =
VersionParseFail Text
deriving (Typeable)
instance Exception VersionParseFail
Expand Down
4 changes: 2 additions & 2 deletions src/Stack/Upgrade.hs
Original file line number Diff line number Diff line change
Expand Up @@ -88,8 +88,8 @@ data BinaryOpts = BinaryOpts
, _boGithubRepo :: !(Maybe String)
}
deriving Show
data SourceOpts = SourceOpts
{ _soRepo :: !(Maybe String)
newtype SourceOpts = SourceOpts
{ _soRepo :: Maybe String
}
deriving Show

Expand Down
4 changes: 2 additions & 2 deletions src/Stack/Upload.hs
Original file line number Diff line number Diff line change
Expand Up @@ -248,8 +248,8 @@ printBody res = runConduit $ getResponseBody res .| CB.sinkHandle stdout
-- Typically, you want to use this with 'upload'.
--
-- Since 0.1.0.0
data Uploader = Uploader
{ upload_ :: !(String -> L.ByteString -> IO ())
newtype Uploader = Uploader
{ upload_ :: String -> L.ByteString -> IO ()
}

-- | Upload a single tarball with the given @Uploader@.
Expand Down
2 changes: 1 addition & 1 deletion src/System/Process/Read.hs
Original file line number Diff line number Diff line change
Expand Up @@ -423,7 +423,7 @@ getEnvOverride platform =
mkEnvOverride platform
. Map.fromList . map (T.pack *** T.pack)

data PathException = PathsInvalidInPath [FilePath]
newtype PathException = PathsInvalidInPath [FilePath]
deriving Typeable

instance Exception PathException
Expand Down
46 changes: 14 additions & 32 deletions src/test/Network/HTTP/Download/VerifiedSpec.hs
Original file line number Diff line number Diff line change
Expand Up @@ -2,14 +2,11 @@
module Network.HTTP.Download.VerifiedSpec where

import Control.Applicative
import Control.Monad.IO.Class (MonadIO)
import Control.Monad.Logger (LoggingT, runStdoutLoggingT)
import Control.Monad.Trans.Reader
import Control.Monad.Logger (runStdoutLoggingT)
import Control.Retry (limitRetries)
import Crypto.Hash
import Data.Maybe
import Network.HTTP.Client.Conduit
import Network.HTTP.Client.TLS (getGlobalManager)
import Network.HTTP.Download.Verified
import Path
import Path.IO
Expand Down Expand Up @@ -65,76 +62,61 @@ isWrongDigest :: VerifiedDownloadException -> Bool
isWrongDigest WrongDigest{} = True
isWrongDigest _ = False

data T = T
{ manager :: Manager
}

runWith :: MonadIO m => Manager -> ReaderT Manager (LoggingT m) r -> m r
runWith manager = runStdoutLoggingT . flip runReaderT manager

setup :: IO T
setup = do
manager <- getGlobalManager
return T{..}

teardown :: T -> IO ()
teardown _ = return ()

spec :: Spec
spec = beforeAll setup $ afterAll teardown $ do
spec = do
let exampleProgressHook _ = return ()

describe "verifiedDownload" $ do
-- Preconditions:
-- * the exampleReq server is running
-- * the test runner has working internet access to it
it "downloads the file correctly" $ \T{..} -> withTempDir' $ \dir -> do
it "downloads the file correctly" $ withTempDir' $ \dir -> do
examplePath <- getExamplePath dir
doesFileExist examplePath `shouldReturn` False
let go = runWith manager $ verifiedDownload exampleReq examplePath exampleProgressHook
let go = runStdoutLoggingT $ verifiedDownload exampleReq examplePath exampleProgressHook
go `shouldReturn` True
doesFileExist examplePath `shouldReturn` True

it "is idempotent, and doesn't redownload unnecessarily" $ \T{..} -> withTempDir' $ \dir -> do
it "is idempotent, and doesn't redownload unnecessarily" $ withTempDir' $ \dir -> do
examplePath <- getExamplePath dir
doesFileExist examplePath `shouldReturn` False
let go = runWith manager $ verifiedDownload exampleReq examplePath exampleProgressHook
let go = runStdoutLoggingT $ verifiedDownload exampleReq examplePath exampleProgressHook
go `shouldReturn` True
doesFileExist examplePath `shouldReturn` True
go `shouldReturn` False
doesFileExist examplePath `shouldReturn` True

-- https://github.com/commercialhaskell/stack/issues/372
it "does redownload when the destination file is wrong" $ \T{..} -> withTempDir' $ \dir -> do
it "does redownload when the destination file is wrong" $ withTempDir' $ \dir -> do
examplePath <- getExamplePath dir
let exampleFilePath = toFilePath examplePath
writeFile exampleFilePath exampleWrongContent
doesFileExist examplePath `shouldReturn` True
readFile exampleFilePath `shouldReturn` exampleWrongContent
let go = runWith manager $ verifiedDownload exampleReq examplePath exampleProgressHook
let go = runStdoutLoggingT $ verifiedDownload exampleReq examplePath exampleProgressHook
go `shouldReturn` True
doesFileExist examplePath `shouldReturn` True
readFile exampleFilePath `shouldNotReturn` exampleWrongContent

it "rejects incorrect content length" $ \T{..} -> withTempDir' $ \dir -> do
it "rejects incorrect content length" $ withTempDir' $ \dir -> do
examplePath <- getExamplePath dir
let wrongContentLengthReq = exampleReq
{ drLengthCheck = Just exampleWrongContentLength
}
let go = runWith manager $ verifiedDownload wrongContentLengthReq examplePath exampleProgressHook
let go = runStdoutLoggingT $ verifiedDownload wrongContentLengthReq examplePath exampleProgressHook
go `shouldThrow` isWrongContentLength
doesFileExist examplePath `shouldReturn` False

it "rejects incorrect digest" $ \T{..} -> withTempDir' $ \dir -> do
it "rejects incorrect digest" $ withTempDir' $ \dir -> do
examplePath <- getExamplePath dir
let wrongHashCheck = exampleHashCheck { hashCheckHexDigest = exampleWrongDigest }
let wrongDigestReq = exampleReq { drHashChecks = [wrongHashCheck] }
let go = runWith manager $ verifiedDownload wrongDigestReq examplePath exampleProgressHook
let go = runStdoutLoggingT $ verifiedDownload wrongDigestReq examplePath exampleProgressHook
go `shouldThrow` isWrongDigest
doesFileExist examplePath `shouldReturn` False

-- https://github.com/commercialhaskell/stack/issues/240
it "can download hackage tarballs" $ \T{..} -> withTempDir' $ \dir -> do
it "can download hackage tarballs" $ withTempDir' $ \dir -> do
dest <- (dir </>) <$> parseRelFile "acme-missiles-0.3.tar.gz"
let req = parseRequest_ "http://hackage.haskell.org/package/acme-missiles-0.3/acme-missiles-0.3.tar.gz"
let dReq = DownloadRequest
Expand All @@ -143,7 +125,7 @@ spec = beforeAll setup $ afterAll teardown $ do
, drLengthCheck = Nothing
, drRetryPolicy = limitRetries 1
}
let go = runWith manager $ verifiedDownload dReq dest exampleProgressHook
let go = runStdoutLoggingT $ verifiedDownload dReq dest exampleProgressHook
doesFileExist dest `shouldReturn` False
go `shouldReturn` True
doesFileExist dest `shouldReturn` True

0 comments on commit b5c5184

Please sign in to comment.