diff --git a/examples/end-to-end/elm.json b/examples/end-to-end/elm.json index c4ebd37d..f6d3d5c5 100644 --- a/examples/end-to-end/elm.json +++ b/examples/end-to-end/elm.json @@ -11,13 +11,11 @@ "elm-version": "0.19.1", "dependencies": { "direct": { - "MartinSStewart/elm-serialize": "1.2.5", "avh4/elm-color": "1.0.0", "avh4/elm-fifo": "1.0.4", "danfishgold/base64-bytes": "1.1.0", "danyx23/elm-mimetype": "4.0.1", "dillonkearns/elm-bcp47-language-tag": "1.0.1", - "dillonkearns/elm-markdown": "6.0.1", "elm/browser": "1.0.2", "elm/bytes": "1.0.8", "elm/core": "1.0.5", @@ -40,22 +38,16 @@ "justinmimbs/date": "4.0.1", "lamdera/codecs": "1.0.0", "lamdera/core": "1.0.0", - "matheus23/elm-default-tailwind-modules": "2.0.1", "mgold/elm-nonempty-list": "4.2.0", "miniBill/elm-codec": "2.0.0", "noahzgordon/elm-color-extra": "1.0.2", - "pablohirafuji/elm-syntax-highlight": "3.4.0", "robinheghan/fnv1a": "1.0.0", - "robinheghan/murmur3": "1.0.0", "rtfeldman/elm-css": "16.1.1", - "tripokey/elm-fuzzy": "5.2.1", "turboMaCk/non-empty-list-alias": "1.2.0", "vito/elm-ansi": "10.0.1", - "ymtszw/elm-xml-decode": "3.2.1", - "zwilias/json-decode-exploration": "6.0.0" + "ymtszw/elm-xml-decode": "3.2.1" }, "indirect": { - "bburdette/toop": "1.0.1", "elm/file": "1.0.5", "elm-community/maybe-extra": "5.3.0", "fredcy/elm-parseint": "2.0.1", diff --git a/examples/end-to-end/src/MarkdownRenderer.elm b/examples/end-to-end/src/MarkdownRenderer.elm deleted file mode 100644 index 8c72a2b7..00000000 --- a/examples/end-to-end/src/MarkdownRenderer.elm +++ /dev/null @@ -1,233 +0,0 @@ -module MarkdownRenderer exposing (renderer) - -import Html.Styled as Html -import Html.Styled.Attributes as Attr exposing (css) -import Markdown.Block as Block exposing (ListItem(..), Task(..)) -import Markdown.Html -import Markdown.Renderer -import SyntaxHighlight -import Tailwind.Utilities as Tw - - -renderer : Markdown.Renderer.Renderer (Html.Html msg) -renderer = - { heading = heading - , paragraph = Html.p [] - , thematicBreak = Html.hr [] [] - , text = Html.text - , strong = \content -> Html.strong [ css [ Tw.font_bold ] ] content - , emphasis = \content -> Html.em [ css [ Tw.italic ] ] content - , blockQuote = Html.blockquote [] - , codeSpan = - \content -> - Html.code - [ css - [ Tw.font_semibold - , Tw.font_medium - ] - ] - [ Html.text content ] - - --, codeSpan = code - , link = - \{ destination } body -> - Html.a - [ Attr.href destination - , css - [ Tw.underline - ] - ] - body - , hardLineBreak = Html.br [] [] - , image = - \image -> - case image.title of - Just _ -> - Html.img [ Attr.src image.src, Attr.alt image.alt ] [] - - Nothing -> - Html.img [ Attr.src image.src, Attr.alt image.alt ] [] - , unorderedList = - \items -> - Html.ul [] - (items - |> List.map - (\item -> - case item of - Block.ListItem task children -> - let - checkbox = - case task of - Block.NoTask -> - Html.text "" - - Block.IncompleteTask -> - Html.input - [ Attr.disabled True - , Attr.checked False - , Attr.type_ "checkbox" - ] - [] - - Block.CompletedTask -> - Html.input - [ Attr.disabled True - , Attr.checked True - , Attr.type_ "checkbox" - ] - [] - in - Html.li [] (checkbox :: children) - ) - ) - , orderedList = - \startingIndex items -> - Html.ol - (case startingIndex of - 1 -> - [ Attr.start startingIndex ] - - _ -> - [] - ) - (items - |> List.map - (\itemBlocks -> - Html.li [] - itemBlocks - ) - ) - , html = Markdown.Html.oneOf [] - , codeBlock = codeBlock - - --\{ body, language } -> - -- let - -- classes = - -- -- Only the first word is used in the class - -- case Maybe.map String.words language of - -- Just (actualLanguage :: _) -> - -- [ Attr.class <| "language-" ++ actualLanguage ] - -- - -- _ -> - -- [] - -- in - -- Html.pre [] - -- [ Html.code classes - -- [ Html.text body - -- ] - -- ] - , table = Html.table [] - , tableHeader = Html.thead [] - , tableBody = Html.tbody [] - , tableRow = Html.tr [] - , strikethrough = - \children -> Html.del [] children - , tableHeaderCell = - \maybeAlignment -> - let - attrs = - maybeAlignment - |> Maybe.map - (\alignment -> - case alignment of - Block.AlignLeft -> - "left" - - Block.AlignCenter -> - "center" - - Block.AlignRight -> - "right" - ) - |> Maybe.map Attr.align - |> Maybe.map List.singleton - |> Maybe.withDefault [] - in - Html.th attrs - , tableCell = - \maybeAlignment -> - let - attrs = - maybeAlignment - |> Maybe.map - (\alignment -> - case alignment of - Block.AlignLeft -> - "left" - - Block.AlignCenter -> - "center" - - Block.AlignRight -> - "right" - ) - |> Maybe.map Attr.align - |> Maybe.map List.singleton - |> Maybe.withDefault [] - in - Html.td attrs - } - - -rawTextToId : String -> String -rawTextToId rawText = - rawText - |> String.split " " - |> String.join "-" - |> String.toLower - - -heading : { level : Block.HeadingLevel, rawText : String, children : List (Html.Html msg) } -> Html.Html msg -heading { level, rawText, children } = - (case level of - Block.H1 -> - Html.h1 - - Block.H2 -> - Html.h2 - - Block.H3 -> - Html.h3 - - Block.H4 -> - Html.h4 - - Block.H5 -> - Html.h5 - - Block.H6 -> - Html.h6 - ) - [ Attr.id (rawTextToId rawText) - , Attr.attribute "name" (rawTextToId rawText) - , css - [ Tw.font_bold - , Tw.text_2xl - , Tw.mt_8 - , Tw.mb_4 - ] - ] - 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 } -> Html.Html msg -codeBlock details = - SyntaxHighlight.elm details.body - |> Result.map (SyntaxHighlight.toBlockHtml (Just 1)) - |> Result.map Html.fromUnstyled - |> Result.withDefault (Html.pre [] [ Html.code [] [ Html.text details.body ] ]) diff --git a/examples/end-to-end/tests/PagesTest.elm b/examples/end-to-end/tests/PagesTest.elm deleted file mode 100644 index 5670d234..00000000 --- a/examples/end-to-end/tests/PagesTest.elm +++ /dev/null @@ -1,506 +0,0 @@ -module PagesTest exposing (DataSourceSimulator, start) - -import Base64 -import Bytes.Encode -import Dict exposing (Dict) -import Effect exposing (Effect) -import Json.Decode as Decode -import Json.Encode as Encode -import Main exposing (config) -import PageServerResponse -import Pages.Internal.NotFoundReason exposing (NotFoundReason) -import Pages.Internal.Platform as Platform -import Pages.Internal.ResponseSketch as ResponseSketch -import Pages.Internal.StaticHttpBody exposing (Body(..)) -import Pages.StaticHttp.Request -import Pages.StaticHttpRequest -import Path -import ProgramTest -import Regex -import RequestsAndPending -import Route -import Shared -import SimulatedEffect.Cmd -import SimulatedEffect.Navigation -import SimulatedEffect.Task -import Url exposing (Protocol(..), Url) - - -type alias DataSourceSimulator = - Dict String String -> ProgramTest.SimpleState -> Maybe Platform.RequestInfo -> Pages.StaticHttp.Request.Request -> Maybe RequestsAndPending.Response - - -start : - String - -> ((Main.Msg -> Platform.Msg Main.Msg Main.PageData Shared.Data) -> Effect Main.Msg -> ProgramTest.SimulatedEffect (Platform.Msg Main.Msg Main.PageData Shared.Data)) - -> DataSourceSimulator - -> - ProgramTest.ProgramTest - (Platform.Model Main.Model Main.PageData Shared.Data) - (Platform.Msg Main.Msg Main.PageData Shared.Data) - (Platform.Effect Main.Msg Main.PageData Shared.Data (Effect Main.Msg)) -start initialPath simulateEffect dataSourceSimulator = - let - initialSimpleState = - { domFields = Dict.empty - , navigation = - Just - { currentLocation = toUrl initialPath - , browserHistory = [ toUrl initialPath ] - } - , cookieJar = Dict.empty - } - - appRequestSimulator : DataSourceSimulator - appRequestSimulator inFlightCookies testState maybeRequestInfo request = - if request.url == "$$elm-pages$$headers" then - let - cookieHeader : ( String, String ) - cookieHeader = - ( "cookie" - , testState.cookieJar - |> Dict.union inFlightCookies - |> Dict.toList - |> List.map (\( name, value ) -> name ++ "=" ++ value) - |> String.join ";" - ) - - requestTime : ( String, Encode.Value ) - requestTime = - ( "requestTime", Encode.int 0 ) - - rawUrl : ( String, Encode.Value ) - rawUrl = - ( "rawUrl" - , Encode.string <| - "https://localhost:1234/" - -- TODO handle with or without leading `/` - -- TODO handle URL on page change - ++ initialPath - ) - in - case maybeRequestInfo of - Just requestInfo -> - RequestsAndPending.Response Nothing - (RequestsAndPending.JsonBody - (Encode.object - [ requestTime - , ( "headers" - , [ ( "content-type", requestInfo.contentType ) - , cookieHeader - ] - |> Dict.fromList - |> Encode.dict identity Encode.string - ) - , rawUrl - , ( "body" - , Encode.string requestInfo.body - ) - , ( "method", Encode.string "POST" ) - ] - ) - ) - |> Just - - Nothing -> - RequestsAndPending.Response Nothing - (RequestsAndPending.JsonBody - (Encode.object - [ requestTime - , ( "headers" - , [ cookieHeader - ] - |> Dict.fromList - |> Encode.dict identity Encode.string - ) - , rawUrl - , ( "body" - , Encode.null - ) - , ( "method", Encode.string "GET" ) - ] - ) - ) - |> Just - - else if request.url == "elm-pages-internal://env" then - RequestsAndPending.Response Nothing - (RequestsAndPending.JsonBody - (Encode.string "") - ) - |> Just - - else if request.url == "elm-pages-internal://encrypt" then - RequestsAndPending.Response Nothing - (RequestsAndPending.JsonBody - (case request.body of - JsonBody body -> - body - |> Decode.decodeValue (Decode.field "values" Decode.value) - |> Result.withDefault Encode.null - |> Encode.encode 0 - |> Encode.string - - _ -> - Encode.null - ) - ) - |> Just - - else if request.url == "elm-pages-internal://decrypt" then - let - decryptResponse : Encode.Value - decryptResponse = - case request.body of - JsonBody body -> - let - decoded = - body - |> Decode.decodeValue (Decode.field "input" Decode.string) - |> Result.withDefault "INTERNAL ERROR - unexpected decrypt data" - |> Decode.decodeString Decode.value - |> Result.withDefault Encode.null - in - decoded - - _ -> - Encode.null - in - RequestsAndPending.Response Nothing - (RequestsAndPending.JsonBody - decryptResponse - ) - |> Just - - else - dataSourceSimulator - Dict.empty - { domFields = Dict.empty - , navigation = - Just - { currentLocation = toUrl initialPath - , browserHistory = [ toUrl initialPath ] - } - , cookieJar = Dict.empty - } - Nothing - request - - resolvedSharedData : Shared.Data - resolvedSharedData = - Pages.StaticHttpRequest.mockResolve - Shared.template.data - (appRequestSimulator Dict.empty initialSimpleState Nothing) - |> expectOk - - flagsWithData = - Encode.object - [ ( "pageDataBase64" - , (case initialRouteNotFoundReason of - Just notFoundReason -> - { reason = notFoundReason - , path = Path.fromString initialPath - } - |> ResponseSketch.NotFound - - Nothing -> - ResponseSketch.HotUpdate - (responseSketchData |> tupleThird) - resolvedSharedData - ) - |> Main.encodeResponse - |> Bytes.Encode.encode - |> Base64.fromBytes - |> expectJust - |> Encode.string - ) - ] - - initialRoute : Maybe Route.Route - initialRoute = - Main.config.urlToRoute - { path = - initialPath - |> Regex.replace - (Regex.fromString "\\?.*" |> Maybe.withDefault Regex.never) - (\_ -> "") - } - - initialRouteNotFoundReason : Maybe NotFoundReason - initialRouteNotFoundReason = - Pages.StaticHttpRequest.mockResolve - (config.handleRoute initialRoute) - (appRequestSimulator Dict.empty initialSimpleState Nothing) - |> expectOk - - responseSketchData : ( Dict String String, Maybe String, Main.PageData ) - responseSketchData = - initialUrlOrRedirect Nothing Dict.empty initialSimpleState initialRoute appRequestSimulator Nothing - in - ProgramTest.createApplication - { onUrlRequest = Platform.LinkClicked - , onUrlChange = Platform.UrlChanged - , init = - \flags url () -> - Platform.init Main.config flags url Nothing - , update = - \msg model -> - Platform.update Main.config msg model - , view = - \model -> - Platform.view Main.config model - , onFormSubmit = - \formState -> - let - url : Url - url = - { path = "/login" -- TODO use current URL (unless the form overrides it) - , query = Nothing - , fragment = Nothing - , host = "localhost" - , port_ = Just 1234 - , protocol = Https - } - in - Platform.FetchPageData - (Just - { body = - formState - -- TODO url encode key and value (use shared helper, same one that elm-pages uses?) - -- TODO don't send ALL form state... send only the form state from the current form *AND* the button that was clicked to submit (if any) - |> Dict.toList - |> List.map (\( key, value ) -> key ++ "=" ++ value) - |> String.join "&" - , contentType = "application/x-www-form-urlencoded" - } - ) - url - (Platform.UpdateCacheAndUrlNew False url) - } - |> ProgramTest.withBaseUrl - ("https://localhost:1234" - ++ (responseSketchData - |> tupleSecond - |> Maybe.withDefault initialPath - ) - ) - |> ProgramTest.withSimulatedEffects (perform simulateEffect appRequestSimulator) - |> ProgramTest.start flagsWithData - - -tupleFirst : ( a, b, c ) -> a -tupleFirst ( a, b, c ) = - a - - -tupleSecond : ( a, b, c ) -> b -tupleSecond ( a, b, c ) = - b - - -tupleThird : ( a, b, c ) -> c -tupleThird ( a, b, c ) = - c - - -perform : - ((Main.Msg -> Platform.Msg Main.Msg Main.PageData Shared.Data) -> Effect Main.Msg -> ProgramTest.SimulatedEffect (Platform.Msg Main.Msg Main.PageData Shared.Data)) - -> DataSourceSimulator - -> ProgramTest.SimpleState - -> Platform.Effect Main.Msg Main.PageData Shared.Data (Effect Main.Msg) - -> ( Dict String String, ProgramTest.SimulatedEffect (Platform.Msg Main.Msg Main.PageData Shared.Data) ) -perform simulateEffect dataSourceSimulator testState effect = - case effect of - Platform.NoEffect -> - ( testState.cookieJar, SimulatedEffect.Cmd.none ) - - Platform.ScrollToTop -> - ( testState.cookieJar, SimulatedEffect.Cmd.none ) - - Platform.BrowserLoadUrl url -> - ( testState.cookieJar, SimulatedEffect.Navigation.load url ) - - Platform.BrowserPushUrl url -> - ( testState.cookieJar, SimulatedEffect.Navigation.pushUrl url ) - - Platform.Batch effects -> - let - all = - effects - |> List.map (perform simulateEffect dataSourceSimulator testState) - - allCookies : Dict String String - allCookies = - all - |> List.map Tuple.first - -- TODO should it be foldl or foldr - |> List.foldl Dict.union testState.cookieJar - - batchedEffects = - effects - |> List.map (perform simulateEffect dataSourceSimulator testState) - |> List.map Tuple.second - |> SimulatedEffect.Cmd.batch - in - ( allCookies - , batchedEffects - ) - - Platform.FetchPageData maybeRequestInfo url toMsg -> - let - newRoute : Maybe Route.Route - newRoute = - Main.config.urlToRoute url - - newThing : ( Dict String String, Maybe String, Main.PageData ) - newThing = - initialUrlOrRedirect Nothing - testState.cookieJar - testState - newRoute - dataSourceSimulator - maybeRequestInfo - - newThingMapped : ( Dict String String, Url, ResponseSketch.ResponseSketch Main.PageData Shared.Data ) - newThingMapped = - case newThing of - ( a, b, c ) -> - ( a - , b - |> Maybe.map toUrl - |> Maybe.withDefault url - , ResponseSketch.RenderPage c - ) - - msg : Result error ( Url, ResponseSketch.ResponseSketch Main.PageData Shared.Data ) - msg = - case newThingMapped of - ( _, b, c ) -> - Ok ( b, c ) - in - case newThing of - ( _, Just redirectToUrl, _ ) -> - ( testState.cookieJar - |> Dict.union (tupleFirst newThing) - , SimulatedEffect.Cmd.batch - [ SimulatedEffect.Task.succeed (msg |> toMsg) - |> SimulatedEffect.Task.perform identity - , SimulatedEffect.Navigation.pushUrl redirectToUrl - ] - ) - - _ -> - ( testState.cookieJar - |> Dict.union (tupleFirst newThing) - , SimulatedEffect.Task.succeed (msg |> toMsg) - |> SimulatedEffect.Task.perform identity - ) - - Platform.UserCmd cmd -> - ( testState.cookieJar - , simulateEffect Platform.UserMsg cmd - ) - - -initialUrlOrRedirect : - Maybe String - -> Dict String String - -> ProgramTest.SimpleState - -> Maybe Route.Route - -> DataSourceSimulator - -> Maybe Platform.RequestInfo - -> - ( Dict String String - , Maybe String - , Main.PageData - ) -initialUrlOrRedirect redirectedFrom cookiesSoFar testState newRoute dataSourceSimulator maybeRequestInfo = - let - newDataMock = - Pages.StaticHttpRequest.mockResolve - (Main.config.data newRoute) - (dataSourceSimulator cookiesSoFar testState maybeRequestInfo) - in - case newDataMock of - Ok (PageServerResponse.RenderPage info newPageData) -> - ( cookiesSoFar - |> Dict.union (getCookies info) - , redirectedFrom - , newPageData - ) - - Ok (PageServerResponse.ServerResponse info) -> - PageServerResponse.toRedirect info - |> Maybe.map - (\{ location } -> - location - ) - |> expectJust - |> (\location -> - initialUrlOrRedirect (Just location) - (cookiesSoFar |> Dict.union (getCookies info)) - testState - (Main.config.urlToRoute { path = location }) - dataSourceSimulator - -- Don't pass along the request payload to redirects - Nothing - ) - - _ -> - Debug.todo <| "Unhandled: " ++ Debug.toString newDataMock - - -getCookies : { a | headers : List ( String, String ) } -> Dict String String -getCookies info = - info.headers - |> List.filterMap - (\( key, value ) -> - if String.toLower key == "set-cookie" then - case - value - |> String.split ";" - |> List.head - |> Maybe.withDefault value - |> String.split "=" - of - [ setCookieKey, setCookieValue ] -> - Just ( setCookieKey, setCookieValue ) - - _ -> - Nothing - - else - Nothing - ) - |> Dict.fromList - - -expectJust : Maybe a -> a -expectJust maybeValue = - case maybeValue of - Just justThing -> - justThing - - Nothing -> - Debug.todo "Expected Just but got Nothing" - - -expectOk : Result error a -> a -expectOk thing = - case thing of - Ok okThing -> - okThing - - Err error -> - Debug.todo <| "Expected Ok but got Err " ++ Debug.toString error - - -toUrl : String -> Url -toUrl path = - { path = path - , query = Nothing - , fragment = Nothing - , host = "localhost" - , port_ = Just 1234 - , protocol = Https - }