Tune performance to avoid traverse converting to/from dict repeatedly.

This commit is contained in:
Dillon Kearns 2020-10-05 20:35:15 -07:00
parent 340f9b966c
commit ba228d2c1a
7 changed files with 133 additions and 48 deletions

View File

@ -24,6 +24,7 @@ import Json.Decode as Decode
import Pages.Document as Document exposing (Document)
import Pages.Internal.String as String
import Pages.PagePath as PagePath exposing (PagePath)
import RequestsAndPending exposing (RequestsAndPending)
import Task exposing (Task)
import TerminalText as Terminal
import Url exposing (Url)
@ -423,7 +424,7 @@ httpTask url =
type alias ContentJson body =
{ body : body
, staticData : Dict String String
, staticData : RequestsAndPending
}
@ -431,7 +432,7 @@ contentJsonDecoder : Decode.Decoder (ContentJson String)
contentJsonDecoder =
Decode.map2 ContentJson
(Decode.field "body" Decode.string)
(Decode.field "staticData" (Decode.dict Decode.string))
(Decode.field "staticData" RequestsAndPending.decoder)
update :

View File

@ -21,6 +21,7 @@ import Pages.Manifest as Manifest
import Pages.PagePath as PagePath exposing (PagePath)
import Pages.StaticHttp as StaticHttp
import Pages.StaticHttpRequest as StaticHttpRequest
import RequestsAndPending exposing (RequestsAndPending)
import Result.Extra
import Task exposing (Task)
import Url exposing (Url)
@ -250,7 +251,7 @@ type alias Flags =
type alias ContentJson =
{ body : String
, staticData : Dict String String
, staticData : RequestsAndPending
}
@ -258,7 +259,7 @@ contentJsonDecoder : Decode.Decoder ContentJson
contentJsonDecoder =
Decode.map2 ContentJson
(Decode.field "body" Decode.string)
(Decode.field "staticData" (Decode.dict Decode.string))
(Decode.field "staticData" RequestsAndPending.decoder)
init :

View File

