Merge pull request #395 from Profpatsch/refactor-download-code

Refactor Input/Download

src/Action/Generate.hs

@@ -201,14 +201,19 @@ actionGenerate g@Generate{..} = withTiming (if debug then Just $ replaceExtensio
     createDirectoryIfMissing True $ takeDirectory database
     whenLoud $ putStrLn $ "Generating files to " ++ takeDirectory database
 
-    download <- pure $ downloadInput timing insecure download (takeDirectory database)
+    let doDownload name url = do
+          let download' = case download of
+                Just True -> AlwaysDownloadInput
+                Just False -> NeverDownloadInput
+                Nothing -> DownloadInputIfNotThere
+          downloadInput timing insecure download' (takeDirectory database) name url
     settings <- loadSettings
     (cbl, want, source) <- case language of
         Haskell | Just dir <- haddock -> readHaskellHaddock timing settings dir
                 | [""] <- local_ -> readHaskellGhcpkg timing settings
-                | [] <- local_ -> readHaskellOnline timing settings download
+                | [] <- local_ -> readHaskellOnline timing settings doDownload
                 | otherwise -> readHaskellDirs timing settings local_
-        Frege | [] <- local_ -> readFregeOnline timing download
+        Frege | [] <- local_ -> readFregeOnline timing doDownload
               | otherwise -> errorIO "No support for local Frege databases"
     (cblErrs, popularity) <- evaluate $ packagePopularity cbl
     cbl <- evaluate $ Map.map (\p -> p{packageDepends=[]}) cbl -- clear the memory, since the information is no longer used

src/Input/Download.hs

 {-# LANGUAGE TupleSections #-}
 
-module Input.Download(downloadInput) where
+module Input.Download(downloadInput, DownloadInput(..)) where
 
 import System.FilePath
 import Control.Monad.Extra
@@ -14,24 +14,39 @@ import General.Timing
 import Control.Monad.Trans.Resource
 import Control.Exception.Extra
 
+data DownloadInput =
+    AlwaysDownloadInput
+    | NeverDownloadInput
+    | DownloadInputIfNotThere
+
 
 -- | Download all the input files to input/
-downloadInput :: Timing -> Bool -> Maybe Bool -> FilePath -> String -> URL -> IO FilePath
+downloadInput :: Timing -> Bool -> DownloadInput -> FilePath -> String -> URL -> IO FilePath
 downloadInput timing insecure download dir name url = do
     let file = dir </> "input-" ++ name
     exists <- doesFileExist file
-    when (not exists && download == Just False) $
-        errorIO $ "File is not already downloaded and --download=no given, downloading " ++ url ++ " to " ++ file
-    when (not exists || download == Just True) $
-        timed timing ("Downloading " ++ url) $ do
-            downloadFile insecure (file <.> "part") url
-            renameFile (file <.> "part") file
+    let act =
+            timed timing ("Downloading " ++ url) $ do
+                downloadFile insecure (file <.> "part") url
+                renameFile (file <.> "part") file
+    case download of
+        NeverDownloadInput ->
+            unless exists $
+              errorIO $ "File is not already downloaded and --download=no given, downloading " ++ url ++ " to " ++ file
+        AlwaysDownloadInput -> act
+        DownloadInputIfNotThere ->
+            unless exists act
     pure file
 
 downloadFile :: Bool -> FilePath -> String -> IO ()
 downloadFile insecure file url = do
     let request = C.parseRequest_ url
-    manager <- C.newManager $ C.mkManagerSettings (TLSSettingsSimple insecure False False) Nothing
+    manager <- C.newManager $ C.mkManagerSettings
+      (TLSSettingsSimple {
+        settingDisableCertificateValidation = insecure,
+        settingDisableSession = False,
+        settingUseServerName = False
+      }) Nothing
     runResourceT $ do
         response <- C.http request manager
         C.runConduit $ C.responseBody response C..| sinkFile file