TaskPorts.elm

module Main exposing (main)

import Browser
import Html exposing (Html, button, div, input, pre, text)
import Html.Attributes exposing (type_, value)
import Html.Events exposing (onClick, onInput)
import Http
import Json.Decode as JD exposing (Decoder)
import Json.Encode as JE exposing (Value)
import Task exposing (Task)
import Url



-- Task ports!


getCryptoRandom : Task TaskPortError Int
getCryptoRandom =
    getFromJs "getCryptoRandom " JD.int


alert : String -> Task TaskPortError ()
alert string =
    sendToJs "alert" (JE.string string)


getRandAndAlert : Task TaskPortError ()
getRandAndAlert =
    -- We can easily chain task ports!
    getCryptoRandom
        |> Task.map (\n -> "You got " ++ String.fromInt n ++ " from JS")
        |> Task.andThen alert


calculateFibonacci : Int -> Task TaskPortError Int
calculateFibonacci n =
    callJs 5000 "fib" (JE.int n) JD.int



-- Model


type alias Model =
    { fibInput : String, fibResult : Maybe Int, randInt : Maybe Int, error : Maybe TaskPortError }


initModel : Model
initModel =
    { fibInput = "4", fibResult = Nothing, randInt = Nothing, error = Nothing }



-- Update


type Msg
    = GetFib
    | GetRandom
    | AlertRandom
    | GotFib Int
    | GotRandom Int
    | Error TaskPortError
    | SetFibInput String
    | NoOp ()


update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
    let
        resToMsg constructor res =
            case res of
                Ok n ->
                    constructor n

                Err e ->
                    Error e
    in
    case msg of
        GetFib ->
            ( model
            , calculateFibonacci (String.toInt model.fibInput |> Maybe.withDefault 0)
                |> Task.attempt (resToMsg GotFib)
            )

        GetRandom ->
            ( model, getCryptoRandom |> Task.attempt (resToMsg GotRandom) )

        AlertRandom ->
            ( model, getRandAndAlert |> Task.attempt (resToMsg NoOp) )

        GotFib n ->
            ( { model | fibResult = Just n }, Cmd.none )

        GotRandom n ->
            ( { model | randInt = Just n }, Cmd.none )

        Error err ->
            ( { model | error = Just err }, Cmd.none )

        SetFibInput newN ->
            ( { model | fibInput = newN }, Cmd.none )

        NoOp _ ->
            ( model, Cmd.none )



-- View


view : Model -> Html Msg
view model =
    div []
        [ div []
            [ text "Fibbonacci("
            , input [ onInput SetFibInput, value model.fibInput, type_ "number" ] [ text model.fibInput ]
            , text (") = " ++ optionalInt model.fibResult)
            , button [ onClick GetFib ] [ text "Calculate" ]
            ]
        , div []
            [ text ("Crypto random int: " ++ optionalInt model.randInt)
            , button [ onClick GetRandom ] [ text "Get new one" ]
            ]
        , div []
            [ button [ onClick AlertRandom ] [ text "Show crypto random in alert" ]
            ]
        , case model.error of
            Just err ->
                pre [] [ text ("Error:\n\n" ++ Debug.toString err) ]

            Nothing ->
                text ""
        ]


optionalInt : Maybe Int -> String
optionalInt m =
    case m of
        Just n ->
            String.fromInt n

        Nothing ->
            "?"



-- Main


main : Program () Model Msg
main =
    Browser.element
        { init = \flags -> ( initModel, Cmd.none )
        , view = view
        , subscriptions = \model -> Sub.none
        , update = update
        }



---
-- Task ports module
---


type TaskPortError
    = JavaScriptError String
    | NoTaskPortDefined String
    | BadResponse JD.Error
    | Timeout


defaultTimeout =
    5 * 1000


getFromJs : String -> Decoder result -> Task TaskPortError result
getFromJs portName resultDecoder =
    callJs defaultTimeout portName JE.null resultDecoder


sendToJs : String -> Value -> Task TaskPortError ()
sendToJs portName value =
    callJs defaultTimeout portName value (JD.succeed ())


