From 96e9a53a174c5fabd7a0457fe652b4f6daf54bd4 Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Thu, 21 Jun 2018 19:30:48 +0300 Subject: [PATCH] Remove system-file(path/io) --- package.yaml | 2 -- src/Data/GhcLinks.hs | 6 +++--- src/Stackage/Database.hs | 29 ++++++++++++++-------------- src/Stackage/Database/Cron.hs | 36 +++++++++++++++++------------------ 4 files changed, 34 insertions(+), 39 deletions(-) diff --git a/package.yaml b/package.yaml index 8e21c97..799892e 100644 --- a/package.yaml +++ b/package.yaml @@ -39,8 +39,6 @@ dependencies: - persistent-template - resourcet - shakespeare -- system-fileio -- system-filepath - tar - template-haskell - temporary diff --git a/src/Data/GhcLinks.hs b/src/Data/GhcLinks.hs index 0b787a8..f3f7b3d 100644 --- a/src/Data/GhcLinks.hs +++ b/src/Data/GhcLinks.hs @@ -7,7 +7,7 @@ import ClassyPrelude.Yesod import Control.Monad.State.Strict (modify, execStateT) import qualified Data.HashMap.Strict as HashMap import qualified Data.Yaml as Yaml -import Filesystem (readTextFile, isFile) +import System.Directory import Types @@ -37,7 +37,7 @@ readGhcLinks dir = do path = dir unpack (toPathPiece arch) unpack fileName - whenM (liftIO $ isFile (fromString path)) $ do - text <- liftIO $ readTextFile (fromString path) + whenM (liftIO $ doesFileExist path) $ do + text <- liftIO $ readFileUtf8 path modify (HashMap.insert (arch, ver) text) return $ GhcLinks hashMap diff --git a/src/Stackage/Database.hs b/src/Stackage/Database.hs index a92b194..489f271 100644 --- a/src/Stackage/Database.hs +++ b/src/Stackage/Database.hs @@ -53,13 +53,12 @@ import CMarkGFM import System.Directory (removeFile) import Stackage.Database.Haddock import System.FilePath (takeBaseName, takeExtension) -import ClassyPrelude.Conduit hiding (pi, FilePath, ()) +import ClassyPrelude.Conduit hiding (pi) import Text.Blaze.Html (Html, toHtml, preEscapedToHtml) import Yesod.Form.Fields (Textarea (..)) import Stackage.Database.Types -import System.Directory (getAppUserDataDirectory) -import qualified Filesystem as F -import Filesystem.Path.CurrentOS (filename, directory, FilePath, encodeString, ()) +import System.Directory (getAppUserDataDirectory, doesDirectoryExist, createDirectoryIfMissing) +import System.FilePath (takeFileName, takeDirectory) import Data.Conduit.Process import Stackage.Types import Stackage.Metadata @@ -182,23 +181,23 @@ sourceBuildPlans :: MonadResource m => FilePath -> ConduitT i (SnapName, FilePat sourceBuildPlans root = do forM_ ["lts-haskell", "stackage-nightly"] $ \repoName -> do dir <- liftIO $ cloneOrUpdate root "fpco" repoName - sourceDirectory (encodeString dir) .| concatMapMC (go Left . fromString) + sourceDirectory dir .| concatMapMC (go Left . fromString) let docdir = dir "docs" - whenM (liftIO $ F.isDirectory docdir) $ - sourceDirectory (encodeString docdir) .| concatMapMC (go Right . fromString) + whenM (liftIO $ doesDirectoryExist docdir) $ + sourceDirectory docdir .| concatMapMC (go Right . fromString) where go wrapper fp | Just name <- nameFromFP fp = liftIO $ do - let bp = decodeFileEither (encodeString fp) >>= either throwIO return + let bp = decodeFileEither fp >>= either throwIO return return $ Just (name, fp, wrapper bp) go _ _ = return Nothing nameFromFP fp = do - base <- stripSuffix ".yaml" $ pack $ encodeString $ filename fp + base <- stripSuffix ".yaml" $ pack $ takeFileName fp fromPathPiece base cloneOrUpdate :: FilePath -> String -> String -> IO FilePath cloneOrUpdate root org name = do - exists <- F.isDirectory dest + exists <- doesDirectoryExist dest if exists then do let git = runIn dest "git" @@ -214,7 +213,7 @@ runIn :: FilePath -> String -> [String] -> IO () runIn dir cmd args = withCheckedProcess cp $ \ClosedStream Inherited Inherited -> return () where - cp = (proc cmd args) { cwd = Just $ encodeString dir } + cp = (proc cmd args) { cwd = Just dir } openStackageDatabase :: MonadIO m => PostgresConf -> m StackageDatabase openStackageDatabase pg = liftIO $ do @@ -244,8 +243,8 @@ createStackageDatabase fp = liftIO $ do runMigration migrateAll unless schemaMatch $ insert_ $ Schema currentSchema - root <- liftIO $ fmap ( fromString "database") $ fmap fromString $ getAppUserDataDirectory "stackage" - F.createTree root + root <- liftIO $ ( "database") <$> getAppUserDataDirectory "stackage" + createDirectoryIfMissing True root runResourceT $ do putStrLn "Updating all-cabal-metadata repo" flip runSqlPool pool $ runConduit $ sourcePackages root .| getZipSink @@ -369,9 +368,9 @@ addPlan name fp bp = do [ "log" , "--format=%ad" , "--date=short" - , encodeString $ filename fp + , takeFileName fp ] - cp = cp' { cwd = Just $ encodeString $ directory fp } + cp = cp' { cwd = Just $ takeDirectory fp } t <- withCheckedProcess cp $ \ClosedStream out ClosedStream -> runConduit $ out .| decodeUtf8C .| foldC case readMay $ concat $ take 1 $ words t of diff --git a/src/Stackage/Database/Cron.hs b/src/Stackage/Database/Cron.hs index 1328d1f..adafc4c 100644 --- a/src/Stackage/Database/Cron.hs +++ b/src/Stackage/Database/Cron.hs @@ -11,9 +11,8 @@ import qualified Codec.Archive.Tar as Tar import Stackage.Database import Network.HTTP.Client import Network.HTTP.Client.Conduit (bodyReaderSource) -import Filesystem (rename, removeTree, removeFile, isFile, createTree) +import System.Directory import Web.PathPieces (toPathPiece) -import Filesystem.Path.CurrentOS (parent, fromText, encodeString) import Network.HTTP.Types (status200) import Data.Streaming.Network (bindPortTCP) import Network.AWS (Credentials (Discover), newEnv, @@ -30,10 +29,9 @@ import qualified Data.Conduit.Binary as CB import Data.Conduit.Zlib (WindowBits (WindowBits), compress, ungzip) import qualified Hoogle -import System.Directory (getAppUserDataDirectory) import Control.SingleRun import qualified Data.ByteString.Lazy as L -import System.FilePath (splitPath) +import System.FilePath (splitPath, takeDirectory) import System.Environment (getEnv) hoogleKey :: SnapName -> Text @@ -55,24 +53,24 @@ newHoogleLocker :: Bool -- ^ print exceptions? -> Manager -> IO (SingleRun SnapName (Maybe FilePath)) newHoogleLocker toPrint man = mkSingleRun $ \name -> do - let fp = fromText $ hoogleKey name - fptmp = encodeString fp <.> "tmp" + let fp = unpack $ hoogleKey name + fptmp = fp <.> "tmp" - exists <- isFile fp + exists <- doesFileExist fp if exists - then return $ Just (encodeString fp) + then return $ Just fp else do req' <- parseRequest $ unpack $ hoogleUrl name let req = req' { decompress = const False } withResponse req man $ \res -> if responseStatus res == status200 then do - createTree $ parent (fromString fptmp) + createDirectoryIfMissing True $ takeDirectory fptmp runConduitRes $ bodyReaderSource (responseBody res) .| ungzip .| sinkFile fptmp - rename (fromString fptmp) fp - return $ Just $ encodeString fp + renamePath fptmp fp + return $ Just fp else do when toPrint $ mapM brRead res >>= print return Nothing @@ -139,8 +137,8 @@ stackageServerCron = do let key = hoogleKey name upload fp (ObjectKey key) let dest = unpack key - createTree $ parent (fromString dest) - rename (fromString fp) (fromString dest) + createDirectoryIfMissing True $ takeDirectory dest + renamePath fp dest createHoogleDB :: StackageDatabase -> Manager -> SnapName -> IO (Maybe FilePath) createHoogleDB db man name = handleAny (\e -> print e $> Nothing) $ do @@ -148,17 +146,17 @@ createHoogleDB db man name = handleAny (\e -> print e $> Nothing) $ do req' <- parseRequest $ unpack tarUrl let req = req' { decompress = const True } - unlessM (isFile (fromString tarFP)) $ withResponse req man $ \res -> do + unlessM (doesFileExist tarFP) $ withResponse req man $ \res -> do let tmp = tarFP <.> "tmp" - createTree $ parent (fromString tmp) + createDirectoryIfMissing True $ takeDirectory tmp runConduitRes $ bodyReaderSource (responseBody res) .| sinkFile tmp - rename (fromString tmp) (fromString tarFP) + renamePath tmp tarFP - void $ tryIO $ removeTree (fromString bindir) - void $ tryIO $ removeFile (fromString outname) - createTree (fromString bindir) + void $ tryIO $ removeDirectoryRecursive bindir + void $ tryIO $ removeFile outname + createDirectoryIfMissing True bindir withSystemTempDirectory ("hoogle-" ++ unpack (toPathPiece name)) $ \tmpdir -> do allPackagePairs <- runConduitRes