@ -11,6 +11,7 @@ import Pages.PagePath as PagePath exposing (PagePath)
import Pages.StaticHttp as StaticHttp exposing (RequestDetails)
import Pages.StaticHttp.Request as HashRequest
import Pages.StaticHttpRequest as StaticHttpRequest
import RequestsAndPending exposing (RequestsAndPending)
import Secrets
import SecretsDict exposing (SecretsDict)
import Set
@ -113,15 +114,18 @@ init staticHttpCache siteMetadataResult config list =
updatedEntry =
staticHttpCache
|> dictCompact
|> Dict.toList
|> List.foldl
(\( hashedRequest, response ) entrySoFar ->
entrySoFar
|> addEntry
staticHttpCache
hashedRequest
(Ok response)
|> Dict.foldl
(\hashedRequest response entrySoFar ->
case response of
Nothing ->
entrySoFar
Just justResponse ->
entrySoFar
|> addEntry
staticHttpCache
hashedRequest
(Ok justResponse)
)
entry
in
@ -171,7 +175,6 @@ update newEntry model =
let
realUrls =
updatedAllResponses
|> dictCompact
|> StaticHttpRequest.resolveUrls ApplicationType.Cli request
|> Tuple.second
|> List.map Secrets.maskedLookup
@ -200,7 +203,7 @@ update newEntry model =
addEntry :
Dict String (Maybe String)
RequestsAndPending
-> String
-> Result () String
-> StaticHttpResult
@ -209,7 +212,6 @@ addEntry globalRawResponses hashedRequest rawResponse ((NotFetched request rawRe
let
realUrls =
globalRawResponses
|> dictCompact
|> StaticHttpRequest.resolveUrls ApplicationType.Cli request
|> Tuple.second
|> List.map Secrets.maskedLookup
@ -244,20 +246,25 @@ encode mode (StaticResponses staticResponses) =
case result of
NotFetched request rawResponsesDict ->
let
relevantResponses : RequestsAndPending
relevantResponses =
Dict.map
(\_ ->
(\key value ->
-- TODO avoid running this code at all if there are errors here
Result.withDefault ""
value
|> Result.withDefault ""
|> Just
)
rawResponsesDict
in
case mode of
Mode.Dev ->
relevantResponses
|> Dict.Extra.filterMap (\key value -> value)
Mode.Prod ->
StaticHttpRequest.strippedResponses ApplicationType.Cli request relevantResponses
|> Dict.Extra.filterMap (\key value -> value)
)
@ -300,7 +307,7 @@ nextStep :
-> Result (List BuildError) (List ( PagePath pathKey, metadata ))
-> Mode
-> SecretsDict
-> Dict String (Maybe String)
-> RequestsAndPending
-> List BuildError
-> StaticResponses
-> NextStep pathKey
@ -346,7 +353,7 @@ nextStep config siteMetadata mode secrets allRawResponses errors (StaticResponse
resolvedGenerateFilesResult =
StaticHttpRequest.resolve ApplicationType.Cli
(config.generateFiles metadataForGenerateFiles)
(allRawResponses |> Dict.Extra.filterMap (\key value -> value))
(allRawResponses |> Dict.Extra.filterMap (\key value -> Just value))
generatedOkayFiles : List { path : List String, content : String }
generatedOkayFiles =
@ -393,10 +400,10 @@ nextStep config siteMetadata mode secrets allRawResponses errors (StaticResponse
case entry of
NotFetched request rawResponses ->
let
usableRawResponses : Dict String String
usableRawResponses : RequestsAndPending
usableRawResponses =
rawResponses
|> Dict.Extra.filterMap
|> Dict.map
(\key value ->
value
|> Result.map Just
@ -425,8 +432,10 @@ nextStep config siteMetadata mode secrets allRawResponses errors (StaticResponse
ApplicationType.Cli
request
(rawResponses
|> Dict.map (\key value -> value |> Result.withDefault "")
|> Dict.union (allRawResponses |> Dict.Extra.filterMap (\_ value -> value))
|> Dict.map (\key value -> value |> Result.withDefault "" |> Just)
--|> Dict.union (allRawResponses |> Dict.Extra.filterMap (\_ value -> value))
--|> Dict.map (\key value -> value)
|> Dict.union allRawResponses
)
fetchedAllKnownUrls =
@ -456,10 +465,16 @@ nextStep config siteMetadata mode secrets allRawResponses errors (StaticResponse
|> List.concatMap
(\( path, NotFetched request rawResponses ) ->
let
usableRawResponses : Dict String String
( status, continuationRequests ) =
StaticHttpRequest.cacheRequestResolution
ApplicationType.Cli
request
usableRawResponses
usableRawResponses : RequestsAndPending
usableRawResponses =
rawResponses
|> Dict.Extra.filterMap
|> Dict.map
(\key value ->
value
|> Result.map Just
@ -554,10 +569,10 @@ performStaticHttpRequests :
-> Result (List BuildError) (List { unmasked : RequestDetails, masked : RequestDetails })
performStaticHttpRequests allRawResponses secrets staticRequests =
staticRequests
-- TODO look for performance bottleneck in this double nesting
|> List.map
(\( pagePath, request ) ->
allRawResponses
|> dictCompact
|> StaticHttpRequest.resolveUrls ApplicationType.Cli request
|> Tuple.second
)

View File

@ -86,6 +86,7 @@ import Pages.Internal.StaticHttpBody as Body
import Pages.Secrets
import Pages.StaticHttp.Request as HashRequest
import Pages.StaticHttpRequest exposing (Request(..))
import RequestsAndPending exposing (RequestsAndPending)
import Secrets
@ -241,7 +242,7 @@ map2 fn request1 request2 =
case ( request1, request2 ) of
( Request ( urls1, lookupFn1 ), Request ( urls2, lookupFn2 ) ) ->
let
value : ApplicationType -> Dict String String -> Result Pages.StaticHttpRequest.Error ( Dict String String, Request c )
value : ApplicationType -> RequestsAndPending -> Result Pages.StaticHttpRequest.Error ( RequestsAndPending, Request c )
value appType rawResponses =
let
value1 =
@ -326,12 +327,12 @@ map2 fn request1 request2 =
This is assuming that there are no duplicate URLs, so it can safely choose between either a raw or a reduced response.
It would not work correctly if it chose between two responses that were reduced with different `Json.Decode.Exploration.Decoder`s.
-}
combineReducedDicts : Dict String String -> Dict String String -> Dict String String
combineReducedDicts : RequestsAndPending -> RequestsAndPending -> RequestsAndPending
combineReducedDicts dict1 dict2 =
(Dict.toList dict1 ++ Dict.toList dict2)
|> Dict.Extra.fromListDedupe
(\response1 response2 ->
if String.length response1 < String.length response2 then
if String.length (response1 |> Maybe.withDefault "") < String.length (response2 |> Maybe.withDefault "") then
response1
else
@ -339,7 +340,7 @@ combineReducedDicts dict1 dict2 =
)
lookup : ApplicationType -> Pages.StaticHttpRequest.Request value -> Dict String String -> Result Pages.StaticHttpRequest.Error ( Dict String String, value )
lookup : ApplicationType -> Pages.StaticHttpRequest.Request value -> RequestsAndPending -> Result Pages.StaticHttpRequest.Error ( RequestsAndPending, value )
lookup appType requestInfo rawResponses =
case requestInfo of
Request ( urls, lookupFn ) ->
@ -595,7 +596,7 @@ unoptimizedRequest requestWithSecrets expect =
case appType of
ApplicationType.Cli ->
rawResponseDict
|> Dict.get (Secrets.maskedLookup requestWithSecrets |> HashRequest.hash)
|> RequestsAndPending.get (Secrets.maskedLookup requestWithSecrets |> HashRequest.hash)
|> (\maybeResponse ->
case maybeResponse of
Just rawResponse ->
@ -640,7 +641,7 @@ unoptimizedRequest requestWithSecrets expect =
|> Result.map
(\finalRequest ->
( strippedResponses
|> Dict.insert
|> RequestsAndPending.insert
(Secrets.maskedLookup requestWithSecrets |> HashRequest.hash)
reduced
, finalRequest
@ -650,7 +651,7 @@ unoptimizedRequest requestWithSecrets expect =
ApplicationType.Browser ->
rawResponseDict
|> Dict.get (Secrets.maskedLookup requestWithSecrets |> HashRequest.hash)
|> RequestsAndPending.get (Secrets.maskedLookup requestWithSecrets |> HashRequest.hash)
|> (\maybeResponse ->
case maybeResponse of
Just rawResponse ->
@ -690,7 +691,7 @@ unoptimizedRequest requestWithSecrets expect =
( [ requestWithSecrets ]
, \appType rawResponseDict ->
rawResponseDict
|> Dict.get (Secrets.maskedLookup requestWithSecrets |> HashRequest.hash)
|> RequestsAndPending.get (Secrets.maskedLookup requestWithSecrets |> HashRequest.hash)
|> (\maybeResponse ->
case maybeResponse of
Just rawResponse ->
@ -726,7 +727,7 @@ unoptimizedRequest requestWithSecrets expect =
|> Result.map
(\finalRequest ->
( strippedResponses
|> Dict.insert
|> RequestsAndPending.insert
(Secrets.maskedLookup requestWithSecrets |> HashRequest.hash)
rawResponse
, finalRequest
@ -740,7 +741,7 @@ unoptimizedRequest requestWithSecrets expect =
( [ requestWithSecrets ]
, \appType rawResponseDict ->
rawResponseDict
|> Dict.get (Secrets.maskedLookup requestWithSecrets |> HashRequest.hash)
|> RequestsAndPending.get (Secrets.maskedLookup requestWithSecrets |> HashRequest.hash)
|> (\maybeResponse ->
case maybeResponse of
Just rawResponse ->
@ -765,7 +766,7 @@ unoptimizedRequest requestWithSecrets expect =
|> Result.map
(\finalRequest ->
( strippedResponses
|> Dict.insert
|> RequestsAndPending.insert
(Secrets.maskedLookup requestWithSecrets |> HashRequest.hash)
rawResponse
, finalRequest

View File

@ -1,19 +1,21 @@
module Pages.StaticHttpRequest exposing (Error(..), Request(..), permanentError, resolve, resolveUrls, strippedResponses, toBuildError, urls)
module Pages.StaticHttpRequest exposing (Error(..), Request(..), cacheRequestResolution, permanentError, resolve, resolveUrls, strippedResponses, toBuildError, urls)
import BuildError exposing (BuildError)
import Dict exposing (Dict)
import Pages.Internal.ApplicationType as ApplicationType exposing (ApplicationType)
import Pages.Internal.StaticHttpBody as StaticHttpBody
import Pages.StaticHttp.Request
import RequestsAndPending exposing (RequestsAndPending)
import Secrets
import TerminalText as Terminal
type Request value
= Request ( List (Secrets.Value Pages.StaticHttp.Request.Request), ApplicationType -> Dict String String -> Result Error ( Dict String String, Request value ) )
= Request ( List (Secrets.Value Pages.StaticHttp.Request.Request), ApplicationType -> RequestsAndPending -> Result Error ( Dict String (Maybe String), Request value ) )
| Done value
strippedResponses : ApplicationType -> Request value -> Dict String String -> Dict String String
strippedResponses : ApplicationType -> Request value -> RequestsAndPending -> RequestsAndPending
strippedResponses appType request rawResponses =
case request of
Request ( list, lookupFn ) ->
@ -78,7 +80,7 @@ toBuildError path error =
}
permanentError : ApplicationType -> Request value -> Dict String String -> Maybe Error
permanentError : ApplicationType -> Request value -> RequestsAndPending -> Maybe Error
permanentError appType request rawResponses =
case request of
Request ( urlList, lookupFn ) ->
@ -101,7 +103,7 @@ permanentError appType request rawResponses =
Nothing
resolve : ApplicationType -> Request value -> Dict String String -> Result Error value
resolve : ApplicationType -> Request value -> RequestsAndPending -> Result Error value
resolve appType request rawResponses =
case request of
Request ( urlList, lookupFn ) ->
@ -116,19 +118,53 @@ resolve appType request rawResponses =
Ok value
resolveUrls : ApplicationType -> Request value -> Dict String String -> ( Bool, List (Secrets.Value Pages.StaticHttp.Request.Request) )
resolveUrls : ApplicationType -> Request value -> RequestsAndPending -> ( Bool, List (Secrets.Value Pages.StaticHttp.Request.Request) )
resolveUrls appType request rawResponses =
case request of
Request ( urlList, lookupFn ) ->
case lookupFn appType rawResponses of
Ok ( partiallyStrippedResponses, nextRequest ) ->
Ok ( _, nextRequest ) ->
resolveUrls appType nextRequest rawResponses
|> Tuple.mapSecond ((++) urlList)
Err error ->
Err _ ->
( False
, urlList
)
Done value ->
Done _ ->
( True, [] )
cacheRequestResolution :
ApplicationType
-> Request value
-> RequestsAndPending
-> ( Status value, List (Secrets.Value Pages.StaticHttp.Request.Request) )
cacheRequestResolution =
cacheRequestResolutionHelp []
type Status value
= CompleteWithError Error
| Complete value
cacheRequestResolutionHelp :
List (Secrets.Value Pages.StaticHttp.Request.Request)
-> ApplicationType
-> Request value
-> RequestsAndPending
-> ( Status value, List (Secrets.Value Pages.StaticHttp.Request.Request) )
cacheRequestResolutionHelp foundUrls appType request rawResponses =
case request of
Request ( urlList, lookupFn ) ->
case lookupFn appType rawResponses of
Ok ( partiallyStrippedResponses, nextRequest ) ->
cacheRequestResolutionHelp urlList appType nextRequest rawResponses
Err error ->
( CompleteWithError error, urlList ++ foundUrls )
Done value ->
( Complete value, [] )

View File

@ -0,0 +1,31 @@
module RequestsAndPending exposing (..)
import Dict exposing (Dict)
import Json.Decode as Decode
import List.Extra as Dict
type alias RequestsAndPending =
Dict String (Maybe String)
init : RequestsAndPending
init =
Dict.empty
get : String -> RequestsAndPending -> Maybe String
get key requestsAndPending =
requestsAndPending
|> Dict.get key
|> Maybe.andThen identity
insert : String -> String -> RequestsAndPending -> RequestsAndPending
insert key value requestsAndPending =
Dict.insert key (Just value) requestsAndPending
decoder : Decode.Decoder RequestsAndPending
decoder =
Decode.dict (Decode.string |> Decode.map Just)

View File

@ -21,7 +21,7 @@ requestsDict requestMap =
|> List.map
(\( request, response ) ->
( request |> Request.hash
, response
, Just response
)
)
|> Dict.fromList