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