{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE LambdaCase #-} module Hpack.Defaults ( ensure , Defaults(..) #ifdef TEST , Result(..) , ensureFile #endif ) where import Imports import Network.HTTP.Client import Network.HTTP.Client.TLS import qualified Data.ByteString.Lazy as LB import System.FilePath import System.Directory import Hpack.Error import Hpack.Syntax.Defaults defaultsUrl :: Github -> URL defaultsUrl :: Github -> FilePath defaultsUrl Github{FilePath [FilePath] githubOwner :: FilePath githubRepo :: FilePath githubRef :: FilePath githubPath :: [FilePath] githubOwner :: Github -> FilePath githubRepo :: Github -> FilePath githubRef :: Github -> FilePath githubPath :: Github -> [FilePath] ..} = FilePath "https://raw.githubusercontent.com/" FilePath -> FilePath -> FilePath forall a. [a] -> [a] -> [a] ++ FilePath githubOwner FilePath -> FilePath -> FilePath forall a. [a] -> [a] -> [a] ++ FilePath "/" FilePath -> FilePath -> FilePath forall a. [a] -> [a] -> [a] ++ FilePath githubRepo FilePath -> FilePath -> FilePath forall a. [a] -> [a] -> [a] ++ FilePath "/" FilePath -> FilePath -> FilePath forall a. [a] -> [a] -> [a] ++ FilePath githubRef FilePath -> FilePath -> FilePath forall a. [a] -> [a] -> [a] ++ FilePath "/" FilePath -> FilePath -> FilePath forall a. [a] -> [a] -> [a] ++ FilePath -> [FilePath] -> FilePath forall a. [a] -> [[a]] -> [a] intercalate FilePath "/" [FilePath] githubPath defaultsCachePath :: FilePath -> Github -> FilePath defaultsCachePath :: FilePath -> Github -> FilePath defaultsCachePath FilePath dir Github{FilePath [FilePath] githubOwner :: Github -> FilePath githubRepo :: Github -> FilePath githubRef :: Github -> FilePath githubPath :: Github -> [FilePath] githubOwner :: FilePath githubRepo :: FilePath githubRef :: FilePath githubPath :: [FilePath] ..} = [FilePath] -> FilePath joinPath ([FilePath] -> FilePath) -> [FilePath] -> FilePath forall a b. (a -> b) -> a -> b $ FilePath dir FilePath -> [FilePath] -> [FilePath] forall a. a -> [a] -> [a] : FilePath "defaults" FilePath -> [FilePath] -> [FilePath] forall a. a -> [a] -> [a] : FilePath githubOwner FilePath -> [FilePath] -> [FilePath] forall a. a -> [a] -> [a] : FilePath githubRepo FilePath -> [FilePath] -> [FilePath] forall a. a -> [a] -> [a] : FilePath githubRef FilePath -> [FilePath] -> [FilePath] forall a. a -> [a] -> [a] : [FilePath] githubPath data Result = Found | NotFound | Failed Status deriving (Result -> Result -> Bool (Result -> Result -> Bool) -> (Result -> Result -> Bool) -> Eq Result forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a $c== :: Result -> Result -> Bool == :: Result -> Result -> Bool $c/= :: Result -> Result -> Bool /= :: Result -> Result -> Bool Eq, Int -> Result -> FilePath -> FilePath [Result] -> FilePath -> FilePath Result -> FilePath (Int -> Result -> FilePath -> FilePath) -> (Result -> FilePath) -> ([Result] -> FilePath -> FilePath) -> Show Result forall a. (Int -> a -> FilePath -> FilePath) -> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a $cshowsPrec :: Int -> Result -> FilePath -> FilePath showsPrec :: Int -> Result -> FilePath -> FilePath $cshow :: Result -> FilePath show :: Result -> FilePath $cshowList :: [Result] -> FilePath -> FilePath showList :: [Result] -> FilePath -> FilePath Show) get :: URL -> FilePath -> IO Result get :: FilePath -> FilePath -> IO Result get FilePath url FilePath file = do Manager manager <- ManagerSettings -> IO Manager newManager ManagerSettings tlsManagerSettings Request request <- FilePath -> IO Request forall (m :: * -> *). MonadThrow m => FilePath -> m Request parseRequest FilePath url Response ByteString response <- Request -> Manager -> IO (Response ByteString) httpLbs Request request Manager manager case Response ByteString -> Status forall body. Response body -> Status responseStatus Response ByteString response of Status Int 200 ByteString _ -> do Bool -> FilePath -> IO () createDirectoryIfMissing Bool True (FilePath -> FilePath takeDirectory FilePath file) FilePath -> ByteString -> IO () LB.writeFile FilePath file (Response ByteString -> ByteString forall body. Response body -> body responseBody Response ByteString response) Result -> IO Result forall a. a -> IO a forall (m :: * -> *) a. Monad m => a -> m a return Result Found Status Int 404 ByteString _ -> Result -> IO Result forall a. a -> IO a forall (m :: * -> *) a. Monad m => a -> m a return Result NotFound Status status -> Result -> IO Result forall a. a -> IO a forall (m :: * -> *) a. Monad m => a -> m a return (Status -> Result Failed Status status) ensure :: FilePath -> FilePath -> Defaults -> IO (Either HpackError FilePath) ensure :: FilePath -> FilePath -> Defaults -> IO (Either HpackError FilePath) ensure FilePath userDataDir FilePath dir = \ case DefaultsGithub Github defaults -> do let url :: FilePath url = Github -> FilePath defaultsUrl Github defaults file :: FilePath file = FilePath -> Github -> FilePath defaultsCachePath FilePath userDataDir Github defaults FilePath -> FilePath -> IO Result ensureFile FilePath file FilePath url IO Result -> (Result -> IO (Either HpackError FilePath)) -> IO (Either HpackError FilePath) forall a b. IO a -> (a -> IO b) -> IO b forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \ case Result Found -> Either HpackError FilePath -> IO (Either HpackError FilePath) forall a. a -> IO a forall (m :: * -> *) a. Monad m => a -> m a return (FilePath -> Either HpackError FilePath forall a b. b -> Either a b Right FilePath file) Result NotFound -> FilePath -> IO (Either HpackError FilePath) forall {b}. FilePath -> IO (Either HpackError b) notFound FilePath url Failed Status status -> Either HpackError FilePath -> IO (Either HpackError FilePath) forall a. a -> IO a forall (m :: * -> *) a. Monad m => a -> m a return (HpackError -> Either HpackError FilePath forall a b. a -> Either a b Left (HpackError -> Either HpackError FilePath) -> HpackError -> Either HpackError FilePath forall a b. (a -> b) -> a -> b $ FilePath -> Status -> HpackError DefaultsDownloadFailed FilePath url Status status) DefaultsLocal (Local ((FilePath dir FilePath -> FilePath -> FilePath </>) -> FilePath file)) -> do FilePath -> IO Bool doesFileExist FilePath file IO Bool -> (Bool -> IO (Either HpackError FilePath)) -> IO (Either HpackError FilePath) forall a b. IO a -> (a -> IO b) -> IO b forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \ case Bool True -> Either HpackError FilePath -> IO (Either HpackError FilePath) forall a. a -> IO a forall (m :: * -> *) a. Monad m => a -> m a return (FilePath -> Either HpackError FilePath forall a b. b -> Either a b Right FilePath file) Bool False -> FilePath -> IO (Either HpackError FilePath) forall {b}. FilePath -> IO (Either HpackError b) notFound FilePath file where notFound :: FilePath -> IO (Either HpackError b) notFound = Either HpackError b -> IO (Either HpackError b) forall a. a -> IO a forall (m :: * -> *) a. Monad m => a -> m a return (Either HpackError b -> IO (Either HpackError b)) -> (FilePath -> Either HpackError b) -> FilePath -> IO (Either HpackError b) forall b c a. (b -> c) -> (a -> b) -> a -> c . HpackError -> Either HpackError b forall a b. a -> Either a b Left (HpackError -> Either HpackError b) -> (FilePath -> HpackError) -> FilePath -> Either HpackError b forall b c a. (b -> c) -> (a -> b) -> a -> c . FilePath -> HpackError DefaultsFileNotFound ensureFile :: FilePath -> URL -> IO Result ensureFile :: FilePath -> FilePath -> IO Result ensureFile FilePath file FilePath url = do FilePath -> IO Bool doesFileExist FilePath file IO Bool -> (Bool -> IO Result) -> IO Result forall a b. IO a -> (a -> IO b) -> IO b forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \ case Bool True -> Result -> IO Result forall a. a -> IO a forall (m :: * -> *) a. Monad m => a -> m a return Result Found Bool False -> FilePath -> FilePath -> IO Result get FilePath url FilePath file