module TestState exposing (TestState, advanceTime, drain, fillInField, queueEffect, routeChangeHelper, simulateLoadUrlHelper, update, withSimulation) import Dict exposing (Dict) import PairingHeap import ProgramTest.EffectSimulation as EffectSimulation exposing (EffectSimulation) import ProgramTest.Failure exposing (Failure(..)) import ProgramTest.Program exposing (Program) import SimulatedEffect exposing (SimulatedEffect, SimulatedSub) import String.Extra import Url exposing (Url) import Url.Extra {-| TODO: what's a better name? -} type alias TestState model msg effect = { currentModel : model , lastEffect : effect , navigation : Maybe { currentLocation : Url , browserHistory : List Url } , effectSimulation : Maybe (EffectSimulation msg effect) , domFields : Dict String String , cookieJar : Dict String String } update : msg -> Program model msg effect sub -> TestState model msg effect -> Result Failure (TestState model msg effect) update msg program state = let ( newModel, newEffect ) = program.update msg state.currentModel in { state | currentModel = newModel , lastEffect = newEffect } |> queueEffect program newEffect |> Result.andThen (drain program) queueEffect : Program model msg effect sub -> effect -> TestState model msg effect -> Result Failure (TestState model msg effect) queueEffect program effect state = case state.effectSimulation of Nothing -> Ok state Just simulation -> let simpleState : SimpleState simpleState = { navigation = state.navigation , domFields = state.domFields , cookieJar = state.cookieJar } ( newCookieJar, newEffect ) = simulation.deconstructEffect simpleState effect in queueSimulatedEffect program newEffect { state | cookieJar = newCookieJar } type alias SimpleState = { navigation : Maybe { currentLocation : Url , browserHistory : List Url } , domFields : Dict String String , cookieJar : Dict String String } queueSimulatedEffect : Program model msg effect sub -> SimulatedEffect msg -> TestState model msg effect -> Result Failure (TestState model msg effect) queueSimulatedEffect program effect state = case state.effectSimulation of Nothing -> Ok state Just simulation -> case effect of SimulatedEffect.None -> Ok state SimulatedEffect.Batch effects -> List.foldl (\ef -> Result.andThen (queueSimulatedEffect program ef)) (Ok state) effects SimulatedEffect.Task t -> Ok { state | effectSimulation = Just (EffectSimulation.queueTask t simulation) } SimulatedEffect.PortEffect portName value -> Ok { state | effectSimulation = Just { simulation | outgoingPortValues = Dict.update portName (Maybe.withDefault [] >> (::) value >> Just) simulation.outgoingPortValues } } SimulatedEffect.PushUrl url -> routeChangeHelper ("simulating effect: SimulatedEffect.Navigation.pushUrl " ++ String.Extra.escape url) 0 url program state SimulatedEffect.ReplaceUrl url -> routeChangeHelper ("simulating effect: SimulatedEffect.Navigation.replaceUrl " ++ String.Extra.escape url) 1 url program state SimulatedEffect.Back n -> case state.navigation of Nothing -> Ok state Just { currentLocation, browserHistory } -> if n <= 0 then Ok state else case List.head (List.drop (n - 1) browserHistory) of Nothing -> -- n is bigger than the history; -- in this case, browsers ignore the request Ok state Just first -> routeChangeHelper ("simulating effect: SimulatedEffect.Navigation.Back " ++ String.fromInt n) 2 (Url.toString first) program state SimulatedEffect.Load url -> Err (simulateLoadUrlHelper ("simulating effect: SimulatedEffect.Navigation.load " ++ url) url state) SimulatedEffect.Reload skipCache -> let functionName = if skipCache then "reloadAndSkipCache" else "reload" in case state.navigation of Nothing -> Err (ProgramDoesNotSupportNavigation functionName) Just { currentLocation } -> Err (ChangedPage ("simulating effect: SimulatedEffect.Navigation." ++ functionName) currentLocation) simulateLoadUrlHelper : String -> String -> TestState model msg effect -> Failure simulateLoadUrlHelper functionDescription href state = case Maybe.map .currentLocation state.navigation of Just location -> ChangedPage functionDescription (Url.Extra.resolve location href) Nothing -> case Url.fromString href of Nothing -> NoBaseUrl functionDescription href Just location -> ChangedPage functionDescription location routeChangeHelper : String -> Int -> String -> Program model msg effect sub -> TestState model msg effect -> Result Failure (TestState model msg effect) routeChangeHelper functionName removeFromBackStack url program state = case state.navigation of Nothing -> Err (ProgramDoesNotSupportNavigation functionName) Just { currentLocation, browserHistory } -> let newLocation = Url.Extra.resolve currentLocation url processRouteChange = case program.onRouteChange newLocation of Nothing -> Ok Just msg -> -- TODO: should this be set before or after? update msg program in { state | navigation = Just { currentLocation = newLocation , browserHistory = (currentLocation :: browserHistory) |> List.drop removeFromBackStack } } |> processRouteChange drain : Program model msg effect sub -> TestState model msg effect -> Result Failure (TestState model msg effect) drain program = let advanceTimeIfSimulating t state = case state.effectSimulation of Nothing -> Ok state Just _ -> advanceTime "" t program state in advanceTimeIfSimulating 0 >> Result.andThen (drainWorkQueue program) drainWorkQueue : Program model msg effect sub -> TestState model msg effect -> Result Failure (TestState model msg effect) drainWorkQueue program state = case state.effectSimulation of Nothing -> Ok state Just simulation -> case EffectSimulation.stepWorkQueue simulation of Nothing -> -- work queue is empty Ok state Just ( newSimulation, msg ) -> let updateMaybe tc = case msg of Nothing -> Ok tc Just m -> update m program tc in { state | effectSimulation = Just newSimulation } |> updateMaybe |> Result.andThen (drain program) advanceTime : String -> Int -> Program model msg effect sub -> TestState model msg effect -> Result Failure (TestState model msg effect) advanceTime functionName delta program state = case state.effectSimulation of Nothing -> Err (EffectSimulationNotConfigured functionName) Just simulation -> advanceTo program functionName (simulation.state.nowMs + delta) state advanceTo : Program model msg effect sub -> String -> Int -> TestState model msg effect -> Result Failure (TestState model msg effect) advanceTo program functionName end state = case state.effectSimulation of Nothing -> Err (EffectSimulationNotConfigured functionName) Just simulation -> let ss = simulation.state in case PairingHeap.findMin simulation.state.futureTasks of Nothing -> -- No future tasks to check Ok { state | effectSimulation = Just { simulation | state = { ss | nowMs = end } } } Just ( t, task ) -> if t <= end then Ok { state | effectSimulation = Just { simulation | state = { ss | nowMs = t , futureTasks = PairingHeap.deleteMin simulation.state.futureTasks } } } |> Result.map (withSimulation (EffectSimulation.queueTask (task ()))) |> Result.andThen (drain program) |> Result.andThen (advanceTo program functionName end) else -- next task is further in the future than we are advancing Ok { state | effectSimulation = Just { simulation | state = { ss | nowMs = end } } } withSimulation : (EffectSimulation msg effect -> EffectSimulation msg effect) -> TestState model msg effect -> TestState model msg effect withSimulation f state = { state | effectSimulation = Maybe.map f state.effectSimulation } fillInField : String -> String -> TestState model msg effect -> TestState model msg effect fillInField name value state = { state | domFields = state.domFields |> Dict.insert name value |> Debug.log "newState" }