From 7f739ce4e2d592bbbb7c5e39366bcd009f6230d8 Mon Sep 17 00:00:00 2001 From: Dillon Kearns Date: Mon, 24 Aug 2020 13:40:30 -0700 Subject: [PATCH 001/100] Ignore coverage folder. --- .gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitignore b/.gitignore index 333588be..4ec4f508 100644 --- a/.gitignore +++ b/.gitignore @@ -4,3 +4,4 @@ dist/ .cache/ generator/src/Main.js elm-pages-*.tgz +coverage From e2a12877034a46890e2c231babf19b12c36781d9 Mon Sep 17 00:00:00 2001 From: Dillon Kearns Date: Wed, 23 Sep 2020 11:30:45 -0700 Subject: [PATCH 002/100] Create FUNDING.yml --- .github/FUNDING.yml | 3 +++ 1 file changed, 3 insertions(+) create mode 100644 .github/FUNDING.yml diff --git a/.github/FUNDING.yml b/.github/FUNDING.yml new file mode 100644 index 00000000..81126791 --- /dev/null +++ b/.github/FUNDING.yml @@ -0,0 +1,3 @@ +# These are supported funding model platforms + +github: [dillonkearns] From 340f9b966c5d409cad03680f717fa8f1f0fff524 Mon Sep 17 00:00:00 2001 From: Dillon Kearns Date: Sun, 4 Oct 2020 20:40:13 -0700 Subject: [PATCH 003/100] Perform one request at a time. --- src/Pages/Internal/Platform/Cli.elm | 26 ++++++++++++++++--- .../Internal/Platform/StaticResponses.elm | 23 ++++++---------- 2 files changed, 30 insertions(+), 19 deletions(-) diff --git a/src/Pages/Internal/Platform/Cli.elm b/src/Pages/Internal/Platform/Cli.elm index e74f2689..eb2c9f70 100644 --- a/src/Pages/Internal/Platform/Cli.elm +++ b/src/Pages/Internal/Platform/Cli.elm @@ -60,6 +60,7 @@ type alias Model = , errors : List BuildError , allRawResponses : Dict String (Maybe String) , mode : Mode + , pendingRequests : List { masked : RequestDetails, unmasked : RequestDetails } } @@ -265,7 +266,7 @@ init toModel contentCache siteMetadata config flags = StaticResponses.init staticHttpCache siteMetadata config [] in StaticResponses.nextStep config siteMetadata mode secrets staticHttpCache [] staticResponses - |> nextStepToEffect (Model staticResponses secrets [] staticHttpCache mode) + |> nextStepToEffect (Model staticResponses secrets [] staticHttpCache mode []) |> Tuple.mapFirst toModel pageErrors -> @@ -296,6 +297,7 @@ init toModel contentCache siteMetadata config flags = pageErrors staticHttpCache mode + [] ) toModel @@ -308,6 +310,7 @@ init toModel contentCache siteMetadata config flags = (metadataParserErrors |> List.map Tuple.second) staticHttpCache mode + [] ) toModel @@ -324,6 +327,7 @@ init toModel contentCache siteMetadata config flags = ] Dict.empty Mode.Dev + [] ) toModel @@ -363,7 +367,11 @@ update siteMetadata config msg model = updatedModel = (case response of Ok okResponse -> - model + { model + | pendingRequests = + model.pendingRequests + |> List.filter (\pending -> pending /= request) + } Err error -> { model @@ -421,8 +429,18 @@ nextStepToEffect : Model -> StaticResponses.NextStep pathKey -> ( Model, Effect nextStepToEffect model nextStep = case nextStep of StaticResponses.Continue updatedAllRawResponses httpRequests -> - ( { model | allRawResponses = updatedAllRawResponses } - , httpRequests + let + nextAndPending = + model.pendingRequests ++ httpRequests + + doNow = + nextAndPending |> List.take 1 + + pending = + nextAndPending |> List.drop 1 + in + ( { model | allRawResponses = updatedAllRawResponses, pendingRequests = pending } + , doNow |> List.map Effect.FetchHttp |> Effect.Batch ) diff --git a/src/Pages/Internal/Platform/StaticResponses.elm b/src/Pages/Internal/Platform/StaticResponses.elm index 3a86f293..182ac92c 100644 --- a/src/Pages/Internal/Platform/StaticResponses.elm +++ b/src/Pages/Internal/Platform/StaticResponses.elm @@ -221,14 +221,12 @@ addEntry globalRawResponses hashedRequest rawResponse ((NotFetched request rawRe realUrls in if includesUrl then - let - updatedRawResponses = - Dict.insert - hashedRequest - rawResponse - rawResponses - in - NotFetched request updatedRawResponses + NotFetched request + (Dict.insert + hashedRequest + rawResponse + rawResponses + ) else entry @@ -253,18 +251,13 @@ encode mode (StaticResponses staticResponses) = Result.withDefault "" ) rawResponsesDict - - strippedResponses : Dict String String - strippedResponses = - -- TODO should this return an Err and handle that here? - StaticHttpRequest.strippedResponses ApplicationType.Cli request relevantResponses in case mode of Mode.Dev -> relevantResponses Mode.Prod -> - strippedResponses + StaticHttpRequest.strippedResponses ApplicationType.Cli request relevantResponses ) @@ -495,7 +488,7 @@ nextStep config siteMetadata mode secrets allRawResponses errors (StaticResponse staticResponses |> Dict.toList |> List.map - (\( path, NotFetched request rawResponses ) -> + (\( path, NotFetched request _ ) -> ( path, request ) ) in From ba228d2c1a1fc725be5d75d47d02943bf9b5d5a3 Mon Sep 17 00:00:00 2001 From: Dillon Kearns Date: Mon, 5 Oct 2020 20:35:15 -0700 Subject: [PATCH 004/100] Tune performance to avoid traverse converting to/from dict repeatedly. --- src/Pages/ContentCache.elm | 5 +- src/Pages/Internal/Platform.elm | 5 +- .../Internal/Platform/StaticResponses.elm | 61 ++++++++++++------- src/Pages/StaticHttp.elm | 23 +++---- src/Pages/StaticHttpRequest.elm | 54 +++++++++++++--- src/RequestsAndPending.elm | 31 ++++++++++ tests/StaticHttpUnitTests.elm | 2 +- 7 files changed, 133 insertions(+), 48 deletions(-) create mode 100644 src/RequestsAndPending.elm diff --git a/src/Pages/ContentCache.elm b/src/Pages/ContentCache.elm index ea748ef0..80c6a92e 100644 --- a/src/Pages/ContentCache.elm +++ b/src/Pages/ContentCache.elm @@ -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 : diff --git a/src/Pages/Internal/Platform.elm b/src/Pages/Internal/Platform.elm index 7e56ebe1..0891d102 100644 --- a/src/Pages/Internal/Platform.elm +++ b/src/Pages/Internal/Platform.elm @@ -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 : diff --git a/src/Pages/Internal/Platform/StaticResponses.elm b/src/Pages/Internal/Platform/StaticResponses.elm index 182ac92c..a38f37f9 100644 --- a/src/Pages/Internal/Platform/StaticResponses.elm +++ b/src/Pages/Internal/Platform/StaticResponses.elm @@ -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 ) diff --git a/src/Pages/StaticHttp.elm b/src/Pages/StaticHttp.elm index ac0ed24b..ecc6d580 100644 --- a/src/Pages/StaticHttp.elm +++ b/src/Pages/StaticHttp.elm @@ -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 diff --git a/src/Pages/StaticHttpRequest.elm b/src/Pages/StaticHttpRequest.elm index da5c6be9..3794d81f 100644 --- a/src/Pages/StaticHttpRequest.elm +++ b/src/Pages/StaticHttpRequest.elm @@ -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, [] ) diff --git a/src/RequestsAndPending.elm b/src/RequestsAndPending.elm new file mode 100644 index 00000000..c3a092a6 --- /dev/null +++ b/src/RequestsAndPending.elm @@ -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) diff --git a/tests/StaticHttpUnitTests.elm b/tests/StaticHttpUnitTests.elm index 6d74add5..781c9272 100644 --- a/tests/StaticHttpUnitTests.elm +++ b/tests/StaticHttpUnitTests.elm @@ -21,7 +21,7 @@ requestsDict requestMap = |> List.map (\( request, response ) -> ( request |> Request.hash - , response + , Just response ) ) |> Dict.fromList From 1a20715be6f60777ed5362be985e378b4c7f0553 Mon Sep 17 00:00:00 2001 From: Dillon Kearns Date: Tue, 6 Oct 2020 21:02:23 -0700 Subject: [PATCH 005/100] Avoid storing stripped requests and instead compute at the last moment. --- src/Pages/Internal/Platform/Cli.elm | 6 +- .../Internal/Platform/StaticResponses.elm | 72 +++---------------- src/Pages/StaticHttp.elm | 43 +++++------ src/Pages/StaticHttpRequest.elm | 17 +++-- tests/StaticHttpRequestsTests.elm | 3 +- 5 files changed, 49 insertions(+), 92 deletions(-) diff --git a/src/Pages/Internal/Platform/Cli.elm b/src/Pages/Internal/Platform/Cli.elm index eb2c9f70..eab23f96 100644 --- a/src/Pages/Internal/Platform/Cli.elm +++ b/src/Pages/Internal/Platform/Cli.elm @@ -103,7 +103,8 @@ type alias Config pathKey userMsg userModel metadata view = -> StaticHttp.Request (List - (Result String + (Result + String { path : List String , content : String } @@ -464,7 +465,8 @@ staticResponseForPage : } ) -> - Result (List BuildError) + Result + (List BuildError) (List ( PagePath pathKey , StaticHttp.Request diff --git a/src/Pages/Internal/Platform/StaticResponses.elm b/src/Pages/Internal/Platform/StaticResponses.elm index a38f37f9..e41bbd21 100644 --- a/src/Pages/Internal/Platform/StaticResponses.elm +++ b/src/Pages/Internal/Platform/StaticResponses.elm @@ -50,7 +50,8 @@ init : -> StaticHttp.Request (List - (Result String + (Result + String { path : List String , content : String } @@ -164,41 +165,7 @@ update newEntry model = in { model | allRawResponses = updatedAllResponses - , staticResponses = - case model.staticResponses of - StaticResponses staticResponses -> - staticResponses - |> Dict.map - (\pageUrl entry -> - case entry of - NotFetched request rawResponses -> - let - realUrls = - updatedAllResponses - |> StaticHttpRequest.resolveUrls ApplicationType.Cli request - |> Tuple.second - |> List.map Secrets.maskedLookup - |> List.map HashRequest.hash - includesUrl = - List.member - (HashRequest.hash newEntry.request.masked) - realUrls - in - if includesUrl then - let - updatedRawResponses = - Dict.insert - (HashRequest.hash newEntry.request.masked) - newEntry.response - rawResponses - in - NotFetched request updatedRawResponses - - else - entry - ) - |> StaticResponses } @@ -234,8 +201,8 @@ addEntry globalRawResponses hashedRequest rawResponse ((NotFetched request rawRe entry -encode : Mode -> StaticResponses -> Dict String (Dict String String) -encode mode (StaticResponses staticResponses) = +encode : RequestsAndPending -> Mode -> StaticResponses -> Dict String (Dict String String) +encode requestsAndPending mode (StaticResponses staticResponses) = staticResponses |> Dict.filter (\key value -> @@ -244,36 +211,16 @@ encode mode (StaticResponses staticResponses) = |> Dict.map (\path result -> 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 - value - |> Result.withDefault "" - |> Just - ) - rawResponsesDict - in + NotFetched request _ -> case mode of Mode.Dev -> - relevantResponses - |> Dict.Extra.filterMap (\key value -> value) + StaticHttpRequest.strippedResponses ApplicationType.Cli request requestsAndPending Mode.Prod -> - StaticHttpRequest.strippedResponses ApplicationType.Cli request relevantResponses - |> Dict.Extra.filterMap (\key value -> value) + StaticHttpRequest.strippedResponses ApplicationType.Cli request requestsAndPending ) -dictCompact : Dict String (Maybe a) -> Dict String a -dictCompact dict = - dict - |> Dict.Extra.filterMap (\key value -> value) - - cliDictKey : String cliDictKey = "////elm-pages-CLI////" @@ -297,7 +244,8 @@ nextStep : -> StaticHttp.Request (List - (Result String + (Result + String { path : List String , content : String } @@ -554,7 +502,7 @@ nextStep config siteMetadata mode secrets allRawResponses errors (StaticResponse else ToJsPayload.toJsPayload - (encode mode (StaticResponses staticResponses)) + (encode allRawResponses mode (StaticResponses staticResponses)) config.manifest generatedOkayFiles allRawResponses diff --git a/src/Pages/StaticHttp.elm b/src/Pages/StaticHttp.elm index ecc6d580..20569f06 100644 --- a/src/Pages/StaticHttp.elm +++ b/src/Pages/StaticHttp.elm @@ -242,7 +242,7 @@ map2 fn request1 request2 = case ( request1, request2 ) of ( Request ( urls1, lookupFn1 ), Request ( urls2, lookupFn2 ) ) -> let - value : ApplicationType -> RequestsAndPending -> Result Pages.StaticHttpRequest.Error ( RequestsAndPending, Request c ) + value : ApplicationType -> RequestsAndPending -> Result Pages.StaticHttpRequest.Error ( Dict String String, Request c ) value appType rawResponses = let value1 = @@ -327,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 : RequestsAndPending -> RequestsAndPending -> RequestsAndPending +combineReducedDicts : Dict String String -> Dict String String -> Dict String String combineReducedDicts dict1 dict2 = (Dict.toList dict1 ++ Dict.toList dict2) |> Dict.Extra.fromListDedupe (\response1 response2 -> - if String.length (response1 |> Maybe.withDefault "") < String.length (response2 |> Maybe.withDefault "") then + if String.length response1 < String.length response2 then response1 else @@ -340,20 +340,26 @@ combineReducedDicts dict1 dict2 = ) -lookup : ApplicationType -> Pages.StaticHttpRequest.Request value -> RequestsAndPending -> Result Pages.StaticHttpRequest.Error ( RequestsAndPending, value ) -lookup appType requestInfo rawResponses = +lookup : ApplicationType -> Pages.StaticHttpRequest.Request value -> RequestsAndPending -> Result Pages.StaticHttpRequest.Error ( Dict String String, value ) +lookup = + lookupHelp Dict.empty + + +lookupHelp : Dict String String -> ApplicationType -> Pages.StaticHttpRequest.Request value -> RequestsAndPending -> Result Pages.StaticHttpRequest.Error ( Dict String String, value ) +lookupHelp strippedSoFar appType requestInfo rawResponses = case requestInfo of Request ( urls, lookupFn ) -> lookupFn appType rawResponses |> Result.andThen (\( strippedResponses, nextRequest ) -> - lookup appType + lookupHelp (Dict.union strippedResponses strippedSoFar) + appType (addUrls urls nextRequest) - strippedResponses + rawResponses ) Done value -> - Ok ( rawResponses, value ) + Ok ( strippedSoFar, value ) addUrls : List (Pages.Secrets.Value HashRequest.Request) -> Pages.StaticHttpRequest.Request value -> Pages.StaticHttpRequest.Request value @@ -441,7 +447,7 @@ succeed value = Request ( [] , \appType rawResponses -> - Ok ( rawResponses, Done value ) + Ok ( Dict.empty, Done value ) ) @@ -601,7 +607,7 @@ unoptimizedRequest requestWithSecrets expect = case maybeResponse of Just rawResponse -> Ok - ( rawResponseDict + ( Dict.singleton (Secrets.maskedLookup requestWithSecrets |> HashRequest.hash) rawResponse , rawResponse ) @@ -641,7 +647,7 @@ unoptimizedRequest requestWithSecrets expect = |> Result.map (\finalRequest -> ( strippedResponses - |> RequestsAndPending.insert + |> Dict.insert (Secrets.maskedLookup requestWithSecrets |> HashRequest.hash) reduced , finalRequest @@ -656,7 +662,7 @@ unoptimizedRequest requestWithSecrets expect = case maybeResponse of Just rawResponse -> Ok - ( rawResponseDict + ( Dict.singleton (Secrets.maskedLookup requestWithSecrets |> HashRequest.hash) rawResponse , rawResponse ) @@ -696,8 +702,7 @@ unoptimizedRequest requestWithSecrets expect = case maybeResponse of Just rawResponse -> Ok - ( rawResponseDict - -- |> Dict.update url (\maybeValue -> Just """{"fake": 123}""") + ( Dict.singleton (Secrets.maskedLookup requestWithSecrets |> HashRequest.hash) rawResponse , rawResponse ) @@ -711,7 +716,6 @@ unoptimizedRequest requestWithSecrets expect = (\( strippedResponses, rawResponse ) -> rawResponse |> Json.Decode.decodeString decoder - -- |> Result.mapError Json.Decode.Exploration.errorsToString |> (\decodeResult -> case decodeResult of Err error -> @@ -727,7 +731,7 @@ unoptimizedRequest requestWithSecrets expect = |> Result.map (\finalRequest -> ( strippedResponses - |> RequestsAndPending.insert + |> Dict.insert (Secrets.maskedLookup requestWithSecrets |> HashRequest.hash) rawResponse , finalRequest @@ -746,8 +750,7 @@ unoptimizedRequest requestWithSecrets expect = case maybeResponse of Just rawResponse -> Ok - ( rawResponseDict - -- |> Dict.update url (\maybeValue -> Just """{"fake": 123}""") + ( Dict.singleton (Secrets.maskedLookup requestWithSecrets |> HashRequest.hash) rawResponse , rawResponse ) @@ -766,9 +769,7 @@ unoptimizedRequest requestWithSecrets expect = |> Result.map (\finalRequest -> ( strippedResponses - |> RequestsAndPending.insert - (Secrets.maskedLookup requestWithSecrets |> HashRequest.hash) - rawResponse + |> Dict.insert (Secrets.maskedLookup requestWithSecrets |> HashRequest.hash) rawResponse , finalRequest ) ) diff --git a/src/Pages/StaticHttpRequest.elm b/src/Pages/StaticHttpRequest.elm index 3794d81f..24f99e8f 100644 --- a/src/Pages/StaticHttpRequest.elm +++ b/src/Pages/StaticHttpRequest.elm @@ -11,23 +11,28 @@ import TerminalText as Terminal type Request value - = Request ( List (Secrets.Value Pages.StaticHttp.Request.Request), ApplicationType -> RequestsAndPending -> Result Error ( Dict String (Maybe String), Request value ) ) + = Request ( List (Secrets.Value Pages.StaticHttp.Request.Request), ApplicationType -> RequestsAndPending -> Result Error ( Dict String String, Request value ) ) | Done value -strippedResponses : ApplicationType -> Request value -> RequestsAndPending -> RequestsAndPending -strippedResponses appType request rawResponses = +strippedResponses : ApplicationType -> Request value -> RequestsAndPending -> Dict String String +strippedResponses = + strippedResponsesHelp Dict.empty + + +strippedResponsesHelp : Dict String String -> ApplicationType -> Request value -> RequestsAndPending -> Dict String String +strippedResponsesHelp usedSoFar appType request rawResponses = case request of Request ( list, lookupFn ) -> case lookupFn appType rawResponses of Err error -> - rawResponses + usedSoFar Ok ( partiallyStrippedResponses, followupRequest ) -> - strippedResponses appType followupRequest partiallyStrippedResponses + strippedResponsesHelp (Dict.union usedSoFar partiallyStrippedResponses) appType followupRequest rawResponses Done value -> - rawResponses + usedSoFar type Error diff --git a/tests/StaticHttpRequestsTests.elm b/tests/StaticHttpRequestsTests.elm index 9874cf54..468518c5 100644 --- a/tests/StaticHttpRequestsTests.elm +++ b/tests/StaticHttpRequestsTests.elm @@ -780,7 +780,8 @@ startWithHttpCache = startLowLevel : StaticHttp.Request (List - (Result String + (Result + String { path : List String , content : String } From 962c397d751371e8ab9a9f0c399d7c9d32ea078a Mon Sep 17 00:00:00 2001 From: Dillon Kearns Date: Wed, 7 Oct 2020 11:06:44 -0700 Subject: [PATCH 006/100] Restore staticResponses update for now to fix some cases. --- src/Pages/Internal/Platform/Cli.elm | 10 ++-- .../Internal/Platform/StaticResponses.elm | 47 +++++++++++++++++-- tests/StaticHttpRequestsTests.elm | 6 ++- 3 files changed, 51 insertions(+), 12 deletions(-) diff --git a/src/Pages/Internal/Platform/Cli.elm b/src/Pages/Internal/Platform/Cli.elm index eab23f96..79799c43 100644 --- a/src/Pages/Internal/Platform/Cli.elm +++ b/src/Pages/Internal/Platform/Cli.elm @@ -103,8 +103,7 @@ type alias Config pathKey userMsg userModel metadata view = -> StaticHttp.Request (List - (Result - String + (Result String { path : List String , content : String } @@ -435,10 +434,10 @@ nextStepToEffect model nextStep = model.pendingRequests ++ httpRequests doNow = - nextAndPending |> List.take 1 + nextAndPending pending = - nextAndPending |> List.drop 1 + [] in ( { model | allRawResponses = updatedAllRawResponses, pendingRequests = pending } , doNow @@ -465,8 +464,7 @@ staticResponseForPage : } ) -> - Result - (List BuildError) + Result (List BuildError) (List ( PagePath pathKey , StaticHttp.Request diff --git a/src/Pages/Internal/Platform/StaticResponses.elm b/src/Pages/Internal/Platform/StaticResponses.elm index e41bbd21..da2a9c13 100644 --- a/src/Pages/Internal/Platform/StaticResponses.elm +++ b/src/Pages/Internal/Platform/StaticResponses.elm @@ -12,6 +12,7 @@ import Pages.StaticHttp as StaticHttp exposing (RequestDetails) import Pages.StaticHttp.Request as HashRequest import Pages.StaticHttpRequest as StaticHttpRequest import RequestsAndPending exposing (RequestsAndPending) +import Result.Extra import Secrets import SecretsDict exposing (SecretsDict) import Set @@ -50,8 +51,7 @@ init : -> StaticHttp.Request (List - (Result - String + (Result String { path : List String , content : String } @@ -165,10 +165,50 @@ update newEntry model = in { model | allRawResponses = updatedAllResponses + , staticResponses = + case model.staticResponses of + StaticResponses staticResponses -> + staticResponses + |> Dict.map + (\pageUrl entry -> + case entry of + NotFetched request rawResponses -> + let + realUrls = + updatedAllResponses + |> StaticHttpRequest.resolveUrls ApplicationType.Cli request + |> Tuple.second + |> List.map Secrets.maskedLookup + |> List.map HashRequest.hash + includesUrl = + List.member + (HashRequest.hash newEntry.request.masked) + realUrls + in + if includesUrl then + let + updatedRawResponses = + Dict.insert + (HashRequest.hash newEntry.request.masked) + newEntry.response + rawResponses + in + NotFetched request updatedRawResponses + + else + entry + ) + |> StaticResponses } +dictCompact : Dict String (Maybe a) -> Dict String a +dictCompact dict = + dict + |> Dict.Extra.filterMap (\key value -> value) + + addEntry : RequestsAndPending -> String @@ -244,8 +284,7 @@ nextStep : -> StaticHttp.Request (List - (Result - String + (Result String { path : List String , content : String } diff --git a/tests/StaticHttpRequestsTests.elm b/tests/StaticHttpRequestsTests.elm index 468518c5..219f1ece 100644 --- a/tests/StaticHttpRequestsTests.elm +++ b/tests/StaticHttpRequestsTests.elm @@ -780,8 +780,7 @@ startWithHttpCache = startLowLevel : StaticHttp.Request (List - (Result - String + (Result String { path : List String , content : String } @@ -955,6 +954,9 @@ expectErrorsPort expectedPlainString actualPorts = actualRichTerminalString |> normalizeErrorExpectEqual expectedPlainString + [] -> + Expect.fail "Expected single error port. Didn't receive any ports." + _ -> Expect.fail <| "Expected single error port. Got\n" ++ String.join "\n\n" (List.map Debug.toString actualPorts) From 560be03e854c5682ed86a77841f2df14d6aa91cc Mon Sep 17 00:00:00 2001 From: Dillon Kearns Date: Wed, 7 Oct 2020 11:45:54 -0700 Subject: [PATCH 007/100] Replace one call to permanent error function. --- .../Internal/Platform/StaticResponses.elm | 12 ++++++---- src/Pages/StaticHttpRequest.elm | 23 +++++++++++++------ 2 files changed, 23 insertions(+), 12 deletions(-) diff --git a/src/Pages/Internal/Platform/StaticResponses.elm b/src/Pages/Internal/Platform/StaticResponses.elm index da2a9c13..01e2b51d 100644 --- a/src/Pages/Internal/Platform/StaticResponses.elm +++ b/src/Pages/Internal/Platform/StaticResponses.elm @@ -452,7 +452,7 @@ nextStep config siteMetadata mode secrets allRawResponses errors (StaticResponse |> List.concatMap (\( path, NotFetched request rawResponses ) -> let - ( status, continuationRequests ) = + staticRequestsStatus = StaticHttpRequest.cacheRequestResolution ApplicationType.Cli request @@ -469,10 +469,12 @@ nextStep config siteMetadata mode secrets allRawResponses errors (StaticResponse ) maybePermanentError = - StaticHttpRequest.permanentError - ApplicationType.Cli - request - usableRawResponses + case staticRequestsStatus of + StaticHttpRequest.HasPermanentError theError -> + Just theError + + _ -> + Nothing decoderErrors = maybePermanentError diff --git a/src/Pages/StaticHttpRequest.elm b/src/Pages/StaticHttpRequest.elm index 24f99e8f..200cf183 100644 --- a/src/Pages/StaticHttpRequest.elm +++ b/src/Pages/StaticHttpRequest.elm @@ -1,4 +1,4 @@ -module Pages.StaticHttpRequest exposing (Error(..), Request(..), cacheRequestResolution, permanentError, resolve, resolveUrls, strippedResponses, toBuildError, urls) +module Pages.StaticHttpRequest exposing (Error(..), Request(..), Status(..), cacheRequestResolution, permanentError, resolve, resolveUrls, strippedResponses, toBuildError, urls) import BuildError exposing (BuildError) import Dict exposing (Dict) @@ -145,14 +145,15 @@ cacheRequestResolution : ApplicationType -> Request value -> RequestsAndPending - -> ( Status value, List (Secrets.Value Pages.StaticHttp.Request.Request) ) + -> Status value cacheRequestResolution = cacheRequestResolutionHelp [] type Status value - = CompleteWithError Error - | Complete value + = Incomplete (List (Secrets.Value Pages.StaticHttp.Request.Request)) + | HasPermanentError Error + | Complete value -- TODO include stripped responses? cacheRequestResolutionHelp : @@ -160,7 +161,7 @@ cacheRequestResolutionHelp : -> ApplicationType -> Request value -> RequestsAndPending - -> ( Status value, List (Secrets.Value Pages.StaticHttp.Request.Request) ) + -> Status value cacheRequestResolutionHelp foundUrls appType request rawResponses = case request of Request ( urlList, lookupFn ) -> @@ -169,7 +170,15 @@ cacheRequestResolutionHelp foundUrls appType request rawResponses = cacheRequestResolutionHelp urlList appType nextRequest rawResponses Err error -> - ( CompleteWithError error, urlList ++ foundUrls ) + case error of + MissingHttpResponse string -> + Incomplete (urlList ++ foundUrls) + + DecoderError string -> + HasPermanentError error + + UserCalledStaticHttpFail string -> + HasPermanentError error Done value -> - ( Complete value, [] ) + Complete value From 0c1e101ebd26f616616f944402c2aaaf9fade594 Mon Sep 17 00:00:00 2001 From: Dillon Kearns Date: Wed, 7 Oct 2020 11:51:35 -0700 Subject: [PATCH 008/100] Replace another instance with single call to static request status. --- .../Internal/Platform/StaticResponses.elm | 45 +++++++------------ 1 file changed, 15 insertions(+), 30 deletions(-) diff --git a/src/Pages/Internal/Platform/StaticResponses.elm b/src/Pages/Internal/Platform/StaticResponses.elm index 01e2b51d..8fc94501 100644 --- a/src/Pages/Internal/Platform/StaticResponses.elm +++ b/src/Pages/Internal/Platform/StaticResponses.elm @@ -387,43 +387,28 @@ nextStep config siteMetadata mode secrets allRawResponses errors (StaticResponse case entry of NotFetched request rawResponses -> let - usableRawResponses : RequestsAndPending - usableRawResponses = - rawResponses - |> Dict.map - (\key value -> - value - |> Result.map Just - |> Result.withDefault Nothing - ) + staticRequestsStatus = + allRawResponses + |> StaticHttpRequest.cacheRequestResolution ApplicationType.Cli request hasPermanentError = - usableRawResponses - |> StaticHttpRequest.permanentError ApplicationType.Cli request - |> isJust + case staticRequestsStatus of + StaticHttpRequest.HasPermanentError _ -> + True + + _ -> + False hasPermanentHttpError = not (List.isEmpty errors) - --|> List.any - -- (\error -> - -- case error of - -- FailedStaticHttpRequestError _ -> - -- True - -- - -- _ -> - -- False - -- ) ( allUrlsKnown, knownUrlsToFetch ) = - StaticHttpRequest.resolveUrls - ApplicationType.Cli - request - (rawResponses - |> Dict.map (\key value -> value |> Result.withDefault "" |> Just) - --|> Dict.union (allRawResponses |> Dict.Extra.filterMap (\_ value -> value)) - --|> Dict.map (\key value -> value) - |> Dict.union allRawResponses - ) + case staticRequestsStatus of + StaticHttpRequest.Incomplete newUrlsToFetch -> + ( False, newUrlsToFetch ) + + _ -> + ( True, [] ) fetchedAllKnownUrls = (rawResponses From 7c32c6683f5093b3307f2344fb22e03db212fb96 Mon Sep 17 00:00:00 2001 From: Dillon Kearns Date: Wed, 7 Oct 2020 12:27:33 -0700 Subject: [PATCH 009/100] Avoid using deprecated individually cached responses per request in one case. --- src/Pages/Internal/Platform/Cli.elm | 6 ++++-- src/Pages/Internal/Platform/StaticResponses.elm | 14 +++++--------- tests/StaticHttpRequestsTests.elm | 11 +++++++++-- 3 files changed, 18 insertions(+), 13 deletions(-) diff --git a/src/Pages/Internal/Platform/Cli.elm b/src/Pages/Internal/Platform/Cli.elm index 79799c43..c18dd0e7 100644 --- a/src/Pages/Internal/Platform/Cli.elm +++ b/src/Pages/Internal/Platform/Cli.elm @@ -103,7 +103,8 @@ type alias Config pathKey userMsg userModel metadata view = -> StaticHttp.Request (List - (Result String + (Result + String { path : List String , content : String } @@ -464,7 +465,8 @@ staticResponseForPage : } ) -> - Result (List BuildError) + Result + (List BuildError) (List ( PagePath pathKey , StaticHttp.Request diff --git a/src/Pages/Internal/Platform/StaticResponses.elm b/src/Pages/Internal/Platform/StaticResponses.elm index 8fc94501..9a287b77 100644 --- a/src/Pages/Internal/Platform/StaticResponses.elm +++ b/src/Pages/Internal/Platform/StaticResponses.elm @@ -51,7 +51,8 @@ init : -> StaticHttp.Request (List - (Result String + (Result + String { path : List String , content : String } @@ -284,7 +285,8 @@ nextStep : -> StaticHttp.Request (List - (Result String + (Result + String { path : List String , content : String } @@ -445,13 +447,7 @@ nextStep config siteMetadata mode secrets allRawResponses errors (StaticResponse usableRawResponses : RequestsAndPending usableRawResponses = - rawResponses - |> Dict.map - (\key value -> - value - |> Result.map Just - |> Result.withDefault Nothing - ) + allRawResponses maybePermanentError = case staticRequestsStatus of diff --git a/tests/StaticHttpRequestsTests.elm b/tests/StaticHttpRequestsTests.elm index 219f1ece..905e0212 100644 --- a/tests/StaticHttpRequestsTests.elm +++ b/tests/StaticHttpRequestsTests.elm @@ -557,7 +557,13 @@ I got an error making an HTTP request to this URL: https://api.github.com/repos/ Bad status: 404 Status message: TODO: if you need this, please report to https://github.com/avh4/elm-program-test/issues -Body: """) +Body: + +-- STATIC HTTP DECODING ERROR ----------------------------------------------------- elm-pages + + + +Payload sent back invalid JSON""") , test "uses real secrets to perform request and masked secrets to store and lookup response" <| \() -> start @@ -780,7 +786,8 @@ startWithHttpCache = startLowLevel : StaticHttp.Request (List - (Result String + (Result + String { path : List String , content : String } From d9735c6dcc962450f308e8d103c56871a3e08d47 Mon Sep 17 00:00:00 2001 From: Dillon Kearns Date: Wed, 7 Oct 2020 12:30:12 -0700 Subject: [PATCH 010/100] Remove extra update with nested loops. --- .../Internal/Platform/StaticResponses.elm | 35 ------------------- 1 file changed, 35 deletions(-) diff --git a/src/Pages/Internal/Platform/StaticResponses.elm b/src/Pages/Internal/Platform/StaticResponses.elm index 9a287b77..d12d378c 100644 --- a/src/Pages/Internal/Platform/StaticResponses.elm +++ b/src/Pages/Internal/Platform/StaticResponses.elm @@ -166,41 +166,6 @@ update newEntry model = in { model | allRawResponses = updatedAllResponses - , staticResponses = - case model.staticResponses of - StaticResponses staticResponses -> - staticResponses - |> Dict.map - (\pageUrl entry -> - case entry of - NotFetched request rawResponses -> - let - realUrls = - updatedAllResponses - |> StaticHttpRequest.resolveUrls ApplicationType.Cli request - |> Tuple.second - |> List.map Secrets.maskedLookup - |> List.map HashRequest.hash - - includesUrl = - List.member - (HashRequest.hash newEntry.request.masked) - realUrls - in - if includesUrl then - let - updatedRawResponses = - Dict.insert - (HashRequest.hash newEntry.request.masked) - newEntry.response - rawResponses - in - NotFetched request updatedRawResponses - - else - entry - ) - |> StaticResponses } From f7cd75bbc60a3b3a3516cc1d6c3f0a4e3e20aab1 Mon Sep 17 00:00:00 2001 From: Dillon Kearns Date: Wed, 7 Oct 2020 12:34:02 -0700 Subject: [PATCH 011/100] Remove some more unnecessary calls. --- .../Internal/Platform/StaticResponses.elm | 38 +------------------ 1 file changed, 1 insertion(+), 37 deletions(-) diff --git a/src/Pages/Internal/Platform/StaticResponses.elm b/src/Pages/Internal/Platform/StaticResponses.elm index d12d378c..d19222dc 100644 --- a/src/Pages/Internal/Platform/StaticResponses.elm +++ b/src/Pages/Internal/Platform/StaticResponses.elm @@ -124,10 +124,6 @@ init staticHttpCache siteMetadataResult config list = Just justResponse -> entrySoFar - |> addEntry - staticHttpCache - hashedRequest - (Ok justResponse) ) entry in @@ -175,38 +171,6 @@ dictCompact dict = |> Dict.Extra.filterMap (\key value -> value) -addEntry : - RequestsAndPending - -> String - -> Result () String - -> StaticHttpResult - -> StaticHttpResult -addEntry globalRawResponses hashedRequest rawResponse ((NotFetched request rawResponses) as entry) = - let - realUrls = - globalRawResponses - |> StaticHttpRequest.resolveUrls ApplicationType.Cli request - |> Tuple.second - |> List.map Secrets.maskedLookup - |> List.map HashRequest.hash - - includesUrl = - List.member - hashedRequest - realUrls - in - if includesUrl then - NotFetched request - (Dict.insert - hashedRequest - rawResponse - rawResponses - ) - - else - entry - - encode : RequestsAndPending -> Mode -> StaticResponses -> Dict String (Dict String String) encode requestsAndPending mode (StaticResponses staticResponses) = staticResponses @@ -402,7 +366,7 @@ nextStep config siteMetadata mode secrets allRawResponses errors (StaticResponse staticResponses |> Dict.toList |> List.concatMap - (\( path, NotFetched request rawResponses ) -> + (\( path, NotFetched request _ ) -> let staticRequestsStatus = StaticHttpRequest.cacheRequestResolution From e9aa52b4a0482e8b8e76cccd8147f0fb979c7da7 Mon Sep 17 00:00:00 2001 From: Dillon Kearns Date: Wed, 7 Oct 2020 12:34:27 -0700 Subject: [PATCH 012/100] Simplify some code. --- src/Pages/Internal/Platform/StaticResponses.elm | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/src/Pages/Internal/Platform/StaticResponses.elm b/src/Pages/Internal/Platform/StaticResponses.elm index d19222dc..7d3f43b9 100644 --- a/src/Pages/Internal/Platform/StaticResponses.elm +++ b/src/Pages/Internal/Platform/StaticResponses.elm @@ -114,16 +114,12 @@ init staticHttpCache siteMetadataResult config list = entry = NotFetched (staticRequest |> StaticHttp.map (\_ -> ())) Dict.empty + -- TODO don't update entry here, just use the plain entry with empty (or no) Dict updatedEntry = staticHttpCache |> Dict.foldl (\hashedRequest response entrySoFar -> - case response of - Nothing -> - entrySoFar - - Just justResponse -> - entrySoFar + entrySoFar ) entry in From 9055fa118723ce9b14c0105e3a9540f75e5a44b4 Mon Sep 17 00:00:00 2001 From: Dillon Kearns Date: Wed, 7 Oct 2020 12:36:03 -0700 Subject: [PATCH 013/100] Remove unnecessary loop. --- src/Pages/Internal/Platform/StaticResponses.elm | 11 +---------- 1 file changed, 1 insertion(+), 10 deletions(-) diff --git a/src/Pages/Internal/Platform/StaticResponses.elm b/src/Pages/Internal/Platform/StaticResponses.elm index 7d3f43b9..532b5e4f 100644 --- a/src/Pages/Internal/Platform/StaticResponses.elm +++ b/src/Pages/Internal/Platform/StaticResponses.elm @@ -113,18 +113,9 @@ init staticHttpCache siteMetadataResult config list = let entry = NotFetched (staticRequest |> StaticHttp.map (\_ -> ())) Dict.empty - - -- TODO don't update entry here, just use the plain entry with empty (or no) Dict - updatedEntry = - staticHttpCache - |> Dict.foldl - (\hashedRequest response entrySoFar -> - entrySoFar - ) - entry in ( PagePath.toString path - , updatedEntry + , entry ) ) |> List.append [ generateFilesStaticRequest ] From e327d7a25daae20c75b865a58168e3db48a5df91 Mon Sep 17 00:00:00 2001 From: Dillon Kearns Date: Thu, 8 Oct 2020 19:49:05 -0700 Subject: [PATCH 014/100] Add simple example code. --- examples/simple/content/index.md | 7 + examples/simple/elm.json | 61 + examples/simple/gen/Pages.elm | 117 + examples/simple/images/icon-png.png | Bin 0 -> 976 bytes examples/simple/index.js | 7 + examples/simple/lib/native-shim.js | 49 + examples/simple/package.json | 21 + examples/simple/src/Data/Author.elm | 48 + examples/simple/src/DocSidebar.elm | 70 + examples/simple/src/DocumentSvg.elm | 91 + examples/simple/src/Dotted.elm | 54 + examples/simple/src/Ellie.elm | 20 + examples/simple/src/Feed.elm | 76 + examples/simple/src/FontAwesome.elm | 18 + examples/simple/src/Index.elm | 116 + examples/simple/src/Main.elm | 173 + examples/simple/src/MarkdownRenderer.elm | 317 ++ examples/simple/src/Metadata.elm | 49 + examples/simple/src/MySitemap.elm | 34 + examples/simple/src/Palette.elm | 44 + examples/simple/src/RssPlugin.elm | 56 + examples/simple/src/Showcase.elm | 161 + examples/simple/static/admin/config.yml | 46 + examples/simple/static/admin/index.html | 13 + examples/simple/style.css | 40 + examples/simple/syntax.css | 43 + examples/simple/vendor/elm-ui/Element.elm | 1691 ++++++++ .../vendor/elm-ui/Element/Background.elm | 226 ++ .../simple/vendor/elm-ui/Element/Border.elm | 281 ++ .../simple/vendor/elm-ui/Element/Events.elm | 265 ++ .../simple/vendor/elm-ui/Element/Font.elm | 525 +++ .../simple/vendor/elm-ui/Element/Input.elm | 2232 +++++++++++ .../simple/vendor/elm-ui/Element/Keyed.elm | 70 + .../simple/vendor/elm-ui/Element/Lazy.elm | 117 + .../simple/vendor/elm-ui/Element/Region.elm | 107 + .../simple/vendor/elm-ui/Internal/Flag.elm | 325 ++ .../simple/vendor/elm-ui/Internal/Grid.elm | 270 ++ .../simple/vendor/elm-ui/Internal/Model.elm | 3544 +++++++++++++++++ .../simple/vendor/elm-ui/Internal/Style.elm | 1772 +++++++++ 39 files changed, 13156 insertions(+) create mode 100644 examples/simple/content/index.md create mode 100644 examples/simple/elm.json create mode 100644 examples/simple/gen/Pages.elm create mode 100644 examples/simple/images/icon-png.png create mode 100644 examples/simple/index.js create mode 100644 examples/simple/lib/native-shim.js create mode 100644 examples/simple/package.json create mode 100644 examples/simple/src/Data/Author.elm create mode 100644 examples/simple/src/DocSidebar.elm create mode 100644 examples/simple/src/DocumentSvg.elm create mode 100644 examples/simple/src/Dotted.elm create mode 100644 examples/simple/src/Ellie.elm create mode 100644 examples/simple/src/Feed.elm create mode 100644 examples/simple/src/FontAwesome.elm create mode 100644 examples/simple/src/Index.elm create mode 100644 examples/simple/src/Main.elm create mode 100644 examples/simple/src/MarkdownRenderer.elm create mode 100644 examples/simple/src/Metadata.elm create mode 100644 examples/simple/src/MySitemap.elm create mode 100644 examples/simple/src/Palette.elm create mode 100644 examples/simple/src/RssPlugin.elm create mode 100644 examples/simple/src/Showcase.elm create mode 100644 examples/simple/static/admin/config.yml create mode 100644 examples/simple/static/admin/index.html create mode 100644 examples/simple/style.css create mode 100644 examples/simple/syntax.css create mode 100644 examples/simple/vendor/elm-ui/Element.elm create mode 100644 examples/simple/vendor/elm-ui/Element/Background.elm create mode 100644 examples/simple/vendor/elm-ui/Element/Border.elm create mode 100644 examples/simple/vendor/elm-ui/Element/Events.elm create mode 100644 examples/simple/vendor/elm-ui/Element/Font.elm create mode 100644 examples/simple/vendor/elm-ui/Element/Input.elm create mode 100644 examples/simple/vendor/elm-ui/Element/Keyed.elm create mode 100644 examples/simple/vendor/elm-ui/Element/Lazy.elm create mode 100644 examples/simple/vendor/elm-ui/Element/Region.elm create mode 100644 examples/simple/vendor/elm-ui/Internal/Flag.elm create mode 100644 examples/simple/vendor/elm-ui/Internal/Grid.elm create mode 100644 examples/simple/vendor/elm-ui/Internal/Model.elm create mode 100644 examples/simple/vendor/elm-ui/Internal/Style.elm diff --git a/examples/simple/content/index.md b/examples/simple/content/index.md new file mode 100644 index 00000000..1a3f7ddd --- /dev/null +++ b/examples/simple/content/index.md @@ -0,0 +1,7 @@ +--- +title: elm-pages - a statically typed site generator +type: page +--- + +Hello! + diff --git a/examples/simple/elm.json b/examples/simple/elm.json new file mode 100644 index 00000000..b6a472ff --- /dev/null +++ b/examples/simple/elm.json @@ -0,0 +1,61 @@ +{ + "type": "application", + "source-directories": [ + "src", + "../../src", + "vendor/elm-ui", + "gen" + ], + "elm-version": "0.19.1", + "dependencies": { + "direct": { + "avh4/elm-color": "1.0.0", + "billstclair/elm-xml-eeue56": "1.0.1", + "dillonkearns/elm-markdown": "4.0.2", + "dillonkearns/elm-oembed": "1.0.0", + "dillonkearns/elm-rss": "1.0.1", + "dillonkearns/elm-sitemap": "1.0.1", + "dmy/elm-imf-date-time": "1.0.1", + "elm/browser": "1.0.2", + "elm/core": "1.0.5", + "elm/html": "1.0.0", + "elm/http": "2.0.0", + "elm/json": "1.1.3", + "elm/parser": "1.1.0", + "elm/svg": "1.0.1", + "elm/time": "1.0.0", + "elm/url": "1.0.0", + "elm/virtual-dom": "1.0.2", + "elm-community/dict-extra": "2.4.0", + "elm-community/list-extra": "8.2.4", + "elm-community/result-extra": "2.4.0", + "elm-community/string-extra": "4.0.1", + "elm-explorations/markdown": "1.0.0", + "justinmimbs/date": "3.2.0", + "lukewestby/elm-string-interpolate": "1.0.4", + "miniBill/elm-codec": "1.2.0", + "noahzgordon/elm-color-extra": "1.0.2", + "pablohirafuji/elm-syntax-highlight": "3.3.0", + "rtfeldman/elm-hex": "1.0.0", + "tripokey/elm-fuzzy": "5.2.1", + "zwilias/json-decode-exploration": "6.0.0" + }, + "indirect": { + "elm/bytes": "1.0.8", + "elm/file": "1.0.5", + "elm/random": "1.0.0", + "elm/regex": "1.0.0", + "fredcy/elm-parseint": "2.0.1", + "justinmimbs/time-extra": "1.1.0", + "lazamar/dict-parser": "1.0.2", + "mgold/elm-nonempty-list": "4.1.0", + "ryannhg/date-format": "2.3.0" + } + }, + "test-dependencies": { + "direct": { + "elm-explorations/test": "1.2.2" + }, + "indirect": {} + } +} \ No newline at end of file diff --git a/examples/simple/gen/Pages.elm b/examples/simple/gen/Pages.elm new file mode 100644 index 00000000..be36b40d --- /dev/null +++ b/examples/simple/gen/Pages.elm @@ -0,0 +1,117 @@ +port module Pages exposing (PathKey, allPages, allImages, internals, images, isValidRoute, pages, builtAt) + +import Color exposing (Color) +import Pages.Internal +import Head +import Html exposing (Html) +import Json.Decode +import Json.Encode +import Pages.Platform +import Pages.Manifest exposing (DisplayMode, Orientation) +import Pages.Manifest.Category as Category exposing (Category) +import Url.Parser as Url exposing ((), s) +import Pages.ImagePath as ImagePath exposing (ImagePath) +import Pages.PagePath as PagePath exposing (PagePath) +import Pages.Directory as Directory exposing (Directory) +import Time + + +builtAt : Time.Posix +builtAt = + Time.millisToPosix 1602211703927 + + +type PathKey + = PathKey + + +buildImage : List String -> ImagePath.Dimensions -> ImagePath PathKey +buildImage path dimensions = + ImagePath.build PathKey ("images" :: path) dimensions + + +buildPage : List String -> PagePath PathKey +buildPage path = + PagePath.build PathKey path + + +directoryWithIndex : List String -> Directory PathKey Directory.WithIndex +directoryWithIndex path = + Directory.withIndex PathKey allPages path + + +directoryWithoutIndex : List String -> Directory PathKey Directory.WithoutIndex +directoryWithoutIndex path = + Directory.withoutIndex PathKey allPages path + + +port toJsPort : Json.Encode.Value -> Cmd msg + +port fromJsPort : (Json.Decode.Value -> msg) -> Sub msg + + +internals : Pages.Internal.Internal PathKey +internals = + { applicationType = Pages.Internal.Browser + , toJsPort = toJsPort + , fromJsPort = fromJsPort identity + , content = content + , pathKey = PathKey + } + + + + +allPages : List (PagePath PathKey) +allPages = + [ (buildPage [ ]) + ] + +pages = + { index = (buildPage [ ]) + , directory = directoryWithIndex [] + } + +images = + { iconPng = (buildImage [ "icon-png.png" ] { width = 50, height = 75 }) + , directory = directoryWithoutIndex [] + } + + +allImages : List (ImagePath PathKey) +allImages = + [(buildImage [ "icon-png.png" ] { width = 50, height = 75 }) + ] + + +isValidRoute : String -> Result String () +isValidRoute route = + let + validRoutes = + List.map PagePath.toString allPages + in + if + (route |> String.startsWith "http://") + || (route |> String.startsWith "https://") + || (route |> String.startsWith "#") + || (validRoutes |> List.member route) + then + Ok () + + else + ("Valid routes:\n" + ++ String.join "\n\n" validRoutes + ) + |> Err + + +content : List ( List String, { extension: String, frontMatter : String, body : Maybe String } ) +content = + [ + ( [] + , { frontMatter = "{\"title\":\"elm-pages - a statically typed site generator\",\"type\":\"page\"}" + , body = Nothing + , extension = "md" + } ) + + ] diff --git a/examples/simple/images/icon-png.png b/examples/simple/images/icon-png.png new file mode 100644 index 0000000000000000000000000000000000000000..1e514b4bdb55f895dd68bc1d7d43a0af92c57119 GIT binary patch literal 976 zcmV;>126oEP)U*Ls*iFe)z5v?GWmQwtk*E+56q7V@_ncnrOm=p5%+9Xv zIwR+W!!Ym6!2D)+=Xstz2W;80Rj4Q(WytbP zZrgxV4eQt@4jvT2Y~s8LDZU^IJ?igT?0<3GE@oU-*QIL%zrBY>NV;Vkrni{m8|mFc2Lko**8~r6ZAH;tK*WltV5bhJkKB%+)ZM zc!K~8^&wXdL16)Ay9?8iED#UomxDo=YkrtyfB+2lA-^4fLRTnEazFrvmm59AhJUOy%i1Ym6+j4k)}oK&ONn`igYf1U*; z0ZT5B&DPrV-fq;f!;o=W%GEFkubyL`+y<>91_gm#+hJuPULdmJds6GiK+jd@3Mpdd z-nbbwE?NOD?Bu{7$SK(VnHm31+gF&#DZ853zDpAJdeD1 zgq|2LKY}RJ3Y}?4r$BVbabHgv$aTSqZ=qA#;C`P!#N3-`*^`y;Mqyo{^&qlw7pZld zF~#ZX>>=7`-z#~Q4OxX5>2J#RH@5e-W^;iqq!db~~iLH7W2 z_h##KWNf58I-6|A5l7FDU=T65vS@rM2G80t_yznx=lLryVFC8etUdR{AX&(UQcH#J+a yO}LBvKZmc@ Decode.andThen + (\lookupName -> + case List.Extra.find (\currentAuthor -> currentAuthor.name == lookupName) all of + Just author -> + Decode.succeed author + + Nothing -> + Decode.fail ("Couldn't find author with name " ++ lookupName ++ ". Options are " ++ String.join ", " (List.map .name all)) + ) + + +view : List (Element.Attribute msg) -> Author -> Element msg +view attributes author = + Element.image + (Element.width (Element.px 70) + :: Element.htmlAttribute (Attr.class "avatar") + :: attributes + ) + { src = ImagePath.toString author.avatar, description = author.name } diff --git a/examples/simple/src/DocSidebar.elm b/examples/simple/src/DocSidebar.elm new file mode 100644 index 00000000..8eb136ff --- /dev/null +++ b/examples/simple/src/DocSidebar.elm @@ -0,0 +1,70 @@ +module DocSidebar exposing (view) + +import Element exposing (Element) +import Element.Border as Border +import Element.Font +import Metadata exposing (Metadata) +import Pages +import Pages.PagePath as PagePath exposing (PagePath) +import Palette + + +view : + PagePath Pages.PathKey + -> List ( PagePath Pages.PathKey, Metadata ) + -> Element msg +view currentPage posts = + Element.column + [ Element.spacing 10 + , Border.widthEach { bottom = 0, left = 0, right = 1, top = 0 } + , Border.color (Element.rgba255 40 80 40 0.4) + , Element.padding 12 + , Element.height Element.fill + ] + (posts + |> List.filterMap + (\( path, metadata ) -> + case metadata of + Metadata.Doc meta -> + Just ( currentPage == path, path, meta ) + + _ -> + Nothing + ) + |> List.map postSummary + ) + + +postSummary : + ( Bool, PagePath Pages.PathKey, { title : String } ) + -> Element msg +postSummary ( isCurrentPage, postPath, post ) = + [ Element.text post.title ] + |> Element.paragraph + ([ Element.Font.size 18 + , Element.Font.family [ Element.Font.typeface "Roboto" ] + , Element.Font.semiBold + , Element.padding 16 + ] + ++ (if isCurrentPage then + [ Element.Font.underline + , Element.Font.color Palette.color.primary + ] + + else + [] + ) + ) + |> linkToPost postPath + + +linkToPost : PagePath Pages.PathKey -> Element msg -> Element msg +linkToPost postPath content = + Element.link [ Element.width Element.fill ] + { url = PagePath.toString postPath, label = content } + + +docUrl : List String -> String +docUrl postPath = + "/" + ++ String.join "/" postPath diff --git a/examples/simple/src/DocumentSvg.elm b/examples/simple/src/DocumentSvg.elm new file mode 100644 index 00000000..9766ed19 --- /dev/null +++ b/examples/simple/src/DocumentSvg.elm @@ -0,0 +1,91 @@ +module DocumentSvg exposing (view) + +import Color +import Element exposing (Element) +import Svg exposing (..) +import Svg.Attributes exposing (..) + + +strokeColor = + -- "url(#grad1)" + "black" + + +pageTextColor = + "black" + + +fillColor = + "url(#grad1)" + + + +-- "none" + + +fillGradient = + gradient + (Color.rgb255 5 117 230) + (Color.rgb255 0 242 96) + + + +-- (Color.rgb255 252 0 255) +-- (Color.rgb255 0 219 222) +-- (Color.rgb255 255 93 194) +-- (Color.rgb255 255 150 250) + + +gradient color1 color2 = + linearGradient [ id "grad1", x1 "0%", y1 "0%", x2 "100%", y2 "0%" ] + [ stop + [ offset "10%" + , Svg.Attributes.style ("stop-color:" ++ Color.toCssString color1 ++ ";stop-opacity:1") + ] + [] + , stop [ offset "100%", Svg.Attributes.style ("stop-color:" ++ Color.toCssString color2 ++ ";stop-opacity:1") ] [] + ] + + +view : Element msg +view = + svg + [ version "1.1" + , viewBox "251.0485 144.52063 56.114286 74.5" + , width "56.114286" + , height "74.5" + , Svg.Attributes.width "30px" + ] + [ defs [] + [ fillGradient ] + , metadata [] [] + , g + [ id "Canvas_11" + , stroke "none" + , fill fillColor + , strokeOpacity "1" + , fillOpacity "1" + , strokeDasharray "none" + ] + [ g [ id "Canvas_11: Layer 1" ] + [ g [ id "Group_38" ] + [ g [ id "Graphic_32" ] + [ Svg.path + [ d "M 252.5485 146.02063 L 252.5485 217.52063 L 305.66277 217.52063 L 305.66277 161.68254 L 290.00087 146.02063 Z" + , stroke strokeColor + , strokeLinecap "round" + , strokeLinejoin "round" + , strokeWidth "3" + ] + [] + ] + , g [ id "Line_34" ] [ line [ x1 "266.07286", y1 "182.8279", x2 "290.75465", y2 "183.00997", stroke pageTextColor, strokeLinecap "round", strokeLinejoin "round", strokeWidth "2" ] [] ] + , g [ id "Line_35" ] [ line [ x1 "266.07286", y1 "191.84156", x2 "290.75465", y2 "192.02363", stroke pageTextColor, strokeLinecap "round", strokeLinejoin "round", strokeWidth "2" ] [] ] + , g [ id "Line_36" ] [ line [ x1 "266.07286", y1 "200.85522", x2 "290.75465", y2 "201.0373", stroke pageTextColor, strokeLinecap "round", strokeLinejoin "round", strokeWidth "2" ] [] ] + , g [ id "Line_37" ] [ line [ x1 "266.07286", y1 "164.80058", x2 "278.3874", y2 "164.94049", stroke pageTextColor, strokeLinecap "round", strokeLinejoin "round", strokeWidth "2" ] [] ] + ] + ] + ] + ] + |> Element.html + |> Element.el [] diff --git a/examples/simple/src/Dotted.elm b/examples/simple/src/Dotted.elm new file mode 100644 index 00000000..10b69ae0 --- /dev/null +++ b/examples/simple/src/Dotted.elm @@ -0,0 +1,54 @@ +module Dotted exposing (lines) + +import Element +import Svg +import Svg.Attributes as Attr + + + +{- + .css-m2heu9 { + stroke: #8a4baf; + stroke-width: 3; + stroke-linecap: round; + stroke-dasharray: 0.5 10; + -webkit-animation: animation-yweh2o 400ms linear infinite; + animation: animation-yweh2o 400ms linear infinite; + } +-} +{- + + + +-} + + +lines = + Svg.svg + [ Attr.width "20" + , Attr.height "30" + , Attr.viewBox "0 0 20 30" + ] + [ Svg.path + [ Attr.stroke "#2a75ff" + , Attr.strokeWidth "4" + , Attr.strokeLinecap "round" + , Attr.strokeDasharray "0.5 10" + , Attr.d "M10 40 L10 -10" + , Attr.class "dotted-line" + ] + [] + ] + |> Element.html + |> Element.el + [ Element.centerX + ] + + + +-- rgb(0, 36, 71) +-- #002447 +{- + + .css-m2heu9{stroke:#8a4baf;stroke-width:3;stroke-linecap:round;stroke-dasharray:0.5 10;-webkit-animation:animation-yweh2o 400ms linear infinite;animation:animation-yweh2o 400ms linear infinite;}@-webkit-keyframes animation-yweh2o{to{stroke-dashoffset:10;}}@keyframes animation-yweh2o{to{stroke-dashoffset:10;}} +-} diff --git a/examples/simple/src/Ellie.elm b/examples/simple/src/Ellie.elm new file mode 100644 index 00000000..311f3b0a --- /dev/null +++ b/examples/simple/src/Ellie.elm @@ -0,0 +1,20 @@ +module Ellie exposing (outputTab) + +import Element exposing (Element) +import Html +import Html.Attributes as Attr + + +outputTab : String -> Element msg +outputTab ellieId = + Html.iframe + [ Attr.src <| "https://ellie-app.com/embed/" ++ ellieId ++ "?panel=output" + , Attr.style "width" "100%" + , Attr.style "height" "400px" + , Attr.style "border" "0" + , Attr.style "overflow" "hidden" + , Attr.attribute "sandbox" "allow-modals allow-forms allow-popups allow-scripts allow-same-origin" + ] + [] + |> Element.html + |> Element.el [ Element.width Element.fill ] diff --git a/examples/simple/src/Feed.elm b/examples/simple/src/Feed.elm new file mode 100644 index 00000000..dbc1f7b2 --- /dev/null +++ b/examples/simple/src/Feed.elm @@ -0,0 +1,76 @@ +module Feed exposing (fileToGenerate) + +import Metadata exposing (Metadata(..)) +import Pages +import Pages.PagePath as PagePath exposing (PagePath) +import Rss + + +fileToGenerate : + { siteTagline : String + , siteUrl : String + } + -> + List + { path : PagePath Pages.PathKey + , frontmatter : Metadata + , body : String + } + -> + { path : List String + , content : String + } +fileToGenerate config siteMetadata = + { path = [ "blog", "feed.xml" ] + , content = generate config siteMetadata + } + + +generate : + { siteTagline : String + , siteUrl : String + } + -> + List + { path : PagePath Pages.PathKey + , frontmatter : Metadata + , body : String + } + -> String +generate { siteTagline, siteUrl } siteMetadata = + Rss.generate + { title = "elm-pages Blog" + , description = siteTagline + , url = "https://elm-pages.com/blog" + , lastBuildTime = Pages.builtAt + , generator = Just "elm-pages" + , items = siteMetadata |> List.filterMap metadataToRssItem + , siteUrl = siteUrl + } + + +metadataToRssItem : + { path : PagePath Pages.PathKey + , frontmatter : Metadata + , body : String + } + -> Maybe Rss.Item +metadataToRssItem page = + case page.frontmatter of + Article article -> + if article.draft then + Nothing + + else + Just + { title = article.title + , description = article.description + , url = PagePath.toString page.path + , categories = [] + , author = article.author.name + , pubDate = Rss.Date article.published + , content = Nothing + } + + _ -> + Nothing diff --git a/examples/simple/src/FontAwesome.elm b/examples/simple/src/FontAwesome.elm new file mode 100644 index 00000000..a8150b77 --- /dev/null +++ b/examples/simple/src/FontAwesome.elm @@ -0,0 +1,18 @@ +module FontAwesome exposing (icon, styledIcon) + +import Element exposing (Element) +import Html +import Html.Attributes + + +styledIcon : String -> List (Element.Attribute msg) -> Element msg +styledIcon classString styles = + Html.i [ Html.Attributes.class classString ] [] + |> Element.html + |> Element.el styles + + +icon : String -> Element msg +icon classString = + Html.i [ Html.Attributes.class classString ] [] + |> Element.html diff --git a/examples/simple/src/Index.elm b/examples/simple/src/Index.elm new file mode 100644 index 00000000..1862542a --- /dev/null +++ b/examples/simple/src/Index.elm @@ -0,0 +1,116 @@ +module Index exposing (view) + +import Data.Author +import Date +import Element exposing (Element) +import Element.Border +import Element.Font +import Metadata exposing (Metadata) +import Pages +import Pages.ImagePath as ImagePath exposing (ImagePath) +import Pages.PagePath as PagePath exposing (PagePath) +import Pages.Platform exposing (Page) + + +view : + List ( PagePath Pages.PathKey, Metadata ) + -> Element msg +view posts = + Element.column [ Element.spacing 20 ] + (posts + |> List.filterMap + (\( path, metadata ) -> + case metadata of + Metadata.Article meta -> + if meta.draft then + Nothing + + else + Just ( path, meta ) + + _ -> + Nothing + ) + |> List.sortBy + (\( path, metadata ) -> + metadata.published + |> Date.toRataDie + ) + |> List.reverse + |> List.map postSummary + ) + + +postSummary : + ( PagePath Pages.PathKey, Metadata.ArticleMetadata ) + -> Element msg +postSummary ( postPath, post ) = + articleIndex post |> linkToPost postPath + + +linkToPost : PagePath Pages.PathKey -> Element msg -> Element msg +linkToPost postPath content = + Element.link [ Element.width Element.fill ] + { url = PagePath.toString postPath, label = content } + + +title : String -> Element msg +title text = + [ Element.text text ] + |> Element.paragraph + [ Element.Font.size 36 + , Element.Font.center + , Element.Font.family [ Element.Font.typeface "Montserrat" ] + , Element.Font.semiBold + , Element.padding 16 + ] + + +articleIndex : Metadata.ArticleMetadata -> Element msg +articleIndex metadata = + Element.el + [ Element.centerX + , Element.width (Element.maximum 600 Element.fill) + , Element.padding 40 + , Element.spacing 10 + , Element.Border.width 1 + , Element.Border.color (Element.rgba255 0 0 0 0.1) + , Element.mouseOver + [ Element.Border.color (Element.rgba255 0 0 0 1) + ] + ] + (postPreview metadata) + + +grey = + Element.Font.color (Element.rgba255 0 0 0 0.5) + + +postPreview : Metadata.ArticleMetadata -> Element msg +postPreview post = + Element.textColumn + [ Element.centerX + , Element.width Element.fill + , Element.spacing 30 + , Element.Font.size 18 + ] + [ title post.title + , Element.image [ Element.width Element.fill ] { src = post.image |> ImagePath.toString, description = "Blog post cover photo" } + , Element.row + [ Element.spacing 10 + , Element.centerX + , grey + ] + [ Data.Author.view [ Element.width (Element.px 40) ] post.author + , Element.text post.author.name + , Element.text "•" + , Element.text (post.published |> Date.format "MMMM ddd, yyyy") + ] + , post.description + |> Element.text + |> List.singleton + |> Element.paragraph + [ Element.Font.size 22 + , Element.Font.center + ] + ] diff --git a/examples/simple/src/Main.elm b/examples/simple/src/Main.elm new file mode 100644 index 00000000..78a082a9 --- /dev/null +++ b/examples/simple/src/Main.elm @@ -0,0 +1,173 @@ +module Main exposing (main) + +import Color +import Element exposing (Element) +import Element.Font as Font +import Head +import Head.Seo as Seo +import Html exposing (Html) +import MarkdownRenderer +import Metadata exposing (Metadata) +import Pages exposing (images, pages) +import Pages.Manifest as Manifest +import Pages.Manifest.Category +import Pages.PagePath exposing (PagePath) +import Pages.Platform exposing (Page) +import Pages.StaticHttp as StaticHttp + + +manifest : Manifest.Config Pages.PathKey +manifest = + { backgroundColor = Just Color.white + , categories = [ Pages.Manifest.Category.education ] + , displayMode = Manifest.Standalone + , orientation = Manifest.Portrait + , description = "elm-pages - A statically typed site generator." + , iarcRatingId = Nothing + , name = "elm-pages docs" + , themeColor = Just Color.white + , startUrl = pages.index + , shortName = Just "elm-pages" + , sourceIcon = images.iconPng + } + + +type alias View = + ( MarkdownRenderer.TableOfContents, List (Element Msg) ) + + +main : Pages.Platform.Program Model Msg Metadata View +main = + Pages.Platform.init + { init = init + , view = view + , update = update + , subscriptions = subscriptions + , documents = + [ { extension = "md" + , metadata = Metadata.decoder + , body = MarkdownRenderer.view + } + ] + , onPageChange = Nothing + , manifest = manifest + , canonicalSiteUrl = canonicalSiteUrl + , internals = Pages.internals + } + |> Pages.Platform.toProgram + + +type alias Model = + { showMobileMenu : Bool + } + + +init : + Maybe + { path : PagePath Pages.PathKey + , query : Maybe String + , fragment : Maybe String + } + -> ( Model, Cmd Msg ) +init maybePagePath = + ( Model False, Cmd.none ) + + +type Msg + = OnPageChange + { path : PagePath Pages.PathKey + , query : Maybe String + , fragment : Maybe String + } + | ToggleMobileMenu + + +update : Msg -> Model -> ( Model, Cmd Msg ) +update msg model = + case msg of + OnPageChange page -> + ( { model | showMobileMenu = False }, Cmd.none ) + + ToggleMobileMenu -> + ( { model | showMobileMenu = not model.showMobileMenu }, Cmd.none ) + + +subscriptions : Model -> Sub Msg +subscriptions _ = + Sub.none + + +view : + List ( PagePath Pages.PathKey, Metadata ) + -> + { path : PagePath Pages.PathKey + , frontmatter : Metadata + } + -> + StaticHttp.Request + { view : Model -> View -> { title : String, body : Html Msg } + , head : List (Head.Tag Pages.PathKey) + } +view siteMetadata page = + case page.frontmatter of + Metadata.Page meta -> + StaticHttp.succeed + { view = + \_ _ -> + { title = "Title" + , body = Html.text "Hello from the view!" + } + , head = head page.path page.frontmatter + } + + +{-| + + + +-} +head : PagePath Pages.PathKey -> Metadata -> List (Head.Tag Pages.PathKey) +head currentPath metadata = + case metadata of + Metadata.Page meta -> + Seo.summary + { canonicalUrlOverride = Nothing + , siteName = "elm-pages" + , image = + { url = images.iconPng + , alt = "elm-pages logo" + , dimensions = Nothing + , mimeType = Nothing + } + , description = siteTagline + , locale = Nothing + , title = meta.title + } + |> Seo.website + + +canonicalSiteUrl : String +canonicalSiteUrl = + "https://elm-pages.com" + + +siteTagline : String +siteTagline = + "A statically typed site generator - elm-pages" + + +tocView : MarkdownRenderer.TableOfContents -> Element msg +tocView toc = + Element.column [ Element.alignTop, Element.spacing 20 ] + [ Element.el [ Font.bold, Font.size 22 ] (Element.text "Table of Contents") + , Element.column [ Element.spacing 10 ] + (toc + |> List.map + (\heading -> + Element.link [ Font.color (Element.rgb255 100 100 100) ] + { url = "#" ++ heading.anchorId + , label = Element.text heading.name + } + ) + ) + ] diff --git a/examples/simple/src/MarkdownRenderer.elm b/examples/simple/src/MarkdownRenderer.elm new file mode 100644 index 00000000..25bf2b13 --- /dev/null +++ b/examples/simple/src/MarkdownRenderer.elm @@ -0,0 +1,317 @@ +module MarkdownRenderer exposing (TableOfContents, view) + +import Dotted +import Element exposing (Element) +import Element.Background +import Element.Border +import Element.Font as Font +import Element.Input +import Element.Region +import Ellie +import Html exposing (Attribute, Html) +import Html.Attributes exposing (property) +import Json.Encode as Encode exposing (Value) +import Markdown.Block as Block exposing (Block, Inline, ListItem(..), Task(..)) +import Markdown.Html +import Markdown.Parser +import Markdown.Renderer +import Oembed +import Palette +import SyntaxHighlight + + +buildToc : List Block.Block -> TableOfContents +buildToc blocks = + let + headings = + gatherHeadings blocks + in + headings + |> List.map Tuple.second + |> List.map + (\styledList -> + { anchorId = styledToString styledList |> rawTextToId + , name = styledToString styledList + , level = 1 + } + ) + + +type alias TableOfContents = + List { anchorId : String, name : String, level : Int } + + +view : String -> Result String ( TableOfContents, List (Element msg) ) +view markdown = + case + markdown + |> Markdown.Parser.parse + of + Ok okAst -> + case Markdown.Renderer.render renderer okAst of + Ok rendered -> + Ok ( buildToc okAst, rendered ) + + Err errors -> + Err errors + + Err error -> + Err (error |> List.map Markdown.Parser.deadEndToString |> String.join "\n") + + +renderer : Markdown.Renderer.Renderer (Element msg) +renderer = + { heading = heading + , paragraph = + Element.paragraph + [ Element.spacing 15 ] + , thematicBreak = Element.none + , text = \value -> Element.paragraph [] [ Element.text value ] + , strong = \content -> Element.paragraph [ Font.bold ] content + , emphasis = \content -> Element.paragraph [ Font.italic ] content + , codeSpan = code + , link = + \{ title, destination } body -> + Element.newTabLink [] + { url = destination + , label = + Element.paragraph + [ Font.color (Element.rgb255 0 0 255) + , Element.htmlAttribute (Html.Attributes.style "overflow-wrap" "break-word") + , Element.htmlAttribute (Html.Attributes.style "word-break" "break-word") + ] + body + } + , hardLineBreak = Html.br [] [] |> Element.html + , image = + \image -> + case image.title of + Just title -> + Element.image [ Element.width Element.fill ] { src = image.src, description = image.alt } + + Nothing -> + Element.image [ Element.width Element.fill ] { src = image.src, description = image.alt } + , blockQuote = + \children -> + Element.column + [ Element.Border.widthEach { top = 0, right = 0, bottom = 0, left = 10 } + , Element.padding 10 + , Element.Border.color (Element.rgb255 145 145 145) + , Element.Background.color (Element.rgb255 245 245 245) + ] + children + , unorderedList = + \items -> + Element.column [ Element.spacing 15 ] + (items + |> List.map + (\(ListItem task children) -> + Element.paragraph [ Element.spacing 5 ] + [ Element.row + [ Element.alignTop ] + ((case task of + IncompleteTask -> + Element.Input.defaultCheckbox False + + CompletedTask -> + Element.Input.defaultCheckbox True + + NoTask -> + Element.text "•" + ) + :: Element.text " " + :: children + ) + ] + ) + ) + , orderedList = + \startingIndex items -> + Element.column [ Element.spacing 15 ] + (items + |> List.indexedMap + (\index itemBlocks -> + Element.row [ Element.spacing 5 ] + [ Element.row [ Element.alignTop ] + (Element.text (String.fromInt (index + startingIndex) ++ " ") :: itemBlocks) + ] + ) + ) + , codeBlock = codeBlock + , table = Element.column [] + , tableHeader = Element.column [] + , tableBody = Element.column [] + , tableRow = Element.row [] + , tableHeaderCell = + \maybeAlignment children -> + Element.paragraph [] children + , tableCell = Element.paragraph [] + , html = + Markdown.Html.oneOf + [ Markdown.Html.tag "banner" + (\children -> + Element.paragraph + [ Font.center + , Font.size 47 + , Font.family [ Font.typeface "Montserrat" ] + , Font.color Palette.color.primary + ] + children + ) + , Markdown.Html.tag "boxes" + (\children -> + children + |> List.indexedMap + (\index aBox -> + let + isLast = + index == (List.length children - 1) + in + [ Just aBox + , if isLast then + Nothing + + else + Just Dotted.lines + ] + |> List.filterMap identity + ) + |> List.concat + |> List.reverse + |> Element.column [ Element.centerX ] + ) + , Markdown.Html.tag "box" + (\children -> + Element.textColumn + [ Element.centerX + , Font.center + , Element.padding 30 + , Element.Border.shadow { offset = ( 2, 2 ), size = 3, blur = 3, color = Element.rgba255 40 80 80 0.1 } + , Element.spacing 15 + ] + children + ) + , Markdown.Html.tag "values" + (\children -> + Element.row + [ Element.spacing 30 + , Element.htmlAttribute (Html.Attributes.style "flex-wrap" "wrap") + ] + children + ) + , Markdown.Html.tag "value" + (\children -> + Element.column + [ Element.width Element.fill + , Element.padding 20 + , Element.spacing 20 + , Element.height Element.fill + , Element.centerX + ] + children + ) + , Markdown.Html.tag "oembed" + (\url children -> + Oembed.view [] Nothing url + |> Maybe.map Element.html + |> Maybe.withDefault Element.none + |> Element.el [ Element.centerX ] + ) + |> Markdown.Html.withAttribute "url" + , Markdown.Html.tag "ellie-output" + (\ellieId children -> + -- Oembed.view [] Nothing url + -- |> Maybe.map Element.html + -- |> Maybe.withDefault Element.none + -- |> Element.el [ Element.centerX ] + Ellie.outputTab ellieId + ) + |> Markdown.Html.withAttribute "id" + ] + } + + +styledToString : List Inline -> String +styledToString inlines = + --List.map .string list + --|> String.join "-" + -- TODO do I need to hyphenate? + inlines + |> Block.extractInlineText + + +gatherHeadings : List Block -> List ( Block.HeadingLevel, List Inline ) +gatherHeadings blocks = + List.filterMap + (\block -> + case block of + Block.Heading level content -> + Just ( level, content ) + + _ -> + Nothing + ) + blocks + + +rawTextToId : String -> String +rawTextToId rawText = + rawText + |> String.split " " + |> String.join "-" + |> String.toLower + + +heading : { level : Block.HeadingLevel, rawText : String, children : List (Element msg) } -> Element msg +heading { level, rawText, children } = + Element.paragraph + [ Font.size + (case level of + Block.H1 -> + 36 + + Block.H2 -> + 24 + + _ -> + 20 + ) + , Font.bold + , Font.family [ Font.typeface "Montserrat" ] + , Element.Region.heading (Block.headingLevelToInt level) + , Element.htmlAttribute + (Html.Attributes.attribute "name" (rawTextToId rawText)) + , Element.htmlAttribute + (Html.Attributes.id (rawTextToId rawText)) + ] + children + + +code : String -> Element msg +code snippet = + Element.el + [ Element.Background.color + (Element.rgba255 50 50 50 0.07) + , Element.Border.rounded 2 + , Element.paddingXY 5 3 + , Font.family [ Font.typeface "Roboto Mono", Font.monospace ] + ] + (Element.text snippet) + + +codeBlock : { body : String, language : Maybe String } -> Element msg +codeBlock details = + SyntaxHighlight.elm details.body + |> Result.map (SyntaxHighlight.toBlockHtml (Just 1)) + |> Result.withDefault + (Html.pre [] [ Html.code [] [ Html.text details.body ] ]) + |> Element.html + |> Element.el [ Element.width Element.fill ] + + +editorValue : String -> Attribute msg +editorValue value = + value + |> String.trim + |> Encode.string + |> property "editorValue" diff --git a/examples/simple/src/Metadata.elm b/examples/simple/src/Metadata.elm new file mode 100644 index 00000000..3f24e893 --- /dev/null +++ b/examples/simple/src/Metadata.elm @@ -0,0 +1,49 @@ +module Metadata exposing (Metadata(..), PageMetadata, decoder) + +import Json.Decode as Decode exposing (Decoder) +import List.Extra +import Pages +import Pages.ImagePath as ImagePath exposing (ImagePath) + + +type Metadata + = Page PageMetadata + + +type alias PageMetadata = + { title : String } + + +decoder = + Decode.field "type" Decode.string + |> Decode.andThen + (\pageType -> + case pageType of + "page" -> + Decode.field "title" Decode.string + |> Decode.map (\title -> Page { title = title }) + + _ -> + Decode.fail <| "Unexpected page \"type\" " ++ pageType + ) + + +imageDecoder : Decoder (ImagePath Pages.PathKey) +imageDecoder = + Decode.string + |> Decode.andThen + (\imageAssetPath -> + case findMatchingImage imageAssetPath of + Nothing -> + Decode.fail "Couldn't find image." + + Just imagePath -> + Decode.succeed imagePath + ) + + +findMatchingImage : String -> Maybe (ImagePath Pages.PathKey) +findMatchingImage imageAssetPath = + List.Extra.find + (\image -> ImagePath.toString image == imageAssetPath) + Pages.allImages diff --git a/examples/simple/src/MySitemap.elm b/examples/simple/src/MySitemap.elm new file mode 100644 index 00000000..398432e6 --- /dev/null +++ b/examples/simple/src/MySitemap.elm @@ -0,0 +1,34 @@ +module MySitemap exposing (install) + +import Head +import Pages.PagePath as PagePath exposing (PagePath) +import Pages.Platform exposing (Builder) +import Pages.StaticHttp as StaticHttp +import Sitemap + + +install : + { siteUrl : String + } + -> + (List + { path : PagePath pathKey + , frontmatter : metadata + , body : String + } + -> List { path : String, lastMod : Maybe String } + ) + -> Builder pathKey userModel userMsg metadata view + -> Builder pathKey userModel userMsg metadata view +install config toSitemapEntry builder = + builder + |> Pages.Platform.withGlobalHeadTags [ Head.sitemapLink "/sitemap.xml" ] + |> Pages.Platform.withFileGenerator + (\siteMetadata -> + StaticHttp.succeed + [ Ok + { path = [ "sitemap.xml" ] + , content = Sitemap.build config (toSitemapEntry siteMetadata) + } + ] + ) diff --git a/examples/simple/src/Palette.elm b/examples/simple/src/Palette.elm new file mode 100644 index 00000000..221f8b8f --- /dev/null +++ b/examples/simple/src/Palette.elm @@ -0,0 +1,44 @@ +module Palette exposing (blogHeading, color, heading) + +import Element exposing (Element) +import Element.Font as Font +import Element.Region + + +color = + { primary = Element.rgb255 0 6 255 + , secondary = Element.rgb255 0 242 96 + } + + +heading : Int -> List (Element msg) -> Element msg +heading level content = + Element.paragraph + ([ Font.bold + , Font.family [ Font.typeface "Montserrat" ] + , Element.Region.heading level + ] + ++ (case level of + 1 -> + [ Font.size 36 ] + + 2 -> + [ Font.size 24 ] + + _ -> + [ Font.size 20 ] + ) + ) + content + + +blogHeading : String -> Element msg +blogHeading title = + Element.paragraph + [ Font.bold + , Font.family [ Font.typeface "Montserrat" ] + , Element.Region.heading 1 + , Font.size 36 + , Font.center + ] + [ Element.text title ] diff --git a/examples/simple/src/RssPlugin.elm b/examples/simple/src/RssPlugin.elm new file mode 100644 index 00000000..2537b483 --- /dev/null +++ b/examples/simple/src/RssPlugin.elm @@ -0,0 +1,56 @@ +module RssPlugin exposing (generate) + +import Head +import Pages.PagePath as PagePath exposing (PagePath) +import Pages.Platform exposing (Builder) +import Pages.StaticHttp as StaticHttp +import Rss +import Time + + +generate : + { siteTagline : String + , siteUrl : String + , title : String + , builtAt : Time.Posix + , indexPage : PagePath pathKey + } + -> + ({ path : PagePath pathKey + , frontmatter : metadata + , body : String + } + -> Maybe Rss.Item + ) + -> Builder pathKey userModel userMsg metadata view + -> Builder pathKey userModel userMsg metadata view +generate options metadataToRssItem builder = + let + feedFilePath = + (options.indexPage + |> PagePath.toPath + ) + ++ [ "feed.xml" ] + in + builder + |> Pages.Platform.withFileGenerator + (\siteMetadata -> + { path = feedFilePath + , content = + Rss.generate + { title = options.title + , description = options.siteTagline + + -- TODO make sure you don't add an extra "/" + , url = options.siteUrl ++ "/" ++ PagePath.toString options.indexPage + , lastBuildTime = options.builtAt + , generator = Just "elm-pages" + , items = siteMetadata |> List.filterMap metadataToRssItem + , siteUrl = options.siteUrl + } + } + |> Ok + |> List.singleton + |> StaticHttp.succeed + ) + |> Pages.Platform.withGlobalHeadTags [ Head.rssLink (feedFilePath |> String.join "/") ] diff --git a/examples/simple/src/Showcase.elm b/examples/simple/src/Showcase.elm new file mode 100644 index 00000000..ef56c545 --- /dev/null +++ b/examples/simple/src/Showcase.elm @@ -0,0 +1,161 @@ +module Showcase exposing (..) + +import Element +import Element.Border +import Element.Font +import FontAwesome +import OptimizedDecoder as Decode +import Pages.Secrets as Secrets +import Pages.StaticHttp as StaticHttp +import Palette +import Url.Builder + + +view : List Entry -> Element.Element msg +view entries = + Element.column + [ Element.spacing 30 + ] + (submitShowcaseItemButton + :: List.map entryView entries + ) + + +submitShowcaseItemButton = + Element.newTabLink + [ Element.Font.color Palette.color.primary + , Element.Font.underline + ] + { url = "https://airtable.com/shrPSenIW2EQqJ083" + , label = Element.text "Submit your site to the showcase" + } + + +entryView : Entry -> Element.Element msg +entryView entry = + Element.column + [ Element.spacing 15 + , Element.Border.shadow { offset = ( 2, 2 ), size = 3, blur = 3, color = Element.rgba255 40 80 80 0.1 } + , Element.padding 40 + , Element.width (Element.maximum 700 Element.fill) + ] + [ Element.newTabLink [ Element.Font.size 14, Element.Font.color Palette.color.primary ] + { url = entry.liveUrl + , label = + Element.image [ Element.width Element.fill ] + { src = "https://image.thum.io/get/width/800/crop/800/" ++ entry.screenshotUrl + , description = "Site Screenshot" + } + } + , Element.text entry.displayName |> Element.el [ Element.Font.extraBold ] + , Element.newTabLink [ Element.Font.size 14, Element.Font.color Palette.color.primary ] + { url = entry.liveUrl + , label = Element.text entry.liveUrl + } + , Element.paragraph [ Element.Font.size 14 ] + [ Element.text "By " + , Element.newTabLink [ Element.Font.color Palette.color.primary ] + { url = entry.authorUrl + , label = Element.text entry.authorName + } + ] + , Element.row [ Element.width Element.fill ] + [ categoriesView entry.categories + , Element.row [ Element.alignRight ] + [ case entry.repoUrl of + Just repoUrl -> + Element.newTabLink [] + { url = repoUrl + , label = FontAwesome.icon "fas fa-code-branch" + } + + Nothing -> + Element.none + ] + ] + ] + + +categoriesView : List String -> Element.Element msg +categoriesView categories = + categories + |> List.map + (\category -> + Element.text category + ) + |> Element.wrappedRow + [ Element.spacing 7 + , Element.Font.size 14 + , Element.Font.color (Element.rgba255 0 0 0 0.6) + , Element.width (Element.fillPortion 8) + ] + + +type alias Entry = + { screenshotUrl : String + , displayName : String + , liveUrl : String + , authorName : String + , authorUrl : String + , categories : List String + , repoUrl : Maybe String + } + + +decoder : Decode.Decoder (List Entry) +decoder = + Decode.field "records" <| + Decode.list entryDecoder + + +entryDecoder : Decode.Decoder Entry +entryDecoder = + Decode.field "fields" <| + Decode.map7 Entry + (Decode.field "Screenshot URL" Decode.string) + (Decode.field "Site Display Name" Decode.string) + (Decode.field "Live URL" Decode.string) + (Decode.field "Author" Decode.string) + (Decode.field "Author URL" Decode.string) + (Decode.field "Categories" (Decode.list Decode.string)) + (Decode.maybe (Decode.field "Repository URL" Decode.string)) + + +staticRequest : StaticHttp.Request (List Entry) +staticRequest = + StaticHttp.request + (Secrets.succeed + (\airtableToken -> + { url = "https://api.airtable.com/v0/appDykQzbkQJAidjt/elm-pages%20showcase?maxRecords=100&view=Grid%202" + , method = "GET" + , headers = [ ( "Authorization", "Bearer " ++ airtableToken ), ( "view", "viwayJBsr63qRd7q3" ) ] + , body = StaticHttp.emptyBody + } + ) + |> Secrets.with "AIRTABLE_TOKEN" + ) + decoder + + +allCategroies : List String +allCategroies = + [ "Documentation" + , "eCommerce" + , "Conference" + , "Consulting" + , "Education" + , "Entertainment" + , "Event" + , "Food" + , "Freelance" + , "Gallery" + , "Landing Page" + , "Music" + , "Nonprofit" + , "Podcast" + , "Portfolio" + , "Programming" + , "Sports" + , "Travel" + , "Blog" + ] diff --git a/examples/simple/static/admin/config.yml b/examples/simple/static/admin/config.yml new file mode 100644 index 00000000..6bbbd909 --- /dev/null +++ b/examples/simple/static/admin/config.yml @@ -0,0 +1,46 @@ +backend: + name: git-gateway + +media_folder: "examples/docs/images" # Folder where user uploaded files should go +public_folder: "examples/docs/images" +publish_mode: "editorial_workflow" # see https://www.netlifycms.org/docs/open-authoring/ + +collections: # A list of collections the CMS should be able to edit + - name: "post" # Used in routes, ie.: /admin/collections/:slug/edit + label: "Post" # Used in the UI, ie.: "New Post" + folder: "examples/docs/content/blog" # The path to the folder where the documents are stored + filter: {field: "type", value: "blog"} + create: true # Allow users to create new documents in this collection + fields: # The fields each document in this collection have + - { label: "Title", name: "title", widget: "string" } + - { label: "Publish Date", name: "published", widget: "date" } + - { label: "Intro Blurb", name: "description", widget: "text" } + - { label: "Image", name: "image", widget: "image", required: true } + - label: "Author" + name: "author" + widget: "select" + options: ["Dillon Kearns"] + default: "Dillon Kearns" + - { label: "Body", name: "body", widget: "markdown" } + - { + label: "Type", + name: "type", + widget: "hidden", + default: "blog", + required: false, + } + - name: "docs" # Used in routes, ie.: /admin/collections/:slug/edit + label: "Docs" # Used in the UI, ie.: "New Post" + folder: "examples/docs/content/docs" # The path to the folder where the documents are stored + filter: {field: "type", value: "doc"} + create: true # Allow users to create new documents in this collection + fields: # The fields each document in this collection have + - { label: "Title", name: "title", widget: "string" } + - { label: "Body", name: "body", widget: "markdown" } + - { + label: "Type", + name: "type", + widget: "hidden", + default: "doc", + required: false, + } diff --git a/examples/simple/static/admin/index.html b/examples/simple/static/admin/index.html new file mode 100644 index 00000000..d69251a0 --- /dev/null +++ b/examples/simple/static/admin/index.html @@ -0,0 +1,13 @@ + + + + + + Content Manager + + + + + + + diff --git a/examples/simple/style.css b/examples/simple/style.css new file mode 100644 index 00000000..b94a2d6b --- /dev/null +++ b/examples/simple/style.css @@ -0,0 +1,40 @@ +@import url("https://fonts.googleapis.com/css?family=Montserrat:400,700|Roboto|Roboto+Mono&display=swap"); +@import url("https://use.fontawesome.com/releases/v5.9.0/css/all.css"); + +.dotted-line { + -webkit-animation: animation-yweh2o 400ms linear infinite; + animation: animation-yweh2o 400ms linear infinite; +} +@-webkit-keyframes animation-yweh2o { + to { + stroke-dashoffset: 10; + } +} +@keyframes animation-yweh2o { + to { + stroke-dashoffset: 10; + } +} + +.avatar img { + border-radius: 50%; +} +@media all and (max-width: 600px) { + .navbar-title { + font-size: 20px !important; + } + .navbar-title svg { + width: 20px; + } +} + +@media (max-width: 600px) { + .responsive-desktop { + display: none !important; + } +} +@media (min-width: 600px) { + .responsive-mobile { + display: none !important; + } +} diff --git a/examples/simple/syntax.css b/examples/simple/syntax.css new file mode 100644 index 00000000..2c58cea3 --- /dev/null +++ b/examples/simple/syntax.css @@ -0,0 +1,43 @@ +pre.elmsh { + padding: 10px; + margin: 0; + text-align: left; + overflow: auto; + padding: 20px !important; +} + +code.elmsh { + padding: 0; +} + +code { + font-family: 'Roboto Mono' !important; + font-size: 20px !important; + line-height: 28px; +} + +.elmsh-line:before { + /* content: attr(data-elmsh-lc); */ + display: inline-block; + text-align: right; + width: 40px; + padding: 0 20px 0 0; + opacity: 0.3; +} + +.elmsh { + color: #f8f8f2; + background: #000; +} +.elmsh-hl {background: #343434;} +.elmsh-add {background: #003800;} +.elmsh-del {background: #380000;} +.elmsh-comm {color: #75715e;} +.elmsh1 {color: #ae81ff;} +.elmsh2 {color: #e6db74;} +.elmsh3 {color: #66d9ef;} +.elmsh4 {color: #f92672;} +.elmsh5 {color: #a6e22e;} +.elmsh6 {color: #ae81ff;} +.elmsh7 {color: #fd971f;} + diff --git a/examples/simple/vendor/elm-ui/Element.elm b/examples/simple/vendor/elm-ui/Element.elm new file mode 100644 index 00000000..693dc41b --- /dev/null +++ b/examples/simple/vendor/elm-ui/Element.elm @@ -0,0 +1,1691 @@ +module Element exposing + ( Element, none, text, el + , row, wrappedRow, column + , paragraph, textColumn + , Column, table, IndexedColumn, indexedTable + , Attribute, width, height, Length, px, shrink, fill, fillPortion, maximum, minimum + , explain + , padding, paddingXY, paddingEach + , spacing, spacingXY, spaceEvenly + , centerX, centerY, alignLeft, alignRight, alignTop, alignBottom + , transparent, alpha, pointer + , moveUp, moveDown, moveRight, moveLeft, rotate, scale + , clip, clipX, clipY + , scrollbars, scrollbarX, scrollbarY + , layout, layoutWith, Option, noStaticStyleSheet, forceHover, noHover, focusStyle, FocusStyle + , link, newTabLink, download, downloadAs + , image + , Color, rgba, rgb, rgb255, rgba255, fromRgb, fromRgb255, toRgb + , above, below, onRight, onLeft, inFront, behindContent + , Attr, Decoration, mouseOver, mouseDown, focused + , Device, DeviceClass(..), Orientation(..), classifyDevice + , modular + , map, mapAttribute + , html, htmlAttribute + ) + +{-| + + +# Basic Elements + +@docs Element, none, text, el + + +# Rows and Columns + +When we want more than one child on an element, we want to be _specific_ about how they will be laid out. + +So, the common ways to do that would be `row` and `column`. + +@docs row, wrappedRow, column + + +# Text Layout + +Text layout needs some specific considerations. + +@docs paragraph, textColumn + + +# Data Table + +@docs Column, table, IndexedColumn, indexedTable + + +# Size + +@docs Attribute, width, height, Length, px, shrink, fill, fillPortion, maximum, minimum + + +# Debugging + +@docs explain + + +# Padding and Spacing + +There's no concept of margin in `elm-ui`, instead we have padding and spacing. + +Padding is the distance between the outer edge and the content, and spacing is the space between children. + +So, if we have the following row, with some padding and spacing. + + Element.row [ padding 10, spacing 7 ] + [ Element.el [] none + , Element.el [] none + , Element.el [] none + ] + +Here's what we can expect: + +![Three boxes spaced 7 pixels apart. There's a 10 pixel distance from the edge of the parent to the boxes.](https://mdgriffith.gitbooks.io/style-elements/content/assets/spacing-400.png) + +**Note** `spacing` set on a `paragraph`, will set the pixel spacing between lines. + +@docs padding, paddingXY, paddingEach + +@docs spacing, spacingXY, spaceEvenly + + +# Alignment + +Alignment can be used to align an `Element` within another `Element`. + + Element.el [ centerX, alignTop ] (text "I'm centered and aligned top!") + +If alignment is set on elements in a layout such as `row`, then the element will push the other elements in that direction. Here's an example. + + Element.row [] + [ Element.el [] Element.none + , Element.el [ alignLeft ] Element.none + , Element.el [ centerX ] Element.none + , Element.el [ alignRight ] Element.none + ] + +will result in a layout like + + |-|-| |-| |-| + +Where there are two elements on the left, one on the right, and one in the center of the space between the elements on the left and right. + +**Note** For text alignment, check out `Element.Font`! + +@docs centerX, centerY, alignLeft, alignRight, alignTop, alignBottom + + +# Transparency + +@docs transparent, alpha, pointer + + +# Adjustment + +@docs moveUp, moveDown, moveRight, moveLeft, rotate, scale + + +# Clipping and Scrollbars + +Clip the content if it overflows. + +@docs clip, clipX, clipY + +Add a scrollbar if the content is larger than the element. + +@docs scrollbars, scrollbarX, scrollbarY + + +# Rendering + +@docs layout, layoutWith, Option, noStaticStyleSheet, forceHover, noHover, focusStyle, FocusStyle + + +# Links + +@docs link, newTabLink, download, downloadAs + + +# Images + +@docs image + + +# Color + +In order to use attributes like `Font.color` and `Background.color`, you'll need to make some colors! + +@docs Color, rgba, rgb, rgb255, rgba255, fromRgb, fromRgb255, toRgb + + +# Nearby Elements + +Let's say we want a dropdown menu. Essentially we want to say: _put this element below this other element, but don't affect the layout when you do_. + + Element.row [] + [ Element.el + [ Element.below (Element.text "I'm below!") + ] + (Element.text "I'm normal!") + ] + +This will result in + + |- I'm normal! -| + I'm below + +Where `"I'm Below"` doesn't change the size of `Element.row`. + +This is very useful for things like dropdown menus or tooltips. + +@docs above, below, onRight, onLeft, inFront, behindContent + + +# Temporary Styling + +@docs Attr, Decoration, mouseOver, mouseDown, focused + + +# Responsiveness + +The main technique for responsiveness is to store window size information in your model. + +Install the `Browser` package, and set up a subscription for [`Browser.Events.onResize`](https://package.elm-lang.org/packages/elm/browser/latest/Browser-Events#onResize). + +You'll also need to retrieve the initial window size. You can either use [`Browser.Dom.getViewport`](https://package.elm-lang.org/packages/elm/browser/latest/Browser-Dom#getViewport) or pass in `window.innerWidth` and `window.innerHeight` as flags to your program, which is the preferred way. This requires minor setup on the JS side, but allows you to avoid the state where you don't have window info. + +@docs Device, DeviceClass, Orientation, classifyDevice + + +# Scaling + +@docs modular + + +## Mapping + +@docs map, mapAttribute + + +## Compatibility + +@docs html, htmlAttribute + +-} + +import Html exposing (Html) +import Html.Attributes +import Internal.Flag as Flag exposing (Flag) +import Internal.Model as Internal +import Internal.Style exposing (classes) + + +{-| -} +type alias Color = + Internal.Color + + +{-| Provide the red, green, and blue channels for the color. + +Each channel takes a value between 0 and 1. + +-} +rgb : Float -> Float -> Float -> Color +rgb r g b = + Internal.Rgba r g b 1 + + +{-| -} +rgba : Float -> Float -> Float -> Float -> Color +rgba = + Internal.Rgba + + +{-| Provide the red, green, and blue channels for the color. + +Each channel takes a value between 0 and 255. + +-} +rgb255 : Int -> Int -> Int -> Color +rgb255 red green blue = + Internal.Rgba + (toFloat red / 255) + (toFloat green / 255) + (toFloat blue / 255) + 1 + + +{-| -} +rgba255 : Int -> Int -> Int -> Float -> Color +rgba255 red green blue a = + Internal.Rgba + (toFloat red / 255) + (toFloat green / 255) + (toFloat blue / 255) + a + + +{-| Create a color from an RGB record. +-} +fromRgb : + { red : Float + , green : Float + , blue : Float + , alpha : Float + } + -> Color +fromRgb clr = + Internal.Rgba + clr.red + clr.green + clr.blue + clr.alpha + + +{-| -} +fromRgb255 : + { red : Int + , green : Int + , blue : Int + , alpha : Float + } + -> Color +fromRgb255 clr = + Internal.Rgba + (toFloat clr.red / 255) + (toFloat clr.green / 255) + (toFloat clr.blue / 255) + clr.alpha + + +{-| Deconstruct a `Color` into its rgb channels. +-} +toRgb : + Color + -> + { red : Float + , green : Float + , blue : Float + , alpha : Float + } +toRgb (Internal.Rgba r g b a) = + { red = r + , green = g + , blue = b + , alpha = a + } + + +{-| The basic building block of your layout. + + howdy : Element msg + howdy = + Element.el [] (Element.text "Howdy!") + +-} +type alias Element msg = + Internal.Element msg + + +{-| An attribute that can be attached to an `Element` +-} +type alias Attribute msg = + Internal.Attribute () msg + + +{-| This is a special attribute that counts as both a `Attribute msg` and a `Decoration`. +-} +type alias Attr decorative msg = + Internal.Attribute decorative msg + + +{-| Only decorations +-} +type alias Decoration = + Internal.Attribute Never Never + + +{-| -} +html : Html msg -> Element msg +html = + Internal.unstyled + + +{-| -} +htmlAttribute : Html.Attribute msg -> Attribute msg +htmlAttribute = + Internal.Attr + + +{-| -} +map : (msg -> msg1) -> Element msg -> Element msg1 +map = + Internal.map + + +{-| -} +mapAttribute : (msg -> msg1) -> Attribute msg -> Attribute msg1 +mapAttribute = + Internal.mapAttr + + +{-| -} +type alias Length = + Internal.Length + + +{-| -} +px : Int -> Length +px = + Internal.Px + + +{-| Shrink an element to fit its contents. +-} +shrink : Length +shrink = + Internal.Content + + +{-| Fill the available space. The available space will be split evenly between elements that have `width fill`. +-} +fill : Length +fill = + Internal.Fill 1 + + +{-| Similarly you can set a minimum boundary. + + el + [ height + (fill + |> maximum 300 + |> minimum 30 + ) + + ] + (text "I will stop at 300px") + +-} +minimum : Int -> Length -> Length +minimum i l = + Internal.Min i l + + +{-| Add a maximum to a length. + + el + [ height + (fill + |> maximum 300 + ) + ] + (text "I will stop at 300px") + +-} +maximum : Int -> Length -> Length +maximum i l = + Internal.Max i l + + +{-| Sometimes you may not want to split available space evenly. In this case you can use `fillPortion` to define which elements should have what portion of the available space. + +So, two elements, one with `width (fillPortion 2)` and one with `width (fillPortion 3)`. The first would get 2 portions of the available space, while the second would get 3. + +**Also:** `fill == fillPortion 1` + +-} +fillPortion : Int -> Length +fillPortion = + Internal.Fill + + +{-| This is your top level node where you can turn `Element` into `Html`. +-} +layout : List (Attribute msg) -> Element msg -> Html msg +layout = + layoutWith { options = [] } + + +{-| -} +layoutWith : { options : List Option } -> List (Attribute msg) -> Element msg -> Html msg +layoutWith { options } attrs child = + Internal.renderRoot options + (Internal.htmlClass + (String.join " " + [ classes.root + , classes.any + , classes.single + ] + ) + :: (Internal.rootStyle ++ attrs) + ) + child + + +{-| -} +type alias Option = + Internal.Option + + +{-| Elm UI embeds two StyleSheets, one that is constant, and one that changes dynamically based on styles collected from the elements being rendered. + +This option will stop the static/constant stylesheet from rendering. + +If you're embedding multiple elm-ui `layout` elements, you need to guarantee that only one is rendering the static style sheet and that it's above all the others in the DOM tree. + +-} +noStaticStyleSheet : Option +noStaticStyleSheet = + Internal.RenderModeOption Internal.NoStaticStyleSheet + + +{-| -} +defaultFocus : + { borderColor : Maybe Color + , backgroundColor : Maybe Color + , shadow : + Maybe + { color : Color + , offset : ( Int, Int ) + , blur : Int + , size : Int + } + } +defaultFocus = + Internal.focusDefaultStyle + + +{-| -} +type alias FocusStyle = + { borderColor : Maybe Color + , backgroundColor : Maybe Color + , shadow : + Maybe + { color : Color + , offset : ( Int, Int ) + , blur : Int + , size : Int + } + } + + +{-| -} +focusStyle : FocusStyle -> Option +focusStyle = + Internal.FocusStyleOption + + +{-| Disable all `mouseOver` styles. +-} +noHover : Option +noHover = + Internal.HoverOption Internal.NoHover + + +{-| Any `hover` styles, aka attributes with `mouseOver` in the name, will be always turned on. + +This is useful for when you're targeting a platform that has no mouse, such as mobile. + +-} +forceHover : Option +forceHover = + Internal.HoverOption Internal.ForceHover + + +{-| When you want to render exactly nothing. +-} +none : Element msg +none = + Internal.Empty + + +{-| Create some plain text. + + text "Hello, you stylish developer!" + +**Note** text does not wrap by default. In order to get text to wrap, check out `paragraph`! + +-} +text : String -> Element msg +text content = + Internal.Text content + + +{-| The basic building block of your layout. + +You can think of an `el` as a `div`, but it can only have one child. + +If you want multiple children, you'll need to use something like `row` or `column` + + import Element exposing (Element, rgb) + import Element.Background as Background + import Element.Border as Border + + myElement : Element msg + myElement = + Element.el + [ Background.color (rgb 0 0.5 0) + , Border.color (rgb 0 0.7 0) + ] + (Element.text "You've made a stylish element!") + +-} +el : List (Attribute msg) -> Element msg -> Element msg +el attrs child = + Internal.element + Internal.asEl + Internal.div + (width shrink + :: height shrink + :: attrs + ) + (Internal.Unkeyed [ child ]) + + +{-| -} +row : List (Attribute msg) -> List (Element msg) -> Element msg +row attrs children = + Internal.element + Internal.asRow + Internal.div + (Internal.htmlClass (classes.contentLeft ++ " " ++ classes.contentCenterY) + :: width shrink + :: height shrink + :: attrs + ) + (Internal.Unkeyed children) + + +{-| -} +column : List (Attribute msg) -> List (Element msg) -> Element msg +column attrs children = + Internal.element + Internal.asColumn + Internal.div + (Internal.htmlClass + (classes.contentTop + ++ " " + ++ classes.contentLeft + ) + :: height shrink + :: width shrink + :: attrs + ) + (Internal.Unkeyed children) + + +{-| Same as `row`, but will wrap if it takes up too much horizontal space. +-} +wrappedRow : List (Attribute msg) -> List (Element msg) -> Element msg +wrappedRow attrs children = + let + ( padded, spaced ) = + Internal.extractSpacingAndPadding attrs + in + case spaced of + Nothing -> + Internal.element + Internal.asRow + Internal.div + (Internal.htmlClass + (classes.contentLeft + ++ " " + ++ classes.contentCenterY + ++ " " + ++ classes.wrapped + ) + :: width shrink + :: height shrink + :: attrs + ) + (Internal.Unkeyed children) + + Just (Internal.Spaced spaceName x y) -> + let + newPadding = + case padded of + Just (Internal.Padding name t r b l) -> + if r >= (toFloat x / 2) && b >= (toFloat y / 2) then + let + newTop = + t - (toFloat y / 2) + + newRight = + r - (toFloat x / 2) + + newBottom = + b - (toFloat y / 2) + + newLeft = + l - (toFloat x / 2) + in + Just <| + Internal.StyleClass Flag.padding + (Internal.PaddingStyle + (Internal.paddingNameFloat + newTop + newRight + newBottom + newLeft + ) + newTop + newRight + newBottom + newLeft + ) + + else + Nothing + + Nothing -> + Nothing + in + case newPadding of + Just pad -> + Internal.element + Internal.asRow + Internal.div + (Internal.htmlClass + (classes.contentLeft + ++ " " + ++ classes.contentCenterY + ++ " " + ++ classes.wrapped + ) + :: width shrink + :: height shrink + :: attrs + ++ [ pad ] + ) + (Internal.Unkeyed children) + + Nothing -> + -- Not enough space in padding to compensate for spacing + let + halfX = + negate (toFloat x / 2) + + halfY = + negate (toFloat y / 2) + in + Internal.element + Internal.asEl + Internal.div + attrs + (Internal.Unkeyed + [ Internal.element + Internal.asRow + Internal.div + (Internal.htmlClass + (classes.contentLeft + ++ " " + ++ classes.contentCenterY + ++ " " + ++ classes.wrapped + ) + :: Internal.Attr + (Html.Attributes.style "margin" + (String.fromFloat halfY + ++ "px" + ++ " " + ++ String.fromFloat halfX + ++ "px" + ) + ) + :: Internal.Attr + (Html.Attributes.style "width" + ("calc(100% + " + ++ String.fromInt x + ++ "px)" + ) + ) + :: Internal.Attr + (Html.Attributes.style "height" + ("calc(100% + " + ++ String.fromInt y + ++ "px)" + ) + ) + :: Internal.StyleClass Flag.spacing (Internal.SpacingStyle spaceName x y) + :: [] + ) + (Internal.Unkeyed children) + ] + ) + + +{-| This is just an alias for `Debug.todo` +-} +type alias Todo = + String -> Never + + +{-| Highlight the borders of an element and it's children below. This can really help if you're running into some issue with your layout! + +**Note** This attribute needs to be handed `Debug.todo` in order to work, even though it won't do anything with it. This is a safety measure so you don't accidently ship code with `explain` in it, as Elm won't compile with `--optimize` if you still have a `Debug` statement in your code. + + el + [ Element.explain Debug.todo + ] + (text "Help, I'm being debugged!") + +-} +explain : Todo -> Attribute msg +explain _ = + Internal.htmlClass "explain" + + +{-| -} +type alias Column record msg = + { header : Element msg + , width : Length + , view : record -> Element msg + } + + +{-| Show some tabular data. + +Start with a list of records and specify how each column should be rendered. + +So, if we have a list of `persons`: + + type alias Person = + { firstName : String + , lastName : String + } + + persons : List Person + persons = + [ { firstName = "David" + , lastName = "Bowie" + } + , { firstName = "Florence" + , lastName = "Welch" + } + ] + +We could render it using + + Element.table [] + { data = persons + , columns = + [ { header = Element.text "First Name" + , width = fill + , view = + \person -> + Element.text person.firstName + } + , { header = Element.text "Last Name" + , width = fill + , view = + \person -> + Element.text person.lastName + } + ] + } + +**Note:** Sometimes you might not have a list of records directly in your model. In this case it can be really nice to write a function that transforms some part of your model into a list of records before feeding it into `Element.table`. + +-} +table : + List (Attribute msg) + -> + { data : List records + , columns : List (Column records msg) + } + -> Element msg +table attrs config = + tableHelper attrs + { data = config.data + , columns = + List.map InternalColumn config.columns + } + + +{-| -} +type alias IndexedColumn record msg = + { header : Element msg + , width : Length + , view : Int -> record -> Element msg + } + + +{-| Same as `Element.table` except the `view` for each column will also receive the row index as well as the record. +-} +indexedTable : + List (Attribute msg) + -> + { data : List records + , columns : List (IndexedColumn records msg) + } + -> Element msg +indexedTable attrs config = + tableHelper attrs + { data = config.data + , columns = + List.map InternalIndexedColumn config.columns + } + + +{-| -} +type alias InternalTable records msg = + { data : List records + , columns : List (InternalTableColumn records msg) + } + + +{-| -} +type InternalTableColumn record msg + = InternalIndexedColumn (IndexedColumn record msg) + | InternalColumn (Column record msg) + + +tableHelper : List (Attribute msg) -> InternalTable data msg -> Element msg +tableHelper attrs config = + let + ( sX, sY ) = + Internal.getSpacing attrs ( 0, 0 ) + + columnHeader col = + case col of + InternalIndexedColumn colConfig -> + colConfig.header + + InternalColumn colConfig -> + colConfig.header + + columnWidth col = + case col of + InternalIndexedColumn colConfig -> + colConfig.width + + InternalColumn colConfig -> + colConfig.width + + maybeHeaders = + List.map columnHeader config.columns + |> (\headers -> + if List.all ((==) Internal.Empty) headers then + Nothing + + else + Just (List.indexedMap (\col header -> onGrid 1 (col + 1) header) headers) + ) + + template = + Internal.StyleClass Flag.gridTemplate <| + Internal.GridTemplateStyle + { spacing = ( px sX, px sY ) + , columns = List.map columnWidth config.columns + , rows = List.repeat (List.length config.data) Internal.Content + } + + onGrid rowLevel columnLevel elem = + Internal.element + Internal.asEl + Internal.div + [ Internal.StyleClass Flag.gridPosition + (Internal.GridPosition + { row = rowLevel + , col = columnLevel + , width = 1 + , height = 1 + } + ) + ] + (Internal.Unkeyed [ elem ]) + + add cell columnConfig cursor = + case columnConfig of + InternalIndexedColumn col -> + { cursor + | elements = + onGrid cursor.row + cursor.column + (col.view + (if maybeHeaders == Nothing then + cursor.row - 1 + + else + cursor.row - 2 + ) + cell + ) + :: cursor.elements + , column = cursor.column + 1 + } + + InternalColumn col -> + { elements = + onGrid cursor.row cursor.column (col.view cell) + :: cursor.elements + , column = cursor.column + 1 + , row = cursor.row + } + + build columns rowData cursor = + let + newCursor = + List.foldl (add rowData) + cursor + columns + in + { elements = newCursor.elements + , row = cursor.row + 1 + , column = 1 + } + + children = + List.foldl (build config.columns) + { elements = [] + , row = + if maybeHeaders == Nothing then + 1 + + else + 2 + , column = 1 + } + config.data + in + Internal.element + Internal.asGrid + Internal.div + (width fill + :: template + :: attrs + ) + (Internal.Unkeyed + (case maybeHeaders of + Nothing -> + children.elements + + Just renderedHeaders -> + renderedHeaders ++ List.reverse children.elements + ) + ) + + +{-| A paragraph will layout all children as wrapped, inline elements. + + import Element exposing (el, paragraph, text) + import Element.Font as Font + + view = + paragraph [] + [ text "lots of text ...." + , el [ Font.bold ] (text "this is bold") + , text "lots of text ...." + ] + +This is really useful when you want to markup text by having some parts be bold, or some be links, or whatever you so desire. + +Also, if a child element has `alignLeft` or `alignRight`, then it will be moved to that side and the text will flow around it, (ah yes, `float` behavior). + +This makes it particularly easy to do something like a [dropped capital](https://en.wikipedia.org/wiki/Initial). + + import Element exposing (alignLeft, el, padding, paragraph, text) + import Element.Font as Font + + view = + paragraph [] + [ el + [ alignLeft + , padding 5 + ] + (text "S") + , text "o much text ...." + ] + +Which will look something like + +![A paragraph where the first letter is twice the height of the others](https://mdgriffith.gitbooks.io/style-elements/content/assets/Screen%20Shot%202017-08-25%20at%209.41.52%20PM.png) + +**Note** `spacing` on a paragraph will set the pixel spacing between lines. + +-} +paragraph : List (Attribute msg) -> List (Element msg) -> Element msg +paragraph attrs children = + Internal.element + Internal.asParagraph + Internal.div + (Internal.Describe Internal.Paragraph + :: width fill + :: spacing 5 + :: attrs + ) + (Internal.Unkeyed children) + + +{-| Now that we have a paragraph, we need some way to attach a bunch of paragraph's together. + +To do that we can use a `textColumn`. + +The main difference between a `column` and a `textColumn` is that `textColumn` will flow the text around elements that have `alignRight` or `alignLeft`, just like we just saw with paragraph. + +In the following example, we have a `textColumn` where one child has `alignLeft`. + + Element.textColumn [ spacing 10, padding 10 ] + [ paragraph [] [ text "lots of text ...." ] + , el [ alignLeft ] none + , paragraph [] [ text "lots of text ...." ] + ] + +Which will result in something like: + +![A text layout where an image is on the left.](https://mdgriffith.gitbooks.io/style-elements/content/assets/Screen%20Shot%202017-08-25%20at%208.42.39%20PM.png) + +-} +textColumn : List (Attribute msg) -> List (Element msg) -> Element msg +textColumn attrs children = + Internal.element + Internal.asTextColumn + Internal.div + (width + (fill + |> minimum 500 + |> maximum 750 + ) + :: attrs + ) + (Internal.Unkeyed children) + + +{-| Both a source and a description are required for images. + +The description is used for people using screen readers. + +Leaving the description blank will cause the image to be ignored by assistive technology. This can make sense for images that are purely decorative and add no additional information. + +So, take a moment to describe your image as you would to someone who has a harder time seeing. + +-} +image : List (Attribute msg) -> { src : String, description : String } -> Element msg +image attrs { src, description } = + let + imageAttributes = + attrs + |> List.filter + (\a -> + case a of + Internal.Width _ -> + True + + Internal.Height _ -> + True + + _ -> + False + ) + in + Internal.element + Internal.asEl + Internal.div + (Internal.htmlClass classes.imageContainer + :: attrs + ) + (Internal.Unkeyed + [ Internal.element + Internal.asEl + (Internal.NodeName "img") + ([ Internal.Attr <| Html.Attributes.src src + , Internal.Attr <| Html.Attributes.alt description + ] + ++ imageAttributes + ) + (Internal.Unkeyed []) + ] + ) + + +{-| + + link [] + { url = "http://fruits.com" + , label = text "A link to my favorite fruit provider." + } + +-} +link : + List (Attribute msg) + -> + { url : String + , label : Element msg + } + -> Element msg +link attrs { url, label } = + Internal.element + Internal.asEl + (Internal.NodeName "a") + (Internal.Attr (Html.Attributes.href url) + :: Internal.Attr (Html.Attributes.rel "noopener noreferrer") + :: width shrink + :: height shrink + :: Internal.htmlClass + (classes.contentCenterX + ++ " " + ++ classes.contentCenterY + ++ " " + ++ classes.link + ) + :: attrs + ) + (Internal.Unkeyed [ label ]) + + +{-| -} +newTabLink : + List (Attribute msg) + -> + { url : String + , label : Element msg + } + -> Element msg +newTabLink attrs { url, label } = + Internal.element + Internal.asEl + (Internal.NodeName "a") + (Internal.Attr (Html.Attributes.href url) + :: Internal.Attr (Html.Attributes.rel "noopener noreferrer") + :: Internal.Attr (Html.Attributes.target "_blank") + :: width shrink + :: height shrink + :: Internal.htmlClass + (classes.contentCenterX + ++ " " + ++ classes.contentCenterY + ++ " " + ++ classes.link + ) + :: attrs + ) + (Internal.Unkeyed [ label ]) + + +{-| A link to download a file. + +**Note** If you're using `Browser.application`, then this won't be enough to actually trigger a file download due to how `Browser.Navigation` works. + +[Here's a description of what needs to happen](https://github.com/elm/html/issues/175). + +-} +download : + List (Attribute msg) + -> + { url : String + , label : Element msg + } + -> Element msg +download attrs { url, label } = + Internal.element + Internal.asEl + (Internal.NodeName "a") + (Internal.Attr (Html.Attributes.href url) + :: Internal.Attr (Html.Attributes.download "") + :: width shrink + :: height shrink + :: Internal.htmlClass classes.contentCenterX + :: Internal.htmlClass classes.contentCenterY + :: attrs + ) + (Internal.Unkeyed [ label ]) + + +{-| A link to download a file, but you can specify the filename. +-} +downloadAs : + List (Attribute msg) + -> + { label : Element msg + , filename : String + , url : String + } + -> Element msg +downloadAs attrs { url, filename, label } = + Internal.element + Internal.asEl + (Internal.NodeName "a") + (Internal.Attr (Html.Attributes.href url) + :: Internal.Attr (Html.Attributes.download filename) + :: width shrink + :: height shrink + :: Internal.htmlClass classes.contentCenterX + :: Internal.htmlClass classes.contentCenterY + :: attrs + ) + (Internal.Unkeyed [ label ]) + + + +{- NEARBYS -} + + +createNearby : Internal.Location -> Element msg -> Attribute msg +createNearby loc element = + case element of + Internal.Empty -> + Internal.NoAttribute + + _ -> + Internal.Nearby loc element + + +{-| -} +below : Element msg -> Attribute msg +below element = + createNearby Internal.Below element + + +{-| -} +above : Element msg -> Attribute msg +above element = + createNearby Internal.Above element + + +{-| -} +onRight : Element msg -> Attribute msg +onRight element = + createNearby Internal.OnRight element + + +{-| -} +onLeft : Element msg -> Attribute msg +onLeft element = + createNearby Internal.OnLeft element + + +{-| This will place an element in front of another. + +**Note:** If you use this on a `layout` element, it will place the element as fixed to the viewport which can be useful for modals and overlays. + +-} +inFront : Element msg -> Attribute msg +inFront element = + createNearby Internal.InFront element + + +{-| This will place an element between the background and the content of an element. +-} +behindContent : Element msg -> Attribute msg +behindContent element = + createNearby Internal.Behind element + + +{-| -} +width : Length -> Attribute msg +width = + Internal.Width + + +{-| -} +height : Length -> Attribute msg +height = + Internal.Height + + +{-| -} +scale : Float -> Attr decorative msg +scale n = + Internal.TransformComponent Flag.scale (Internal.Scale ( n, n, 1 )) + + +{-| Angle is given in radians. [Here are some conversion functions if you want to use another unit.](https://package.elm-lang.org/packages/elm/core/latest/Basics#degrees) +-} +rotate : Float -> Attr decorative msg +rotate angle = + Internal.TransformComponent Flag.rotate (Internal.Rotate ( 0, 0, 1 ) angle) + + +{-| -} +moveUp : Float -> Attr decorative msg +moveUp y = + Internal.TransformComponent Flag.moveY (Internal.MoveY (negate y)) + + +{-| -} +moveDown : Float -> Attr decorative msg +moveDown y = + Internal.TransformComponent Flag.moveY (Internal.MoveY y) + + +{-| -} +moveRight : Float -> Attr decorative msg +moveRight x = + Internal.TransformComponent Flag.moveX (Internal.MoveX x) + + +{-| -} +moveLeft : Float -> Attr decorative msg +moveLeft x = + Internal.TransformComponent Flag.moveX (Internal.MoveX (negate x)) + + +{-| -} +padding : Int -> Attribute msg +padding x = + let + f = + toFloat x + in + Internal.StyleClass Flag.padding (Internal.PaddingStyle ("p-" ++ String.fromInt x) f f f f) + + +{-| Set horizontal and vertical padding. +-} +paddingXY : Int -> Int -> Attribute msg +paddingXY x y = + if x == y then + let + f = + toFloat x + in + Internal.StyleClass Flag.padding (Internal.PaddingStyle ("p-" ++ String.fromInt x) f f f f) + + else + let + xFloat = + toFloat x + + yFloat = + toFloat y + in + Internal.StyleClass Flag.padding + (Internal.PaddingStyle + ("p-" ++ String.fromInt x ++ "-" ++ String.fromInt y) + yFloat + xFloat + yFloat + xFloat + ) + + +{-| If you find yourself defining unique paddings all the time, you might consider defining + + edges = + { top = 0 + , right = 0 + , bottom = 0 + , left = 0 + } + +And then just do + + paddingEach { edges | right = 5 } + +-} +paddingEach : { top : Int, right : Int, bottom : Int, left : Int } -> Attribute msg +paddingEach { top, right, bottom, left } = + if top == right && top == bottom && top == left then + let + topFloat = + toFloat top + in + Internal.StyleClass Flag.padding + (Internal.PaddingStyle ("p-" ++ String.fromInt top) + topFloat + topFloat + topFloat + topFloat + ) + + else + Internal.StyleClass Flag.padding + (Internal.PaddingStyle + (Internal.paddingName top right bottom left) + (toFloat top) + (toFloat right) + (toFloat bottom) + (toFloat left) + ) + + +{-| -} +centerX : Attribute msg +centerX = + Internal.AlignX Internal.CenterX + + +{-| -} +centerY : Attribute msg +centerY = + Internal.AlignY Internal.CenterY + + +{-| -} +alignTop : Attribute msg +alignTop = + Internal.AlignY Internal.Top + + +{-| -} +alignBottom : Attribute msg +alignBottom = + Internal.AlignY Internal.Bottom + + +{-| -} +alignLeft : Attribute msg +alignLeft = + Internal.AlignX Internal.Left + + +{-| -} +alignRight : Attribute msg +alignRight = + Internal.AlignX Internal.Right + + +{-| -} +spaceEvenly : Attribute msg +spaceEvenly = + Internal.Class Flag.spacing Internal.Style.classes.spaceEvenly + + +{-| -} +spacing : Int -> Attribute msg +spacing x = + Internal.StyleClass Flag.spacing (Internal.SpacingStyle (Internal.spacingName x x) x x) + + +{-| In the majority of cases you'll just need to use `spacing`, which will work as intended. + +However for some layouts, like `textColumn`, you may want to set a different spacing for the x axis compared to the y axis. + +-} +spacingXY : Int -> Int -> Attribute msg +spacingXY x y = + Internal.StyleClass Flag.spacing (Internal.SpacingStyle (Internal.spacingName x y) x y) + + +{-| Make an element transparent and have it ignore any mouse or touch events, though it will stil take up space. +-} +transparent : Bool -> Attr decorative msg +transparent on = + if on then + Internal.StyleClass Flag.transparency (Internal.Transparency "transparent" 1.0) + + else + Internal.StyleClass Flag.transparency (Internal.Transparency "visible" 0.0) + + +{-| A capped value between 0.0 and 1.0, where 0.0 is transparent and 1.0 is fully opaque. + +Semantically equivalent to html opacity. + +-} +alpha : Float -> Attr decorative msg +alpha o = + let + transparency = + o + |> max 0.0 + |> min 1.0 + |> (\x -> 1 - x) + in + Internal.StyleClass Flag.transparency <| Internal.Transparency ("transparency-" ++ Internal.floatClass transparency) transparency + + + +-- {-| -} +-- hidden : Bool -> Attribute msg +-- hidden on = +-- if on then +-- Internal.class "hidden" +-- else +-- Internal.NoAttribute + + +{-| -} +scrollbars : Attribute msg +scrollbars = + Internal.Class Flag.overflow classes.scrollbars + + +{-| -} +scrollbarY : Attribute msg +scrollbarY = + Internal.Class Flag.overflow classes.scrollbarsY + + +{-| -} +scrollbarX : Attribute msg +scrollbarX = + Internal.Class Flag.overflow classes.scrollbarsX + + +{-| -} +clip : Attribute msg +clip = + Internal.Class Flag.overflow classes.clip + + +{-| -} +clipY : Attribute msg +clipY = + Internal.Class Flag.overflow classes.clipY + + +{-| -} +clipX : Attribute msg +clipX = + Internal.Class Flag.overflow classes.clipX + + +{-| Set the cursor to be a pointing hand when it's hovering over this element. +-} +pointer : Attribute msg +pointer = + Internal.Class Flag.cursor classes.cursorPointer + + +{-| -} +type alias Device = + { class : DeviceClass + , orientation : Orientation + } + + +{-| -} +type DeviceClass + = Phone + | Tablet + | Desktop + | BigDesktop + + +{-| -} +type Orientation + = Portrait + | Landscape + + +{-| Takes in a Window.Size and returns a device profile which can be used for responsiveness. + +If you have more detailed concerns around responsiveness, it probably makes sense to copy this function into your codebase and modify as needed. + +-} +classifyDevice : { window | height : Int, width : Int } -> Device +classifyDevice window = + -- Tested in this ellie: + -- https://ellie-app.com/68QM7wLW8b9a1 + { class = + let + longSide = + max window.width window.height + + shortSide = + min window.width window.height + in + if shortSide < 600 then + Phone + + else if longSide <= 1200 then + Tablet + + else if longSide > 1200 && longSide <= 1920 then + Desktop + + else + BigDesktop + , orientation = + if window.width < window.height then + Portrait + + else + Landscape + } + + +{-| When designing it's nice to use a modular scale to set spacial rythms. + + scaled = + Element.modular 16 1.25 + +A modular scale starts with a number, and multiplies it by a ratio a number of times. +Then, when setting font sizes you can use: + + Font.size (scaled 1) -- results in 16 + + Font.size (scaled 2) -- 16 * 1.25 results in 20 + + Font.size (scaled 4) -- 16 * 1.25 ^ (4 - 1) results in 31.25 + +We can also provide negative numbers to scale below 16px. + + Font.size (scaled -1) -- 16 * 1.25 ^ (-1) results in 12.8 + +-} +modular : Float -> Float -> Int -> Float +modular normal ratio rescale = + if rescale == 0 then + normal + + else if rescale < 0 then + normal * ratio ^ toFloat rescale + + else + normal * ratio ^ (toFloat rescale - 1) + + +{-| -} +mouseOver : List Decoration -> Attribute msg +mouseOver decs = + Internal.StyleClass Flag.hover <| + Internal.PseudoSelector Internal.Hover + (Internal.unwrapDecorations decs) + + +{-| -} +mouseDown : List Decoration -> Attribute msg +mouseDown decs = + Internal.StyleClass Flag.active <| + Internal.PseudoSelector Internal.Active + (Internal.unwrapDecorations decs) + + +{-| -} +focused : List Decoration -> Attribute msg +focused decs = + Internal.StyleClass Flag.focus <| + Internal.PseudoSelector Internal.Focus + (Internal.unwrapDecorations decs) diff --git a/examples/simple/vendor/elm-ui/Element/Background.elm b/examples/simple/vendor/elm-ui/Element/Background.elm new file mode 100644 index 00000000..3886acc7 --- /dev/null +++ b/examples/simple/vendor/elm-ui/Element/Background.elm @@ -0,0 +1,226 @@ +module Element.Background exposing + ( color, gradient + , image, uncropped, tiled, tiledX, tiledY + ) + +{-| + +@docs color, gradient + + +# Images + +@docs image, uncropped, tiled, tiledX, tiledY + +**Note** if you want more control over a background image than is provided here, you should try just using a normal `Element.image` with something like `Element.behindContent`. + +-} + +import Element exposing (Attr, Attribute, Color) +import Internal.Flag as Flag +import Internal.Model as Internal +import VirtualDom + + +{-| -} +color : Color -> Attr decorative msg +color clr = + Internal.StyleClass Flag.bgColor (Internal.Colored ("bg-" ++ Internal.formatColorClass clr) "background-color" clr) + + +{-| Resize the image to fit the containing element while maintaining proportions and cropping the overflow. +-} +image : String -> Attribute msg +image src = + Internal.Attr (VirtualDom.style "background" ("url(\"" ++ src ++ "\") center / cover no-repeat")) + + +{-| A centered background image that keeps its natural proportions, but scales to fit the space. +-} +uncropped : String -> Attribute msg +uncropped src = + Internal.Attr (VirtualDom.style "background" ("url(\"" ++ src ++ "\") center / contain no-repeat")) + + +{-| Tile an image in the x and y axes. +-} +tiled : String -> Attribute msg +tiled src = + Internal.Attr (VirtualDom.style "background" ("url(\"" ++ src ++ "\") repeat")) + + +{-| Tile an image in the x axis. +-} +tiledX : String -> Attribute msg +tiledX src = + Internal.Attr (VirtualDom.style "background" ("url(\"" ++ src ++ "\") repeat-x")) + + +{-| Tile an image in the y axis. +-} +tiledY : String -> Attribute msg +tiledY src = + Internal.Attr (VirtualDom.style "background" ("url(\"" ++ src ++ "\") repeat-y")) + + +type Direction + = ToUp + | ToDown + | ToRight + | ToTopRight + | ToBottomRight + | ToLeft + | ToTopLeft + | ToBottomLeft + | ToAngle Float + + +type Step + = ColorStep Color + | PercentStep Float Color + | PxStep Int Color + + +{-| -} +step : Color -> Step +step = + ColorStep + + +{-| -} +percent : Float -> Color -> Step +percent = + PercentStep + + +{-| -} +px : Int -> Color -> Step +px = + PxStep + + +{-| A linear gradient. + +First you need to specify what direction the gradient is going by providing an angle in radians. `0` is up and `pi` is down. + +The colors will be evenly spaced. + +-} +gradient : + { angle : Float + , steps : List Color + } + -> Attr decorative msg +gradient { angle, steps } = + case steps of + [] -> + Internal.NoAttribute + + clr :: [] -> + Internal.StyleClass Flag.bgColor + (Internal.Colored ("bg-" ++ Internal.formatColorClass clr) "background-color" clr) + + _ -> + Internal.StyleClass Flag.bgGradient <| + Internal.Single ("bg-grad-" ++ (String.join "-" <| Internal.floatClass angle :: List.map Internal.formatColorClass steps)) + "background-image" + ("linear-gradient(" ++ (String.join ", " <| (String.fromFloat angle ++ "rad") :: List.map Internal.formatColor steps) ++ ")") + + + +-- {-| -} +-- gradientWith : { direction : Direction, steps : List Step } -> Attribute msg +-- gradientWith { direction, steps } = +-- StyleClass <| +-- Single ("bg-gradient-" ++ (String.join "-" <| renderDirectionClass direction :: List.map renderStepClass steps)) +-- "background" +-- ("linear-gradient(" ++ (String.join ", " <| renderDirection direction :: List.map renderStep steps) ++ ")") +-- {-| -} +-- renderStep : Step -> String +-- renderStep step = +-- case step of +-- ColorStep color -> +-- formatColor color +-- PercentStep percent color -> +-- formatColor color ++ " " ++ toString percent ++ "%" +-- PxStep px color -> +-- formatColor color ++ " " ++ toString px ++ "px" +-- {-| -} +-- renderStepClass : Step -> String +-- renderStepClass step = +-- case step of +-- ColorStep color -> +-- formatColorClass color +-- PercentStep percent color -> +-- formatColorClass color ++ "-" ++ floatClass percent ++ "p" +-- PxStep px color -> +-- formatColorClass color ++ "-" ++ toString px ++ "px" +-- toUp : Direction +-- toUp = +-- ToUp +-- toDown : Direction +-- toDown = +-- ToDown +-- toRight : Direction +-- toRight = +-- ToRight +-- toTopRight : Direction +-- toTopRight = +-- ToTopRight +-- toBottomRight : Direction +-- toBottomRight = +-- ToBottomRight +-- toLeft : Direction +-- toLeft = +-- ToLeft +-- toTopLeft : Direction +-- toTopLeft = +-- ToTopLeft +-- toBottomLeft : Direction +-- toBottomLeft = +-- ToBottomLeft +-- angle : Float -> Direction +-- angle rad = +-- ToAngle rad +-- renderDirection : Direction -> String +-- renderDirection dir = +-- case dir of +-- ToUp -> +-- "to top" +-- ToDown -> +-- "to bottom" +-- ToRight -> +-- "to right" +-- ToTopRight -> +-- "to top right" +-- ToBottomRight -> +-- "to bottom right" +-- ToLeft -> +-- "to left" +-- ToTopLeft -> +-- "to top left" +-- ToBottomLeft -> +-- "to bottom left" +-- ToAngle angle -> +-- toString angle ++ "rad" +-- renderDirectionClass : Direction -> String +-- renderDirectionClass dir = +-- case dir of +-- ToUp -> +-- "to-top" +-- ToDown -> +-- "to-bottom" +-- ToRight -> +-- "to-right" +-- ToTopRight -> +-- "to-top-right" +-- ToBottomRight -> +-- "to-bottom-right" +-- ToLeft -> +-- "to-left" +-- ToTopLeft -> +-- "to-top-left" +-- ToBottomLeft -> +-- "to-bottom-left" +-- ToAngle angle -> +-- floatClass angle ++ "rad" diff --git a/examples/simple/vendor/elm-ui/Element/Border.elm b/examples/simple/vendor/elm-ui/Element/Border.elm new file mode 100644 index 00000000..04c9ffff --- /dev/null +++ b/examples/simple/vendor/elm-ui/Element/Border.elm @@ -0,0 +1,281 @@ +module Element.Border exposing + ( color + , width, widthXY, widthEach + , solid, dashed, dotted + , rounded, roundEach + , glow, innerGlow, shadow, innerShadow + ) + +{-| + +@docs color + + +## Border Widths + +@docs width, widthXY, widthEach + + +## Border Styles + +@docs solid, dashed, dotted + + +## Rounded Corners + +@docs rounded, roundEach + + +## Shadows + +@docs glow, innerGlow, shadow, innerShadow + +-} + +import Element exposing (Attr, Attribute, Color) +import Internal.Flag as Flag +import Internal.Model as Internal +import Internal.Style as Style exposing (classes) + + +{-| -} +color : Color -> Attr decorative msg +color clr = + Internal.StyleClass + Flag.borderColor + (Internal.Colored + ("bc-" ++ Internal.formatColorClass clr) + "border-color" + clr + ) + + +{-| -} +width : Int -> Attribute msg +width v = + Internal.StyleClass + Flag.borderWidth + (Internal.BorderWidth + ("b-" ++ String.fromInt v) + v + v + v + v + ) + + +{-| Set horizontal and vertical borders. +-} +widthXY : Int -> Int -> Attribute msg +widthXY x y = + Internal.StyleClass + Flag.borderWidth + (Internal.BorderWidth + ("b-" + ++ String.fromInt x + ++ "-" + ++ String.fromInt y + ) + y + x + y + x + ) + + +{-| -} +widthEach : + { bottom : Int + , left : Int + , right : Int + , top : Int + } + -> Attribute msg +widthEach { bottom, top, left, right } = + if top == bottom && left == right then + if top == right then + width top + + else + widthXY left top + + else + Internal.StyleClass Flag.borderWidth + (Internal.BorderWidth + ("b-" + ++ String.fromInt top + ++ "-" + ++ String.fromInt right + ++ "-" + ++ String.fromInt bottom + ++ "-" + ++ String.fromInt left + ) + top + right + bottom + left + ) + + + +-- {-| No Borders +-- -} +-- none : Attribute msg +-- none = +-- Class "border" "border-none" + + +{-| -} +solid : Attribute msg +solid = + Internal.Class Flag.borderStyle classes.borderSolid + + +{-| -} +dashed : Attribute msg +dashed = + Internal.Class Flag.borderStyle classes.borderDashed + + +{-| -} +dotted : Attribute msg +dotted = + Internal.Class Flag.borderStyle classes.borderDotted + + +{-| Round all corners. +-} +rounded : Int -> Attribute msg +rounded radius = + Internal.StyleClass + Flag.borderRound + (Internal.Single + ("br-" ++ String.fromInt radius) + "border-radius" + (String.fromInt radius ++ "px") + ) + + +{-| -} +roundEach : + { topLeft : Int + , topRight : Int + , bottomLeft : Int + , bottomRight : Int + } + -> Attribute msg +roundEach { topLeft, topRight, bottomLeft, bottomRight } = + Internal.StyleClass Flag.borderRound + (Internal.Single + ("br-" + ++ String.fromInt topLeft + ++ "-" + ++ String.fromInt topRight + ++ String.fromInt bottomLeft + ++ "-" + ++ String.fromInt bottomRight + ) + "border-radius" + (String.fromInt topLeft + ++ "px " + ++ String.fromInt topRight + ++ "px " + ++ String.fromInt bottomRight + ++ "px " + ++ String.fromInt bottomLeft + ++ "px" + ) + ) + + +{-| A simple glow by specifying the color and size. +-} +glow : Color -> Float -> Attr decorative msg +glow clr size = + shadow + { offset = ( 0, 0 ) + , size = size + , blur = size * 2 + , color = clr + } + + +{-| -} +innerGlow : Color -> Float -> Attr decorative msg +innerGlow clr size = + innerShadow + { offset = ( 0, 0 ) + , size = size + , blur = size * 2 + , color = clr + } + + +{-| -} +shadow : + { offset : ( Float, Float ) + , size : Float + , blur : Float + , color : Color + } + -> Attr decorative msg +shadow almostShade = + let + shade = + { inset = False + , offset = almostShade.offset + , size = almostShade.size + , blur = almostShade.blur + , color = almostShade.color + } + in + Internal.StyleClass Flag.shadows <| + Internal.Single + (Internal.boxShadowClass shade) + "box-shadow" + (Internal.formatBoxShadow shade) + + +{-| -} +innerShadow : + { offset : ( Float, Float ) + , size : Float + , blur : Float + , color : Color + } + -> Attr decorative msg +innerShadow almostShade = + let + shade = + { inset = True + , offset = almostShade.offset + , size = almostShade.size + , blur = almostShade.blur + , color = almostShade.color + } + in + Internal.StyleClass Flag.shadows <| + Internal.Single + (Internal.boxShadowClass shade) + "box-shadow" + (Internal.formatBoxShadow shade) + + + +-- {-| -} +-- shadow : +-- { offset : ( Float, Float ) +-- , blur : Float +-- , size : Float +-- , color : Color +-- } +-- -> Attr decorative msg +-- shadow shade = +-- Internal.BoxShadow +-- { inset = False +-- , offset = shade.offset +-- , size = shade.size +-- , blur = shade.blur +-- , color = shade.color +-- } diff --git a/examples/simple/vendor/elm-ui/Element/Events.elm b/examples/simple/vendor/elm-ui/Element/Events.elm new file mode 100644 index 00000000..764e44c5 --- /dev/null +++ b/examples/simple/vendor/elm-ui/Element/Events.elm @@ -0,0 +1,265 @@ +module Element.Events exposing + ( onClick, onDoubleClick, onMouseDown, onMouseUp, onMouseEnter, onMouseLeave, onMouseMove + , onFocus, onLoseFocus + -- , onClickCoords + -- , onClickPageCoords + -- , onClickScreenCoords + -- , onMouseCoords + -- , onMousePageCoords + -- , onMouseScreenCoords + ) + +{-| + + +## Mouse Events + +@docs onClick, onDoubleClick, onMouseDown, onMouseUp, onMouseEnter, onMouseLeave, onMouseMove + + +## Focus Events + +@docs onFocus, onLoseFocus + +-} + +import Element exposing (Attribute) +import Html.Events +import Internal.Model as Internal +import Json.Decode as Json +import VirtualDom + + + +-- MOUSE EVENTS + + +{-| -} +onMouseDown : msg -> Attribute msg +onMouseDown = + Internal.Attr << Html.Events.onMouseDown + + +{-| -} +onMouseUp : msg -> Attribute msg +onMouseUp = + Internal.Attr << Html.Events.onMouseUp + + +{-| -} +onClick : msg -> Attribute msg +onClick = + Internal.Attr << Html.Events.onClick + + +{-| -} +onDoubleClick : msg -> Attribute msg +onDoubleClick = + Internal.Attr << Html.Events.onDoubleClick + + +{-| -} +onMouseEnter : msg -> Attribute msg +onMouseEnter = + Internal.Attr << Html.Events.onMouseEnter + + +{-| -} +onMouseLeave : msg -> Attribute msg +onMouseLeave = + Internal.Attr << Html.Events.onMouseLeave + + +{-| -} +onMouseMove : msg -> Attribute msg +onMouseMove msg = + on "mousemove" (Json.succeed msg) + + + +-- onClickWith +-- { button = primary +-- , send = localCoords Button +-- } +-- type alias Click = +-- { button : Button +-- , send : Track +-- } +-- type Button = Primary | Secondary +-- type Track +-- = ElementCoords +-- | PageCoords +-- | ScreenCoords +-- | + + +{-| -} +onClickCoords : (Coords -> msg) -> Attribute msg +onClickCoords msg = + on "click" (Json.map msg localCoords) + + +{-| -} +onClickScreenCoords : (Coords -> msg) -> Attribute msg +onClickScreenCoords msg = + on "click" (Json.map msg screenCoords) + + +{-| -} +onClickPageCoords : (Coords -> msg) -> Attribute msg +onClickPageCoords msg = + on "click" (Json.map msg pageCoords) + + +{-| -} +onMouseCoords : (Coords -> msg) -> Attribute msg +onMouseCoords msg = + on "mousemove" (Json.map msg localCoords) + + +{-| -} +onMouseScreenCoords : (Coords -> msg) -> Attribute msg +onMouseScreenCoords msg = + on "mousemove" (Json.map msg screenCoords) + + +{-| -} +onMousePageCoords : (Coords -> msg) -> Attribute msg +onMousePageCoords msg = + on "mousemove" (Json.map msg pageCoords) + + +type alias Coords = + { x : Int + , y : Int + } + + +screenCoords : Json.Decoder Coords +screenCoords = + Json.map2 Coords + (Json.field "screenX" Json.int) + (Json.field "screenY" Json.int) + + +{-| -} +localCoords : Json.Decoder Coords +localCoords = + Json.map2 Coords + (Json.field "offsetX" Json.int) + (Json.field "offsetY" Json.int) + + +pageCoords : Json.Decoder Coords +pageCoords = + Json.map2 Coords + (Json.field "pageX" Json.int) + (Json.field "pageY" Json.int) + + + +-- FOCUS EVENTS + + +{-| -} +onLoseFocus : msg -> Attribute msg +onLoseFocus = + Internal.Attr << Html.Events.onBlur + + +{-| -} +onFocus : msg -> Attribute msg +onFocus = + Internal.Attr << Html.Events.onFocus + + + +-- CUSTOM EVENTS + + +{-| Create a custom event listener. Normally this will not be necessary, but +you have the power! Here is how `onClick` is defined for example: + + import Json.Decode as Json + + onClick : msg -> Attribute msg + onClick message = + on "click" (Json.succeed message) + +The first argument is the event name in the same format as with JavaScript's +[`addEventListener`][aEL] function. +The second argument is a JSON decoder. Read more about these [here][decoder]. +When an event occurs, the decoder tries to turn the event object into an Elm +value. If successful, the value is routed to your `update` function. In the +case of `onClick` we always just succeed with the given `message`. +If this is confusing, work through the [Elm Architecture Tutorial][tutorial]. +It really does help! +[aEL]: +[decoder]: +[tutorial]: + +-} +on : String -> Json.Decoder msg -> Attribute msg +on event decode = + Internal.Attr <| Html.Events.on event decode + + + +-- {-| Same as `on` but you can set a few options. +-- -} +-- onWithOptions : String -> Html.Events.Options -> Json.Decoder msg -> Attribute msg +-- onWithOptions event options decode = +-- Internal.Attr <| Html.Events.onWithOptions event options decode +-- COMMON DECODERS + + +{-| A `Json.Decoder` for grabbing `event.target.value`. We use this to define +`onInput` as follows: + + import Json.Decode as Json + + onInput : (String -> msg) -> Attribute msg + onInput tagger = + on "input" (Json.map tagger targetValue) + +You probably will never need this, but hopefully it gives some insights into +how to make custom event handlers. + +-} +targetValue : Json.Decoder String +targetValue = + Json.at [ "target", "value" ] Json.string + + +{-| A `Json.Decoder` for grabbing `event.target.checked`. We use this to define +`onCheck` as follows: + + import Json.Decode as Json + + onCheck : (Bool -> msg) -> Attribute msg + onCheck tagger = + on "input" (Json.map tagger targetChecked) + +-} +targetChecked : Json.Decoder Bool +targetChecked = + Json.at [ "target", "checked" ] Json.bool + + +{-| A `Json.Decoder` for grabbing `event.keyCode`. This helps you define +keyboard listeners like this: + + import Json.Decode as Json + + onKeyUp : (Int -> msg) -> Attribute msg + onKeyUp tagger = + on "keyup" (Json.map tagger keyCode) + +**Note:** It looks like the spec is moving away from `event.keyCode` and +towards `event.key`. Once this is supported in more browsers, we may add +helpers here for `onKeyUp`, `onKeyDown`, `onKeyPress`, etc. + +-} +keyCode : Json.Decoder Int +keyCode = + Json.field "keyCode" Json.int diff --git a/examples/simple/vendor/elm-ui/Element/Font.elm b/examples/simple/vendor/elm-ui/Element/Font.elm new file mode 100644 index 00000000..c841e107 --- /dev/null +++ b/examples/simple/vendor/elm-ui/Element/Font.elm @@ -0,0 +1,525 @@ +module Element.Font exposing + ( color, size + , family, Font, typeface, serif, sansSerif, monospace + , external + , alignLeft, alignRight, center, justify, letterSpacing, wordSpacing + , underline, strike, italic, unitalicized + , heavy, extraBold, bold, semiBold, medium, regular, light, extraLight, hairline + , Variant, variant, variantList, smallCaps, slashedZero, ligatures, ordinal, tabularNumbers, stackedFractions, diagonalFractions, swash, feature, indexed + , glow, shadow + ) + +{-| + + import Element + import Element.Font as Font + + view = + Element.el + [ Font.color (Element.rgb 0 0 1) + , Font.size 18 + , Font.family + [ Font.typeface "Open Sans" + , Font.sansSerif + ] + ] + (Element.text "Woohoo, I'm stylish text") + +**Note:** `Font.color`, `Font.size`, and `Font.family` are inherited, meaning you can set them at the top of your view and all subsequent nodes will have that value. + +**Other Note:** If you're looking for something like `line-height`, it's handled by `Element.spacing` on a `paragraph`. + +@docs color, size + + +## Typefaces + +@docs family, Font, typeface, serif, sansSerif, monospace + +@docs external + + +## Alignment and Spacing + +@docs alignLeft, alignRight, center, justify, letterSpacing, wordSpacing + + +## Font Styles + +@docs underline, strike, italic, unitalicized + + +## Font Weight + +@docs heavy, extraBold, bold, semiBold, medium, regular, light, extraLight, hairline + + +## Variants + +@docs Variant, variant, variantList, smallCaps, slashedZero, ligatures, ordinal, tabularNumbers, stackedFractions, diagonalFractions, swash, feature, indexed + + +## Shadows + +@docs glow, shadow + +-} + +import Element exposing (Attr, Attribute, Color) +import Internal.Flag as Flag +import Internal.Model as Internal +import Internal.Style exposing (classes) + + +{-| -} +type alias Font = + Internal.Font + + +{-| -} +color : Color -> Attr decorative msg +color fontColor = + Internal.StyleClass + Flag.fontColor + (Internal.Colored + ("fc-" ++ Internal.formatColorClass fontColor) + "color" + fontColor + ) + + +{-| + + import Element + import Element.Font as Font + + myElement = + Element.el + [ Font.family + [ Font.typeface "Helvetica" + , Font.sansSerif + ] + ] + (text "") + +-} +family : List Font -> Attribute msg +family families = + Internal.StyleClass + Flag.fontFamily + (Internal.FontFamily + (List.foldl Internal.renderFontClassName "ff-" families) + families + ) + + +{-| -} +serif : Font +serif = + Internal.Serif + + +{-| -} +sansSerif : Font +sansSerif = + Internal.SansSerif + + +{-| -} +monospace : Font +monospace = + Internal.Monospace + + +{-| -} +typeface : String -> Font +typeface = + Internal.Typeface + + +{-| -} +type alias Adjustment = + { capital : Float + , lowercase : Float + , baseline : Float + , descender : Float + } + + +{-| -} +with : + { name : String + , adjustment : Maybe Adjustment + , variants : List Variant + } + -> Font +with = + Internal.FontWith + + +{-| -} +sizeByCapital : Attribute msg +sizeByCapital = + Internal.htmlClass classes.sizeByCapital + + +{-| -} +full : Attribute msg +full = + Internal.htmlClass classes.fullSize + + +{-| **Note** it's likely that `Font.external` will cause a flash on your page on loading. + +To bypass this, import your fonts using a separate stylesheet and just use `Font.typeface`. + +It's likely that `Font.external` will be removed or redesigned in the future to avoid the flashing. + +`Font.external` can be used to import font files. Let's say you found a neat font on : + + import Element + import Element.Font as Font + + view = + Element.el + [ Font.family + [ Font.external + { name = "Roboto" + , url = "https://fonts.googleapis.com/css?family=Roboto" + } + , Font.sansSerif + ] + ] + (Element.text "Woohoo, I'm stylish text") + +-} +external : { url : String, name : String } -> Font +external { url, name } = + Internal.ImportFont name url + + +{-| Font sizes are always given as `px`. +-} +size : Int -> Attr decorative msg +size i = + Internal.StyleClass Flag.fontSize (Internal.FontSize i) + + +{-| In `px`. +-} +letterSpacing : Float -> Attribute msg +letterSpacing offset = + Internal.StyleClass Flag.letterSpacing <| + Internal.Single + ("ls-" ++ Internal.floatClass offset) + "letter-spacing" + (String.fromFloat offset ++ "px") + + +{-| In `px`. +-} +wordSpacing : Float -> Attribute msg +wordSpacing offset = + Internal.StyleClass Flag.wordSpacing <| + Internal.Single ("ws-" ++ Internal.floatClass offset) "word-spacing" (String.fromFloat offset ++ "px") + + +{-| Align the font to the left. +-} +alignLeft : Attribute msg +alignLeft = + Internal.Class Flag.fontAlignment classes.textLeft + + +{-| Align the font to the right. +-} +alignRight : Attribute msg +alignRight = + Internal.Class Flag.fontAlignment classes.textRight + + +{-| Center align the font. +-} +center : Attribute msg +center = + Internal.Class Flag.fontAlignment classes.textCenter + + +{-| -} +justify : Attribute msg +justify = + Internal.Class Flag.fontAlignment classes.textJustify + + + +-- {-| -} +-- justifyAll : Attribute msg +-- justifyAll = +-- Internal.class classesTextJustifyAll + + +{-| -} +underline : Attribute msg +underline = + Internal.htmlClass classes.underline + + +{-| -} +strike : Attribute msg +strike = + Internal.htmlClass classes.strike + + +{-| -} +italic : Attribute msg +italic = + Internal.htmlClass classes.italic + + +{-| -} +bold : Attribute msg +bold = + Internal.Class Flag.fontWeight classes.bold + + +{-| -} +light : Attribute msg +light = + Internal.Class Flag.fontWeight classes.textLight + + +{-| -} +hairline : Attribute msg +hairline = + Internal.Class Flag.fontWeight classes.textThin + + +{-| -} +extraLight : Attribute msg +extraLight = + Internal.Class Flag.fontWeight classes.textExtraLight + + +{-| -} +regular : Attribute msg +regular = + Internal.Class Flag.fontWeight classes.textNormalWeight + + +{-| -} +semiBold : Attribute msg +semiBold = + Internal.Class Flag.fontWeight classes.textSemiBold + + +{-| -} +medium : Attribute msg +medium = + Internal.Class Flag.fontWeight classes.textMedium + + +{-| -} +extraBold : Attribute msg +extraBold = + Internal.Class Flag.fontWeight classes.textExtraBold + + +{-| -} +heavy : Attribute msg +heavy = + Internal.Class Flag.fontWeight classes.textHeavy + + +{-| This will reset bold and italic. +-} +unitalicized : Attribute msg +unitalicized = + Internal.htmlClass classes.textUnitalicized + + +{-| -} +shadow : + { offset : ( Float, Float ) + , blur : Float + , color : Color + } + -> Attr decorative msg +shadow shade = + Internal.StyleClass Flag.txtShadows <| + Internal.Single (Internal.textShadowClass shade) "text-shadow" (Internal.formatTextShadow shade) + + +{-| A glow is just a simplified shadow. +-} +glow : Color -> Float -> Attr decorative msg +glow clr i = + let + shade = + { offset = ( 0, 0 ) + , blur = i * 2 + , color = clr + } + in + Internal.StyleClass Flag.txtShadows <| + Internal.Single (Internal.textShadowClass shade) "text-shadow" (Internal.formatTextShadow shade) + + + +{- Variants -} + + +{-| -} +type alias Variant = + Internal.Variant + + +{-| You can use this to set a single variant on an element itself such as: + + el + [ Font.variant Font.smallCaps + ] + (text "rendered with smallCaps") + +**Note** These will **not** stack. If you want multiple variants, you should use `Font.variantList`. + +-} +variant : Variant -> Attribute msg +variant var = + case var of + Internal.VariantActive name -> + Internal.Class Flag.fontVariant ("v-" ++ name) + + Internal.VariantOff name -> + Internal.Class Flag.fontVariant ("v-" ++ name ++ "-off") + + Internal.VariantIndexed name index -> + Internal.StyleClass Flag.fontVariant <| + Internal.Single ("v-" ++ name ++ "-" ++ String.fromInt index) + "font-feature-settings" + ("\"" ++ name ++ "\" " ++ String.fromInt index) + + +isSmallCaps x = + case x of + Internal.VariantActive feat -> + feat == "smcp" + + _ -> + False + + +{-| -} +variantList : List Variant -> Attribute msg +variantList vars = + let + features = + vars + |> List.map Internal.renderVariant + + hasSmallCaps = + List.any isSmallCaps vars + + name = + if hasSmallCaps then + vars + |> List.map Internal.variantName + |> String.join "-" + |> (\x -> x ++ "-sc") + + else + vars + |> List.map Internal.variantName + |> String.join "-" + + featureString = + String.join ", " features + in + Internal.StyleClass Flag.fontVariant <| + Internal.Style ("v-" ++ name) + [ Internal.Property "font-feature-settings" featureString + , Internal.Property "font-variant" + (if hasSmallCaps then + "small-caps" + + else + "normal" + ) + ] + + +{-| [Small caps](https://en.wikipedia.org/wiki/Small_caps) are rendered using uppercase glyphs, but at the size of lowercase glyphs. +-} +smallCaps : Variant +smallCaps = + Internal.VariantActive "smcp" + + +{-| Add a slash when rendering `0` +-} +slashedZero : Variant +slashedZero = + Internal.VariantActive "zero" + + +{-| -} +ligatures : Variant +ligatures = + Internal.VariantActive "liga" + + +{-| Oridinal markers like `1st` and `2nd` will receive special glyphs. +-} +ordinal : Variant +ordinal = + Internal.VariantActive "ordn" + + +{-| Number figures will each take up the same space, allowing them to be easily aligned, such as in tables. +-} +tabularNumbers : Variant +tabularNumbers = + Internal.VariantActive "tnum" + + +{-| Render fractions with the numerator stacked on top of the denominator. +-} +stackedFractions : Variant +stackedFractions = + Internal.VariantActive "afrc" + + +{-| Render fractions +-} +diagonalFractions : Variant +diagonalFractions = + Internal.VariantActive "frac" + + +{-| -} +swash : Int -> Variant +swash = + Internal.VariantIndexed "swsh" + + +{-| Set a feature by name and whether it should be on or off. + +Feature names are four-letter names as defined in the [OpenType specification](https://docs.microsoft.com/en-us/typography/opentype/spec/featurelist). + +-} +feature : String -> Bool -> Variant +feature name on = + if on then + Internal.VariantIndexed name 1 + + else + Internal.VariantIndexed name 0 + + +{-| A font variant might have multiple versions within the font. + +In these cases we need to specify the index of the version we want. + +-} +indexed : String -> Int -> Variant +indexed name on = + Internal.VariantIndexed name on diff --git a/examples/simple/vendor/elm-ui/Element/Input.elm b/examples/simple/vendor/elm-ui/Element/Input.elm new file mode 100644 index 00000000..fe4a6ad0 --- /dev/null +++ b/examples/simple/vendor/elm-ui/Element/Input.elm @@ -0,0 +1,2232 @@ +module Element.Input exposing + ( focusedOnLoad + , button + , checkbox, defaultCheckbox + , text, multiline + , Placeholder, placeholder + , username, newPassword, currentPassword, email, search, spellChecked + , slider, Thumb, thumb, defaultThumb + , radio, radioRow, Option, option, optionWith, OptionState(..) + , Label, labelAbove, labelBelow, labelLeft, labelRight, labelHidden + ) + +{-| Input elements have a lot of constraints! + +We want all of our input elements to: + + - _Always be accessible_ + - _Behave intuitively_ + - _Be completely restyleable_ + +While these three goals may seem pretty obvious, Html and CSS have made it surprisingly difficult to achieve! + +And incredibly difficult for developers to remember all the tricks necessary to make things work. If you've every tried to make a `