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

View File

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

View File

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

View File

@ -86,6 +86,7 @@ import Pages.Internal.StaticHttpBody as Body
import Pages.Secrets import Pages.Secrets
import Pages.StaticHttp.Request as HashRequest import Pages.StaticHttp.Request as HashRequest
import Pages.StaticHttpRequest exposing (Request(..)) import Pages.StaticHttpRequest exposing (Request(..))
import RequestsAndPending exposing (RequestsAndPending)
import Secrets import Secrets
@ -241,7 +242,7 @@ map2 fn request1 request2 =
case ( request1, request2 ) of case ( request1, request2 ) of
( Request ( urls1, lookupFn1 ), Request ( urls2, lookupFn2 ) ) -> ( Request ( urls1, lookupFn1 ), Request ( urls2, lookupFn2 ) ) ->
let 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 = value appType rawResponses =
let let
value1 = 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. 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. 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 = combineReducedDicts dict1 dict2 =
(Dict.toList dict1 ++ Dict.toList dict2) (Dict.toList dict1 ++ Dict.toList dict2)
|> Dict.Extra.fromListDedupe |> Dict.Extra.fromListDedupe
(\response1 response2 -> (\response1 response2 ->
if String.length response1 < String.length response2 then if String.length (response1 |> Maybe.withDefault "") < String.length (response2 |> Maybe.withDefault "") then
response1 response1
else 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 = lookup appType requestInfo rawResponses =
case requestInfo of case requestInfo of
Request ( urls, lookupFn ) -> Request ( urls, lookupFn ) ->
@ -595,7 +596,7 @@ unoptimizedRequest requestWithSecrets expect =
case appType of case appType of
ApplicationType.Cli -> ApplicationType.Cli ->
rawResponseDict rawResponseDict
|> Dict.get (Secrets.maskedLookup requestWithSecrets |> HashRequest.hash) |> RequestsAndPending.get (Secrets.maskedLookup requestWithSecrets |> HashRequest.hash)
|> (\maybeResponse -> |> (\maybeResponse ->
case maybeResponse of case maybeResponse of
Just rawResponse -> Just rawResponse ->
@ -640,7 +641,7 @@ unoptimizedRequest requestWithSecrets expect =
|> Result.map |> Result.map
(\finalRequest -> (\finalRequest ->
( strippedResponses ( strippedResponses
|> Dict.insert |> RequestsAndPending.insert
(Secrets.maskedLookup requestWithSecrets |> HashRequest.hash) (Secrets.maskedLookup requestWithSecrets |> HashRequest.hash)
reduced reduced
, finalRequest , finalRequest
@ -650,7 +651,7 @@ unoptimizedRequest requestWithSecrets expect =
ApplicationType.Browser -> ApplicationType.Browser ->
rawResponseDict rawResponseDict
|> Dict.get (Secrets.maskedLookup requestWithSecrets |> HashRequest.hash) |> RequestsAndPending.get (Secrets.maskedLookup requestWithSecrets |> HashRequest.hash)
|> (\maybeResponse -> |> (\maybeResponse ->
case maybeResponse of case maybeResponse of
Just rawResponse -> Just rawResponse ->
@ -690,7 +691,7 @@ unoptimizedRequest requestWithSecrets expect =
( [ requestWithSecrets ] ( [ requestWithSecrets ]
, \appType rawResponseDict -> , \appType rawResponseDict ->
rawResponseDict rawResponseDict
|> Dict.get (Secrets.maskedLookup requestWithSecrets |> HashRequest.hash) |> RequestsAndPending.get (Secrets.maskedLookup requestWithSecrets |> HashRequest.hash)
|> (\maybeResponse -> |> (\maybeResponse ->
case maybeResponse of case maybeResponse of
Just rawResponse -> Just rawResponse ->
@ -726,7 +727,7 @@ unoptimizedRequest requestWithSecrets expect =
|> Result.map |> Result.map
(\finalRequest -> (\finalRequest ->
( strippedResponses ( strippedResponses
|> Dict.insert |> RequestsAndPending.insert
(Secrets.maskedLookup requestWithSecrets |> HashRequest.hash) (Secrets.maskedLookup requestWithSecrets |> HashRequest.hash)
rawResponse rawResponse
, finalRequest , finalRequest
@ -740,7 +741,7 @@ unoptimizedRequest requestWithSecrets expect =
( [ requestWithSecrets ] ( [ requestWithSecrets ]
, \appType rawResponseDict -> , \appType rawResponseDict ->
rawResponseDict rawResponseDict
|> Dict.get (Secrets.maskedLookup requestWithSecrets |> HashRequest.hash) |> RequestsAndPending.get (Secrets.maskedLookup requestWithSecrets |> HashRequest.hash)
|> (\maybeResponse -> |> (\maybeResponse ->
case maybeResponse of case maybeResponse of
Just rawResponse -> Just rawResponse ->
@ -765,7 +766,7 @@ unoptimizedRequest requestWithSecrets expect =
|> Result.map |> Result.map
(\finalRequest -> (\finalRequest ->
( strippedResponses ( strippedResponses
|> Dict.insert |> RequestsAndPending.insert
(Secrets.maskedLookup requestWithSecrets |> HashRequest.hash) (Secrets.maskedLookup requestWithSecrets |> HashRequest.hash)
rawResponse rawResponse
, finalRequest , 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 BuildError exposing (BuildError)
import Dict exposing (Dict) import Dict exposing (Dict)
import Pages.Internal.ApplicationType as ApplicationType exposing (ApplicationType) import Pages.Internal.ApplicationType as ApplicationType exposing (ApplicationType)
import Pages.Internal.StaticHttpBody as StaticHttpBody
import Pages.StaticHttp.Request import Pages.StaticHttp.Request
import RequestsAndPending exposing (RequestsAndPending)
import Secrets import Secrets
import TerminalText as Terminal import TerminalText as Terminal
type Request value 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 | Done value
strippedResponses : ApplicationType -> Request value -> Dict String String -> Dict String String strippedResponses : ApplicationType -> Request value -> RequestsAndPending -> RequestsAndPending
strippedResponses appType request rawResponses = strippedResponses appType request rawResponses =
case request of case request of
Request ( list, lookupFn ) -> 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 = permanentError appType request rawResponses =
case request of case request of
Request ( urlList, lookupFn ) -> Request ( urlList, lookupFn ) ->
@ -101,7 +103,7 @@ permanentError appType request rawResponses =
Nothing Nothing
resolve : ApplicationType -> Request value -> Dict String String -> Result Error value resolve : ApplicationType -> Request value -> RequestsAndPending -> Result Error value
resolve appType request rawResponses = resolve appType request rawResponses =
case request of case request of
Request ( urlList, lookupFn ) -> Request ( urlList, lookupFn ) ->
@ -116,19 +118,53 @@ resolve appType request rawResponses =
Ok value 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 = resolveUrls appType request rawResponses =
case request of case request of
Request ( urlList, lookupFn ) -> Request ( urlList, lookupFn ) ->
case lookupFn appType rawResponses of case lookupFn appType rawResponses of
Ok ( partiallyStrippedResponses, nextRequest ) -> Ok ( _, nextRequest ) ->
resolveUrls appType nextRequest rawResponses resolveUrls appType nextRequest rawResponses
|> Tuple.mapSecond ((++) urlList) |> Tuple.mapSecond ((++) urlList)
Err error -> Err _ ->
( False ( False
, urlList , urlList
) )
Done value -> Done _ ->
( True, [] ) ( 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 |> List.map
(\( request, response ) -> (\( request, response ) ->
( request |> Request.hash ( request |> Request.hash
, response , Just response
) )
) )
|> Dict.fromList |> Dict.fromList