mirror of
https://github.com/gren-lang/compiler.git
synced 2024-09-11 08:45:42 +03:00
Remove Http client library.
This commit is contained in:
parent
adefad452a
commit
9c0cd44ef4
@ -28,7 +28,6 @@ import qualified Elm.ModuleName as ModuleName
|
||||
import qualified Elm.Package as Pkg
|
||||
import qualified Elm.Version as V
|
||||
import qualified File
|
||||
import qualified Http
|
||||
import qualified Json.Decode as D
|
||||
import qualified Reporting.Exit as Exit
|
||||
import qualified Directories as Dirs
|
||||
@ -354,7 +353,7 @@ changeMagnitude (Changes added changed removed) =
|
||||
-- GET DOCS
|
||||
|
||||
|
||||
getDocs :: Dirs.PackageCache -> Http.Manager -> Pkg.Name -> V.Version -> IO (Either () Docs.Documentation)
|
||||
getDocs cache manager name version =
|
||||
getDocs :: Dirs.PackageCache -> Pkg.Name -> V.Version -> IO (Either () Docs.Documentation)
|
||||
getDocs cache name version =
|
||||
-- TODO: Implement using local git clones
|
||||
return $ Right Docs.tmpEmpty
|
||||
|
@ -27,7 +27,6 @@ import qualified Elm.Package as Pkg
|
||||
import qualified Elm.Outline as Outline
|
||||
import qualified Elm.Version as V
|
||||
import qualified File
|
||||
import qualified Http
|
||||
import qualified Git
|
||||
import qualified Json.Decode as D
|
||||
import qualified Reporting.Exit as Exit
|
||||
|
@ -47,7 +47,6 @@ import qualified Elm.Outline as Outline
|
||||
import qualified Elm.Package as Pkg
|
||||
import qualified Elm.Version as V
|
||||
import qualified File
|
||||
import qualified Http
|
||||
import qualified Json.Decode as D
|
||||
import qualified Json.Encode as E
|
||||
import qualified Parse.Module as Parse
|
||||
|
@ -7,7 +7,6 @@ module File
|
||||
, writeUtf8
|
||||
, readUtf8
|
||||
, writeBuilder
|
||||
, writePackage
|
||||
, exists
|
||||
, remove
|
||||
, removeDir
|
||||
@ -15,7 +14,6 @@ module File
|
||||
where
|
||||
|
||||
|
||||
import qualified Codec.Archive.Zip as Zip
|
||||
import Control.Exception (catch)
|
||||
import qualified Data.Binary as Binary
|
||||
import qualified Data.ByteString as BS
|
||||
@ -171,38 +169,6 @@ writeBuilder path builder =
|
||||
|
||||
|
||||
|
||||
-- WRITE PACKAGE
|
||||
|
||||
|
||||
writePackage :: FilePath -> Zip.Archive -> IO ()
|
||||
writePackage destination archive =
|
||||
case Zip.zEntries archive of
|
||||
[] ->
|
||||
return ()
|
||||
|
||||
entry:entries ->
|
||||
do let root = length (Zip.eRelativePath entry)
|
||||
mapM_ (writeEntry destination root) entries
|
||||
|
||||
|
||||
writeEntry :: FilePath -> Int -> Zip.Entry -> IO ()
|
||||
writeEntry destination root entry =
|
||||
let
|
||||
path = drop root (Zip.eRelativePath entry)
|
||||
in
|
||||
if List.isPrefixOf "src/" path
|
||||
|| path == "LICENSE"
|
||||
|| path == "README.md"
|
||||
|| path == "elm.json"
|
||||
then
|
||||
if not (null path) && last path == '/'
|
||||
then Dir.createDirectoryIfMissing True (destination </> path)
|
||||
else LBS.writeFile (destination </> path) (Zip.fromEntry entry)
|
||||
else
|
||||
return ()
|
||||
|
||||
|
||||
|
||||
-- EXISTS
|
||||
|
||||
|
||||
|
@ -1,244 +0,0 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
module Http
|
||||
( Manager
|
||||
, getManager
|
||||
, toUrl
|
||||
-- fetch
|
||||
, get
|
||||
, post
|
||||
, Header
|
||||
, accept
|
||||
, Error(..)
|
||||
-- archives
|
||||
, Sha
|
||||
, shaToChars
|
||||
, getArchive
|
||||
-- upload
|
||||
, upload
|
||||
, filePart
|
||||
, jsonPart
|
||||
, stringPart
|
||||
)
|
||||
where
|
||||
|
||||
|
||||
import Prelude hiding (zip)
|
||||
import qualified Codec.Archive.Zip as Zip
|
||||
import Control.Exception (SomeException, handle)
|
||||
import qualified Data.Binary as Binary
|
||||
import qualified Data.Binary.Get as Binary
|
||||
import qualified Data.ByteString.Builder as B
|
||||
import qualified Data.ByteString.Char8 as BS
|
||||
import qualified Data.Digest.Pure.SHA as SHA
|
||||
import qualified Data.String as String
|
||||
import Network.HTTP (urlEncodeVars)
|
||||
import Network.HTTP.Client
|
||||
import Network.HTTP.Client.TLS (tlsManagerSettings)
|
||||
import Network.HTTP.Types.Header (Header, hAccept, hAcceptEncoding, hUserAgent)
|
||||
import Network.HTTP.Types.Method (Method, methodGet, methodPost)
|
||||
import qualified Network.HTTP.Client as Multi (RequestBody(RequestBodyLBS))
|
||||
import qualified Network.HTTP.Client.MultipartFormData as Multi
|
||||
|
||||
import qualified Json.Encode as Encode
|
||||
import qualified Elm.Version as V
|
||||
|
||||
|
||||
|
||||
-- MANAGER
|
||||
|
||||
|
||||
getManager :: IO Manager
|
||||
getManager =
|
||||
newManager tlsManagerSettings
|
||||
|
||||
|
||||
|
||||
-- URL
|
||||
|
||||
|
||||
toUrl :: String -> [(String,String)] -> String
|
||||
toUrl url params =
|
||||
case params of
|
||||
[] -> url
|
||||
_:_ -> url ++ "?" ++ urlEncodeVars params
|
||||
|
||||
|
||||
|
||||
-- FETCH
|
||||
|
||||
|
||||
get :: Manager -> String -> [Header] -> (Error -> e) -> (BS.ByteString -> IO (Either e a)) -> IO (Either e a)
|
||||
get =
|
||||
fetch methodGet
|
||||
|
||||
|
||||
post :: Manager -> String -> [Header] -> (Error -> e) -> (BS.ByteString -> IO (Either e a)) -> IO (Either e a)
|
||||
post =
|
||||
fetch methodPost
|
||||
|
||||
|
||||
fetch :: Method -> Manager -> String -> [Header] -> (Error -> e) -> (BS.ByteString -> IO (Either e a)) -> IO (Either e a)
|
||||
fetch methodVerb manager url headers onError onSuccess =
|
||||
handle (handleSomeException url onError) $
|
||||
handle (handleHttpException url onError) $
|
||||
do req0 <- parseUrlThrow url
|
||||
let req1 =
|
||||
req0
|
||||
{ method = methodVerb
|
||||
, requestHeaders = addDefaultHeaders headers
|
||||
}
|
||||
withResponse req1 manager $ \response ->
|
||||
do chunks <- brConsume (responseBody response)
|
||||
onSuccess (BS.concat chunks)
|
||||
|
||||
|
||||
addDefaultHeaders :: [Header] -> [Header]
|
||||
addDefaultHeaders headers =
|
||||
(hUserAgent, userAgent) : (hAcceptEncoding, "gzip") : headers
|
||||
|
||||
|
||||
{-# NOINLINE userAgent #-}
|
||||
userAgent :: BS.ByteString
|
||||
userAgent =
|
||||
BS.pack ("elm/" ++ V.toChars V.compiler)
|
||||
|
||||
|
||||
accept :: BS.ByteString -> Header
|
||||
accept mime =
|
||||
(hAccept, mime)
|
||||
|
||||
|
||||
|
||||
-- EXCEPTIONS
|
||||
|
||||
|
||||
data Error
|
||||
= BadUrl String String
|
||||
| BadHttp String HttpExceptionContent
|
||||
| BadMystery String SomeException
|
||||
|
||||
|
||||
handleHttpException :: String -> (Error -> e) -> HttpException -> IO (Either e a)
|
||||
handleHttpException url onError httpException =
|
||||
case httpException of
|
||||
InvalidUrlException _ reason ->
|
||||
return (Left (onError (BadUrl url reason)))
|
||||
|
||||
HttpExceptionRequest _ content ->
|
||||
return (Left (onError (BadHttp url content)))
|
||||
|
||||
|
||||
handleSomeException :: String -> (Error -> e) -> SomeException -> IO (Either e a)
|
||||
handleSomeException url onError exception =
|
||||
return (Left (onError (BadMystery url exception)))
|
||||
|
||||
|
||||
|
||||
-- SHA
|
||||
|
||||
|
||||
type Sha = SHA.Digest SHA.SHA1State
|
||||
|
||||
|
||||
shaToChars :: Sha -> String
|
||||
shaToChars =
|
||||
SHA.showDigest
|
||||
|
||||
|
||||
|
||||
-- FETCH ARCHIVE
|
||||
|
||||
|
||||
getArchive
|
||||
:: Manager
|
||||
-> String
|
||||
-> (Error -> e)
|
||||
-> e
|
||||
-> ((Sha, Zip.Archive) -> IO (Either e a))
|
||||
-> IO (Either e a)
|
||||
getArchive manager url onError err onSuccess =
|
||||
handle (handleSomeException url onError) $
|
||||
handle (handleHttpException url onError) $
|
||||
do req0 <- parseUrlThrow url
|
||||
let req1 =
|
||||
req0
|
||||
{ method = methodGet
|
||||
, requestHeaders = addDefaultHeaders []
|
||||
}
|
||||
withResponse req1 manager $ \response ->
|
||||
do result <- readArchive (responseBody response)
|
||||
case result of
|
||||
Nothing -> return (Left err)
|
||||
Just shaAndArchive -> onSuccess shaAndArchive
|
||||
|
||||
|
||||
readArchive :: BodyReader -> IO (Maybe (Sha, Zip.Archive))
|
||||
readArchive body =
|
||||
readArchiveHelp body $
|
||||
AS 0 SHA.sha1Incremental (Binary.runGetIncremental Binary.get)
|
||||
|
||||
|
||||
data ArchiveState =
|
||||
AS
|
||||
{ _len :: !Int
|
||||
, _sha :: !(Binary.Decoder SHA.SHA1State)
|
||||
, _zip :: !(Binary.Decoder Zip.Archive)
|
||||
}
|
||||
|
||||
|
||||
readArchiveHelp :: BodyReader -> ArchiveState -> IO (Maybe (Sha, Zip.Archive))
|
||||
readArchiveHelp body (AS len sha zip) =
|
||||
case zip of
|
||||
Binary.Fail _ _ _ ->
|
||||
return Nothing
|
||||
|
||||
Binary.Partial k ->
|
||||
do chunk <- brRead body
|
||||
readArchiveHelp body $
|
||||
AS
|
||||
{ _len = len + BS.length chunk
|
||||
, _sha = Binary.pushChunk sha chunk
|
||||
, _zip = k (if BS.null chunk then Nothing else Just chunk)
|
||||
}
|
||||
|
||||
Binary.Done _ _ archive ->
|
||||
return $ Just ( SHA.completeSha1Incremental sha len, archive )
|
||||
|
||||
|
||||
|
||||
-- UPLOAD
|
||||
|
||||
|
||||
upload :: Manager -> String -> [Multi.Part] -> IO (Either Error ())
|
||||
upload manager url parts =
|
||||
handle (handleSomeException url id) $
|
||||
handle (handleHttpException url id) $
|
||||
do req0 <- parseUrlThrow url
|
||||
req1 <-
|
||||
Multi.formDataBody parts $
|
||||
req0
|
||||
{ method = methodPost
|
||||
, requestHeaders = addDefaultHeaders []
|
||||
, responseTimeout = responseTimeoutNone
|
||||
}
|
||||
withResponse req1 manager $ \_ ->
|
||||
return (Right ())
|
||||
|
||||
|
||||
filePart :: String -> FilePath -> Multi.Part
|
||||
filePart name filePath =
|
||||
Multi.partFileSource (String.fromString name) filePath
|
||||
|
||||
|
||||
jsonPart :: String -> FilePath -> Encode.Value -> Multi.Part
|
||||
jsonPart name filePath value =
|
||||
let
|
||||
body =
|
||||
Multi.RequestBodyLBS $ B.toLazyByteString $ Encode.encodeUgly value
|
||||
in
|
||||
Multi.partFileRequestBody (String.fromString name) filePath body
|
||||
|
||||
|
||||
stringPart :: String -> String -> Multi.Part
|
||||
stringPart name string =
|
||||
Multi.partBS (String.fromString name) (BS.pack string)
|
@ -32,9 +32,6 @@ import qualified Data.List as List
|
||||
import qualified Data.Map as Map
|
||||
import qualified Data.Name as N
|
||||
import qualified Data.NonEmptyList as NE
|
||||
import qualified Network.HTTP.Client as HTTP
|
||||
import qualified Network.HTTP.Types.Header as HTTP
|
||||
import qualified Network.HTTP.Types.Status as HTTP
|
||||
import qualified System.FilePath as FP
|
||||
import System.FilePath ((</>), (<.>))
|
||||
|
||||
@ -45,7 +42,6 @@ import qualified Elm.Package as Pkg
|
||||
import qualified Elm.Version as V
|
||||
import qualified File
|
||||
import qualified Git
|
||||
import qualified Http
|
||||
import qualified Json.Decode as Decode
|
||||
import qualified Json.Encode as Encode
|
||||
import qualified Json.String as Json
|
||||
|
@ -81,7 +81,6 @@ Executable gren
|
||||
Deps.Solver
|
||||
File
|
||||
Generate
|
||||
Http
|
||||
Git
|
||||
Reporting
|
||||
Reporting.Exit
|
||||
@ -211,10 +210,6 @@ Executable gren
|
||||
filepath >= 1 && < 2.0,
|
||||
ghc-prim >= 0.5.2,
|
||||
haskeline,
|
||||
HTTP >= 4000.2.5 && < 4000.4,
|
||||
http-client >= 0.7 && < 0.8,
|
||||
http-client-tls >= 0.3 && < 0.4,
|
||||
http-types >= 0.12 && < 1.0,
|
||||
language-glsl >= 0.3,
|
||||
mtl >= 2.2.1 && < 3,
|
||||
network >= 2.4 && < 2.8,
|
||||
@ -229,5 +224,4 @@ Executable gren
|
||||
time >= 1.9.1,
|
||||
unordered-containers,
|
||||
utf8-string,
|
||||
vector,
|
||||
zip-archive
|
||||
vector
|
||||
|
@ -16,7 +16,6 @@ import qualified Elm.Docs as Docs
|
||||
import qualified Elm.Magnitude as M
|
||||
import qualified Elm.Outline as Outline
|
||||
import qualified Elm.Version as V
|
||||
import qualified Http
|
||||
import Reporting.Doc ((<>), (<+>))
|
||||
import qualified Reporting
|
||||
import qualified Reporting.Doc as D
|
||||
|
@ -24,7 +24,6 @@ import qualified Elm.Magnitude as M
|
||||
import qualified Elm.Outline as Outline
|
||||
import qualified Elm.Package as Pkg
|
||||
import qualified Elm.Version as V
|
||||
import qualified Http
|
||||
import qualified Reporting
|
||||
import Reporting.Doc ((<>), (<+>))
|
||||
import qualified Reporting.Doc as D
|
||||
|
@ -27,7 +27,6 @@ import qualified Elm.Outline as Outline
|
||||
import qualified Elm.Package as Pkg
|
||||
import qualified Elm.Version as V
|
||||
import qualified File
|
||||
import qualified Http
|
||||
import qualified Json.Decode as D
|
||||
import qualified Json.String as Json
|
||||
import qualified Reporting
|
||||
|
Loading…
Reference in New Issue
Block a user