dillonkearns/elm-pages-v3-beta
1
1
Fork 0
mirror of https://github.com/dillonkearns/elm-pages-v3-beta.git synced 2025-01-01 16:36:19 +03:00
Code Issues Packages Projects Releases Wiki Activity

Set up more elm-program-test boilerplate.

Browse Source
This commit is contained in:
Dillon Kearns 2019-10-21 19:11:50 -07:00
parent b3d82b4688
commit 9a7373db33
2 changed files with 94 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

96
src/Pages/Internal/Platform/Cli.elm
View File

@ -29,7 +29,10 @@ import Url exposing (Url)
type Effect type Effect
= None = NoEffect
| SendJsData Json.Encode.Value
| FetchHttp StaticHttp.Request
| Batch (List Effect)
type alias Page metadata view pathKey = type alias Page metadata view pathKey =
@ -127,12 +130,16 @@ cliApplication cliMsgConstructor narrowMsg toModel fromModel config =
) )
in in
Platform.worker Platform.worker
{ init = init toModel contentCache siteMetadata config cliMsgConstructor { init =
\flags ->
init toModel contentCache siteMetadata config cliMsgConstructor flags
|> Tuple.mapSecond (perform cliMsgConstructor config.toJsPort)
, update = , update =
\msg model -> \msg model ->
case narrowMsg msg of case narrowMsg msg of
Just cliMsg -> Just cliMsg ->
update siteMetadata config cliMsg model update siteMetadata config cliMsg model
|> Tuple.mapSecond (perform cliMsgConstructor config.toJsPort)
Nothing -> Nothing ->
( model, Cmd.none ) ( model, Cmd.none )
@ -140,6 +147,35 @@ cliApplication cliMsgConstructor narrowMsg toModel fromModel config =
} }
perform : (Msg -> msg) -> (Json.Encode.Value -> Cmd Never) -> Effect -> Cmd msg
perform cliMsgConstructor toJsPort effect =
case effect of
NoEffect ->
Cmd.none
SendJsData value ->
toJsPort value |> Cmd.map never
Batch list ->
list
|> List.map (perform cliMsgConstructor toJsPort)
|> Cmd.batch
FetchHttp (StaticHttpRequest.Request { url }) ->
Http.get
{ url = url
, expect =
Http.expectString
(\response ->
GotStaticHttpResponse
{ url = url
, response = response
}
|> cliMsgConstructor
)
}
init toModel contentCache siteMetadata config cliMsgConstructor () = init toModel contentCache siteMetadata config cliMsgConstructor () =
( toModel Model ( toModel Model
, case contentCache of , case contentCache of
@ -163,14 +199,13 @@ init toModel contentCache siteMetadata config cliMsgConstructor () =
Err errors -> Err errors ->
Dict.empty Dict.empty
in in
config.toJsPort SendJsData
(Json.Encode.object (Json.Encode.object
[ ( "errors", encodeErrors pageErrors ) [ ( "errors", encodeErrors pageErrors )
, ( "manifest", Manifest.toJson config.manifest ) , ( "manifest", Manifest.toJson config.manifest )
, ( "pages", encodeStaticResponses staticResponses ) , ( "pages", encodeStaticResponses staticResponses )
] ]
) )
|> Cmd.map never
--(Msg userMsg metadata view) --(Msg userMsg metadata view)
Nothing -> Nothing ->
@ -191,24 +226,21 @@ init toModel contentCache siteMetadata config cliMsgConstructor () =
Err errors -> Err errors ->
Dict.empty Dict.empty
in in
Cmd.batch case requests of
[ case requests of Ok okRequests ->
Ok okRequests -> performStaticHttpRequests okRequests
performStaticHttpRequests okRequests
|> Cmd.map cliMsgConstructor
Err errors -> -- |> Cmd.map cliMsgConstructor
Cmd.none Err errors ->
] NoEffect
Err error -> Err error ->
config.toJsPort SendJsData
(Json.Encode.object (Json.Encode.object
[ ( "errors", encodeErrors error ) [ ( "errors", encodeErrors error )
, ( "manifest", Manifest.toJson config.manifest ) , ( "manifest", Manifest.toJson config.manifest )
] ]
) )
|> Cmd.map never
) )
@ -243,34 +275,38 @@ update siteMetadata config msg model =
Dict.empty Dict.empty
in in
( model ( model
, config.toJsPort , SendJsData
(Json.Encode.object (Json.Encode.object
[ ( "manifest", Manifest.toJson config.manifest ) [ ( "manifest", Manifest.toJson config.manifest )
, ( "pages", encodeStaticResponses staticResponses ) , ( "pages", encodeStaticResponses staticResponses )
] ]
) )
|> Cmd.map never
) )
performStaticHttpRequests : List ( PagePath pathKey, ( StaticHttp.Request, Decode.Value -> Result error value ) ) -> Cmd Msg performStaticHttpRequests : List ( PagePath pathKey, ( StaticHttp.Request, Decode.Value -> Result error value ) ) -> Effect
performStaticHttpRequests staticRequests = performStaticHttpRequests staticRequests =
-- @@@@@@@@ TODO
-- NoEffect
staticRequests staticRequests
|> List.map |> List.map
(\( pagePath, ( StaticHttpRequest.Request { url }, fn ) ) -> -- (\( pagePath, ( StaticHttpRequest.Request { url }, fn ) ) ->
Http.get (\( pagePath, ( request, fn ) ) ->
{ url = url -- Http.get
, expect = -- { url = url
Http.expectString -- , expect =
(\response -> -- Http.expectString
GotStaticHttpResponse -- (\response ->
{ url = url -- GotStaticHttpResponse
, response = response -- { url = url
} -- , response = response
) -- }
} -- )
-- }
-- NoEffect
FetchHttp request
) )
|> Cmd.batch |> Batch
staticResponsesInit : List ( PagePath pathKey, ( StaticHttp.Request, Decode.Value -> Result error value ) ) -> StaticResponses staticResponsesInit : List ( PagePath pathKey, ( StaticHttp.Request, Decode.Value -> Result error value ) ) -> StaticResponses

29
tests/StaticHttpRequestsTests.elm
View File

@ -1,4 +1,4 @@
module StaticHttpRequestsTests exposing (..) module StaticHttpRequestsTests exposing (all)
import Dict import Dict
import Html import Html
@ -11,6 +11,33 @@ import Pages.Manifest as Manifest
import Pages.PagePath as PagePath import Pages.PagePath as PagePath
import Pages.StaticHttp as StaticHttp import Pages.StaticHttp as StaticHttp
import ProgramTest exposing (ProgramTest) import ProgramTest exposing (ProgramTest)
import Test exposing (Test, describe, test)
all : Test
all =
describe "GrammarCheckingExample"
[ test "checking grammar" <|
\() ->
start
|> ProgramTest.done
-- |> ProgramTest.fillIn "main"
-- "Enter text to check"
-- "The youngest man the boat."
-- |> ProgramTest.clickButton "Check"
-- |> ProgramTest.ensureOutgoingPortValues
-- "checkGrammar"
-- Json.Decode.string
-- (Expect.equal [ "The youngest man the boat." ])
-- |> ProgramTest.simulateIncomingPort
-- "grammarCheckResults"
-- (Json.Encode.list Json.Encode.string
-- [ "Garden-path sentences can confuse the reader." ]
-- )
-- |> ProgramTest.expectViewHas
-- [ text "Garden-path sentences can confuse the reader." ]
]
start : ProgramTest Main.Model Main.Msg Main.Effect start : ProgramTest Main.Model Main.Msg Main.Effect