callJs : Float -> String -> Value -> Decoder result -> Task TaskPortError result
callJs timeout portName value resultDecoder =
    let
        otherError =
            Err (JavaScriptError "Some error happened in the TaskPorts library, you might want to open an issue.")

        decodeRes =
            JD.map2 Tuple.pair (JD.field "type" JD.string) (JD.field "data" JD.string)

        decodeError =
            JD.field "type" JD.string
                |> JD.andThen
                    (\kind ->
                        case kind of
                            "JsError" ->
                                JD.field "error" JD.string
                                    |> JD.map JavaScriptError

                            "NoTaskPortDefined" ->
                                JD.field "name" JD.string
                                    |> JD.map NoTaskPortDefined

                            "Timeout" ->
                                JD.succeed Timeout

                            _ ->
                                JD.fail ""
                    )

        toResult res =
            case res of
                Http.GoodStatus_ meta_ body ->
                    case JD.decodeString decodeRes body of
                        Ok ( "Result", data ) ->
                            case JD.decodeString resultDecoder data of
                                Ok result ->
                                    Ok result

                                Err e ->
                                    Err (BadResponse e)

                        Ok ( "Error", data ) ->
                            case JD.decodeString decodeError data of
                                Ok err ->
                                    Err err

                                _ ->
                                    otherError

                        _ ->
                            otherError

                _ ->
                    otherError
    in
    Http.task
        { method = "GET"
        , headers = []
        , url = "jsCall:" ++ portName
        , body = Http.stringBody "" (JE.encode 0 value)
        , resolver = Http.stringResolver toResult
        , timeout = Just timeout
        }

<html>
<head>
</head>
<body>
  <main></main>
  <script>
  const main = () => {
      TaskPorts.define("getCryptoRandom", (_, callback) => {
        let buf = new Uint32Array(1);
        window.crypto.getRandomValues(buf);
        callback(buf[0]);
      });
      TaskPorts.define("alert", (value, callback) => {
        // We immediately call ok here, otherwise we might run into a timeout
        callback();
        alert(value);
      });
      TaskPorts.define("fib", (n, callback) => {
        const res = Math.round(
          (Math.pow((1 + Math.sqrt(5)) / 2, n) -
            Math.pow(-2 / (1 + Math.sqrt(5)), n)) /
            Math.sqrt(5)
        );
        callback(res);
      });
      const app = Elm.Main.init({ node: document.querySelector('main') });
  };
    


    
    
    
    
    
    
    
    
    
    
// HACK
var TaskPorts = (function() {
  //==========
  // Public interface

  var subscriptions = {};
  function define(name, fn) {
    subscriptions[name] = fn;
  }
  function undefine(name) {
    delete subscriptions[name];
  }
  //=========

  //=========
  // Hackery
  //
  // Here's Elm's Http implementation: https://github.com/elm/http/blob/2.0.0/src/Elm/Kernel/Http.js
  // This article also helped me a lot: https://www.sitepoint.com/pragmatic-monkey-patching/
  //

  // Keep a reference to the original methods here
  var oAddE = XMLHttpRequest.prototype.addEventListener;
  var oSend = XMLHttpRequest.prototype.send;
  var oOpen = XMLHttpRequest.prototype.open;

  // Keep track of the "load" callback
  XMLHttpRequest.prototype.addEventListener = function(event, fn) {
    if (event === "load") {
      this._load = fn;
    }
    return oAddE.apply(this, arguments);
  };

  // If we get an URL starting with 'jsCall:' we know this comes from Elm, so we should intercept it.
  XMLHttpRequest.prototype.open = function(_method, url) {
    if (url) {
      var colonPos = url.indexOf(":");
      var first = url.substring(0, colonPos);
      var fnName = url.substring(colonPos + 1);
      if (first === "jsCall") {
        // mark our object for later
        this._jsCall = true;
        this._fnName = fnName;
        return;
      }
    }
    return oOpen.apply(this, arguments);
  };

  // Here we call the defined task port and send the result to Elm
  XMLHttpRequest.prototype.send = function(data) {
    if (this._jsCall) {
      // We can't set these properties directly here, because they are read only.
      // But with Object.defineProperty it works ;)
      Object.defineProperty(this, "status", { value: 200 });

      var args = JSON.parse(data);
      var f = subscriptions[this._fnName];
      if (f) {
        try {
          // start the timer
          this._timer = setTimeout(
            function() {
              reportError(this, "Timeout", {});
            }.bind(this),
            this.timeout
          );

          f(
            args,
            function(result) {
              if (this._done) return;
              clearTimeout(this._timer);

              // send over result
              if (result === undefined) {
                result = null;
              }
              var res = { type: "Result", data: JSON.stringify(result) };
              Object.defineProperty(this, "response", {
                value: JSON.stringify(res)
              });
              this._done = true;
              this._load();
            }.bind(this)
          );
        } catch (e) {
          var err = JSON.stringify(e, Object.getOwnPropertyNames(e));
          reportError(this, "JsError", { error: err });
        }
      } else {
        reportError(this, "NoTaskPortDefined", { name: this._fnName });
      }
      return;
    }
    return oSend.apply(this, arguments);
  };

  // Report errors to Elm
  function reportError(obj, type, data) {
    if (obj._done) return;
    clearTimeout(obj._timer);

    data.type = type;
    var error = { type: "Error", data: JSON.stringify(data) };
    Object.defineProperty(obj, "response", { value: JSON.stringify(error) });
    obj._done = true;
    obj._load();
  }
  //=========

  return {
    define: define,
    undefine: undefine
  };
})();

    
main();
  </script>
</body>
</html>