From 0f74359d79f7138e045bafc34bcf6e2a571f4397 Mon Sep 17 00:00:00 2001 From: Konstantin Zudov Date: Tue, 6 Oct 2015 04:40:37 +0300 Subject: [PATCH] Do not use deprecated FilePath related functions --- Data/GhcLinks.hs | 6 +++--- Handler/BuildVersion.hs | 6 +++--- Handler/Hoogle.hs | 4 ++-- Stackage/Database/Cron.hs | 18 +++++++++--------- 4 files changed, 17 insertions(+), 17 deletions(-) diff --git a/Data/GhcLinks.hs b/Data/GhcLinks.hs index 9a8fb49..84d9a45 100644 --- a/Data/GhcLinks.hs +++ b/Data/GhcLinks.hs @@ -22,7 +22,7 @@ supportedArches = [minBound .. maxBound] readGhcLinks :: FilePath -> IO GhcLinks readGhcLinks dir = do let ghcMajorVersionsPath = dir "supported-ghc-major-versions.yaml" - Yaml.decodeFile (fpToString ghcMajorVersionsPath) >>= \case + Yaml.decodeFile ghcMajorVersionsPath >>= \case Nothing -> return $ GhcLinks HashMap.empty Just (ghcMajorVersions :: [GhcMajorVersion]) -> do let opts = @@ -35,8 +35,8 @@ readGhcLinks dir = do let verText = ghcMajorVersionToText ver fileName = "ghc-" <> verText <> "-links.yaml" path = dir - fpFromText (toPathPiece arch) - fpFromText fileName + unpack (toPathPiece arch) + unpack fileName whenM (liftIO $ isFile (fromString path)) $ do text <- liftIO $ readTextFile (fromString path) modify (HashMap.insert (arch, ver) text) diff --git a/Handler/BuildVersion.hs b/Handler/BuildVersion.hs index 9e302a8..438ca10 100644 --- a/Handler/BuildVersion.hs +++ b/Handler/BuildVersion.hs @@ -9,15 +9,15 @@ getBuildVersionR :: Handler Text getBuildVersionR = return $ pack $(do let headFile = ".git/HEAD" qAddDependentFile headFile - ehead <- qRunIO $ tryIO $ readFile $ fpFromString headFile + ehead <- qRunIO $ tryIO $ readFile $ headFile case decodeUtf8 <$> ehead of Left e -> lift $ ".git/HEAD not read: " ++ show e Right raw -> case takeWhile (/= '\n') <$> stripPrefix "ref: " raw of Nothing -> lift $ ".git/HEAD not in expected format: " ++ show raw Just fp' -> do - let fp = ".git" fpFromText fp' - qAddDependentFile $ fpToString fp + let fp = ".git" unpack (fp' :: Text) + qAddDependentFile fp bs <- qRunIO $ readFile fp isDirty <- qRunIO $ (/= ExitSuccess) diff --git a/Handler/Hoogle.hs b/Handler/Hoogle.hs index 894debd..4f23636 100644 --- a/Handler/Hoogle.hs +++ b/Handler/Hoogle.hs @@ -34,7 +34,7 @@ getHoogleR name = do offset = (page - 1) * perPage mdatabasePath <- getHoogleDB name heDatabase <- case mdatabasePath of - Just x -> return $ liftIO $ Hoogle.loadDatabase $ fpToString x + Just x -> return $ liftIO $ Hoogle.loadDatabase x Nothing -> hoogleDatabaseNotAvailableFor name mresults <- case mquery of @@ -61,7 +61,7 @@ getHoogleDatabaseR name = do mdatabasePath <- getHoogleDB name case mdatabasePath of Nothing -> hoogleDatabaseNotAvailableFor name - Just path -> sendFile "application/octet-stream" $ fpToString path + Just path -> sendFile "application/octet-stream" path hoogleDatabaseNotAvailableFor :: SnapName -> Handler a hoogleDatabaseNotAvailableFor name = (>>= sendResponse) $ defaultLayout $ do diff --git a/Stackage/Database/Cron.hs b/Stackage/Database/Cron.hs index cef7c40..1845bf0 100644 --- a/Stackage/Database/Cron.hs +++ b/Stackage/Database/Cron.hs @@ -66,8 +66,8 @@ loadFromS3 man = do writeTVar currSuffixVar $! x + 1 return x - let fp = root fpFromText ("database-download-" ++ tshow suffix) - putStrLn $ "Downloading database to " ++ fpToText fp + let fp = root unpack ("database-download-" ++ tshow suffix) + putStrLn $ "Downloading database to " ++ pack fp withResponse req man $ \res -> runResourceT $ bodyReaderSource (responseBody res) @@ -145,7 +145,7 @@ stackageServerCron = do env <- getEnv NorthVirginia Discover let upload :: FilePath -> Text -> IO () upload fp key = do - let fpgz = fpToString $ fp <.> "gz" + let fpgz = fp <.> "gz" runResourceT $ sourceFile fp $$ compress 9 (WindowBits 31) =$ CB.sinkFile fpgz @@ -188,7 +188,7 @@ stackageServerCron = do forM_ mfp' $ \fp -> do let key = hoogleKey name upload fp key - let dest = fpFromText key + let dest = unpack key createTree $ parent (fromString dest) rename (fromString fp) (fromString dest) @@ -209,12 +209,12 @@ createHoogleDB db man name = handleAny (\e -> print e $> Nothing) $ do createTree (fromString bindir) dbs <- runResourceT - $ sourceTarFile False (fpToString tarFP) + $ sourceTarFile False tarFP $$ evalStateC 1 (mapMC (singleDB db name bindir)) =$ sinkList putStrLn "Merging databases..." - Hoogle.mergeDatabase (map fpToString $ catMaybes dbs) (fpToString outname) + Hoogle.mergeDatabase (catMaybes dbs) outname putStrLn "Merge done" return $ Just outname @@ -225,7 +225,7 @@ createHoogleDB db man name = handleAny (\e -> print e $> Nothing) $ do tarKey = toPathPiece name ++ "/hoogle/orig.tar" tarUrl = "https://s3.amazonaws.com/haddock.stackage.org/" ++ tarKey - tarFP = root fpFromText tarKey + tarFP = root unpack tarKey singleDB :: StackageDatabase -> SnapName @@ -248,7 +248,7 @@ singleDB db sname bindir e@(Tar.entryContent -> Tar.NormalFile lbs _) = do Just (Entity _ sp) -> do let ver = snapshotPackageVersion sp pkgver = concat [pkg, "-", ver] - out = bindir fpFromString (show idx) <.> "hoo" + out = bindir show idx <.> "hoo" src' = unlines $ haddockHacks (Just $ unpack docsUrl) $ lines @@ -262,7 +262,7 @@ singleDB db sname bindir e@(Tar.entryContent -> Tar.NormalFile lbs _) = do , "/index.html" ] - _errs <- liftIO $ Hoogle.createDatabase "" Hoogle.Haskell [] src' $ fpToString out + _errs <- liftIO $ Hoogle.createDatabase "" Hoogle.Haskell [] src' out return $ Just out singleDB _ _ _ _ = return Nothing