|
| 1 | +module Main exposing (main) |
| 2 | + |
| 3 | +import Node |
| 4 | +import Stream exposing (Stream) |
| 5 | +import Node exposing (Environment, Program) |
| 6 | +import HttpServer as Http exposing (ServerError(..)) |
| 7 | +import HttpServer.Response as Response exposing (Response) |
| 8 | +import Init |
| 9 | +import Task |
| 10 | +import Url |
| 11 | + |
| 12 | + |
| 13 | +main : Program Model Msg |
| 14 | +main = |
| 15 | + Node.defineProgram |
| 16 | + { init = init |
| 17 | + , update = update |
| 18 | + , subscriptions = subscriptions |
| 19 | + } |
| 20 | + |
| 21 | + |
| 22 | +type alias Model = |
| 23 | + { stdout : Stream |
| 24 | + , stderr : Stream |
| 25 | + , server : Maybe Http.Server |
| 26 | + } |
| 27 | + |
| 28 | + |
| 29 | +type Msg |
| 30 | + = CreateServerResult (Result Http.ServerError Http.Server) |
| 31 | + | GotRequest Http.Request Response |
| 32 | + |
| 33 | + |
| 34 | +init : Environment -> Init.Task { model : Model, command : Cmd Msg } |
| 35 | +init env = |
| 36 | + Init.await Http.initialize <| \serverPermission -> |
| 37 | + Node.startProgram |
| 38 | + { model = |
| 39 | + { stdout = env.stdout |
| 40 | + , stderr = env.stderr |
| 41 | + , server = Nothing |
| 42 | + } |
| 43 | + , command = |
| 44 | + Task.attempt CreateServerResult <| |
| 45 | + Http.createServer serverPermission |
| 46 | + { host = "0.0.0.0" |
| 47 | + , port_ = 3000 |
| 48 | + } |
| 49 | + } |
| 50 | + |
| 51 | + |
| 52 | +update : Msg -> Model -> { model : Model, command : Cmd Msg } |
| 53 | +update msg model = |
| 54 | + case msg of |
| 55 | + CreateServerResult result -> |
| 56 | + case result of |
| 57 | + Ok server -> |
| 58 | + { model = { model | server = Just server } |
| 59 | + , command = Stream.sendLine model.stdout |
| 60 | + "Server started" |
| 61 | + } |
| 62 | + Err (ServerError code message) -> |
| 63 | + { model = model |
| 64 | + , command = Stream.sendLine model.stderr <| |
| 65 | + "Server failed to start: " ++ code ++ "\n" ++ message |
| 66 | + } |
| 67 | + |
| 68 | + GotRequest req res -> |
| 69 | + let |
| 70 | + body = |
| 71 | + Url.toString req.url |
| 72 | + in |
| 73 | + { model = model |
| 74 | + , command = |
| 75 | + res |
| 76 | + |> Response.setStatus 200 |
| 77 | + |> Response.setHeader "Content-type" "text/html" |
| 78 | + |> Response.setBody ("<html>" ++ body ++ "</html>") |
| 79 | + |> Response.send |
| 80 | + } |
| 81 | + |
| 82 | + |
| 83 | +subscriptions : Model -> Sub Msg |
| 84 | +subscriptions model = |
| 85 | + case model.server of |
| 86 | + Just server -> |
| 87 | + Http.onRequest server GotRequest |
| 88 | + |
| 89 | + Nothing -> |
| 90 | + Sub.none |
0 commit comments