Skip to content

Instantly share code, notes, and snippets.

@imdwit imdwit/Popup.elm Secret
Created Aug 24, 2019

Embed
What would you like to do?
port module Popup exposing (init, main, subscriptions, update, view)
import Browser exposing (Document)
import Data.Flags as Flags
import Data.Session exposing (SessionUpdate(..))
import Data.User as User
import Data.Utils as Utils
import Extension.PopUp as PopUp exposing (Model, initialModel) -- see bottom of file for PopUp.elm's source code
import Html exposing (..)
import Html.Attributes exposing (class, classList, for, href, id, placeholder, rel, target, type_)
import Html.Events exposing (onInput, onSubmit)
import Html.Extra as Html
import Json.Decode as D
import Json.Decode.Pipeline as JDP
import Json.Encode as E exposing (Value)
import Ports.Auth as Ports
import Process
import Task
import Utils
type Msg
= NoOp
| InputPassword String
| InputEmail String
| SubmitLogIn
| SessionMsg SessionUpdate
| GotHostname String
| SyncPopup Model
| RequestHostname
delay t msg =
Process.sleep t
|> Task.perform (\_ -> msg)
{-
these ports go out to popup.init.js
speaks to chrome api
-}
port extOut : Value -> Cmd msg
port extIn : (Value -> msg) -> Sub msg
toExtOut =
extOut << extOutEncoder
type ExtOutBound
= Sync Model
| GetHostname
extOutEncoder out =
case out of
Sync model ->
E.object
[ ( "popup", PopUp.encoder model )
, ( "tag", E.string "syncPopup" )
]
GetHostname ->
E.object [ ( "tag", E.string "getHostname" ) ]
init : Value -> ( Model, Cmd Msg )
init flags =
let
decodedFlags =
D.decodeValue PopUp.decoder flags
|> Result.withDefault PopUp.initialModel
in
( decodedFlags
, Utils.delay 1 RequestHostname
)
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
NoOp ->
( model, Cmd.none )
SubmitLogIn ->
( model
, Ports.loginWithPassword model.credentials
)
InputEmail email ->
let
creds =
model.credentials
credentials =
{ creds | email = email }
in
( { model | credentials = credentials }, Cmd.none )
InputPassword password ->
let
creds =
model.credentials
credentials =
{ creds | password = password }
in
( { model | credentials = credentials }, Cmd.none )
SessionMsg sessionUpdate ->
let
auth =
case sessionUpdate of
LogInResponse userAuth ->
User.Authed userAuth
_ ->
User.Anonymous
updatedModel =
{ model | auth = auth }
in
( updatedModel, Cmd.batch [ toExtOut (Sync updatedModel), toExtOut GetHostname ] )
GotHostname hostname ->
let
m =
{ model | hostname = Just hostname }
in
( m
, toExtOut <| Sync m
)
SyncPopup m ->
( m, Cmd.none )
RequestHostname ->
( model, toExtOut GetHostname )
view model =
{ title = "Vertol"
, body =
[ case model.auth of
User.Authed u ->
div [ class "px-4 py-4" ]
[ div []
[ Maybe.map (viewShit model.hostnames) model.hostname
|> Maybe.withDefault (text "")
]
]
User.Anonymous ->
viewLoginForm model
]
}
viewShit : List String -> String -> Html msg
viewShit hostnames hostname =
if List.member hostname hostnames then
div []
[ h2 [ class "font-semibold" ] [ text "You're all set." ]
, p [] [ text "You can now drag and drop your new images onto your old ones." ]
, p [ class "text-xs text-gray-700" ] [ text "hint: they should be glowing" ]
]
else
div []
[ p []
[ text "it doesn't look like `", text hostname, text "` is one of your projects" ]
, hr [] []
, p [] [ text "Your projects are: " ]
, ul [ class "mt-2" ] <|
List.map
(\hn ->
li []
[ a [ href <| "https://" ++ hn, target "_blank", rel "noopener" ] [ text hn ]
]
)
hostnames
]
viewLoginForm : Model -> Html Msg
viewLoginForm model =
Html.form
[ class "md:w-1/3 px-8 py-6 pb-8 shadow-md"
, onSubmit SubmitLogIn
]
[ div [ class "mb-4" ]
[ label [ class "text-grey-darker text-sm font-bold mb-1", for "email" ]
[ text "Email" ]
, input
[ class "py-2 px-3 shadow block w-full"
, type_ "email"
, placeholder "Email"
, id "email"
, onInput InputEmail
]
[]
]
, div [ class "mb-4" ]
[ label [ class "text-grey-darker text-sm font-bold mb-1", for "password" ]
[ text "Password" ]
, input
[ class "py-2 px-3 shadow block w-full"
, type_ "password"
, placeholder "Password"
, id "password"
, onInput InputPassword
]
[]
]
-- , session.authError
-- |> Maybe.map
-- (\err ->
-- p [ class "text-red mb-2" ] [ text err ]
-- )
-- |> Maybe.withDefault (text "")
, div [ class "mb-4 flex" ]
[ button
[ classList
[ ( "text-grey-darkest font-semibold py-2 px-4 border rounded shadow mr-auto"
, True
)
-- , ( "cursor-not-allowed bg-grey-lightest text-grey"
-- , session.submitStatus == Session.Processing
-- )
]
-- , disabled (session.submitStatus == Session.Processing)
]
[ text "Log In" ]
, a
[ class "self-center text-sm"
, href "https://vertol.io"
, target "_blank"
]
[ text "Dont have an account? Sign Up!" ]
]
]
decoder =
D.field "tag" D.string
|> D.andThen
(\tag ->
case tag of
"gotHostname" ->
D.succeed GotHostname
|> JDP.required "hostname" D.string
"broadcast" ->
D.succeed SyncPopup
|> JDP.required "payload" PopUp.decoder
_ ->
D.succeed NoOp
)
extInBound : a -> Sub Msg
extInBound _ =
extIn <|
\value ->
case D.decodeValue decoder value of
Ok NoOp ->
NoOp
Ok (GotHostname hostname) ->
GotHostname hostname
Ok (SyncPopup m) ->
SyncPopup m
Ok _ ->
NoOp
Err err ->
-- let
-- _ =
-- Debug.log "extinboudn error" err
-- in
NoOp
subscriptions : Model -> Sub Msg
subscriptions model =
Sub.batch
[ Sub.map SessionMsg <| Ports.authInBound ()
, extInBound ()
]
main =
Browser.document
{ init = init
, view = view
, update = update
, subscriptions = subscriptions
}
// INCLUDING PopUp.elm's source below since
module Extension.PopUp exposing (Model, decoder, encoder, initialModel)
import Data.Flags as Flags
import Data.User as User
import Json.Decode as D
import Json.Decode.Pipeline as JDP
import Json.Encode as E
import Json.Encode.Extra as E
type alias Model =
{ auth : User.AuthStatus
, credentials :
{ email : String
, password : String
}
, hostname : Maybe String
, hostnames : List String
}
initialModel =
{ auth = User.Anonymous
, credentials =
{ email = ""
, password = ""
}
, hostname = Nothing
, hostnames = []
}
encoder : Model -> E.Value
encoder m =
let
authStatus =
m.auth
|> User.toMaybe
in
E.object
[ ( "auth", E.maybe User.authEncoder authStatus )
, ( "hostname", E.maybe E.string m.hostname )
, ( "hostnames", E.list E.string m.hostnames )
]
decoder : D.Decoder Model
decoder =
D.succeed Model
|> JDP.required "auth"
(D.oneOf [ User.authedDecoder, User.anonDecoder ])
|> JDP.hardcoded { email = "", password = "" }
|> JDP.required "hostname" (D.nullable D.string)
|> JDP.required "hostnames" (D.list D.string)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.