module Component.Add where import Prelude hiding (div) import Affjax (printError) import Affjax.StatusCode (StatusCode(..)) import App (destroy, editBookmark, lookupTitle) import Data.Either (Either(..)) import Data.Lens (Lens', lens, use, (%=), (.=)) import Data.Maybe (Maybe(..), fromMaybe, isJust, maybe) import Data.Monoid (guard) import Data.String (Pattern(..), null, stripPrefix) import Data.Tuple (fst, snd) import Effect.Aff (Aff) import Effect.Class (liftEffect) import Effect.Console (log) import Globals (closeWindow, mmoment8601) import Halogen as H import Halogen.HTML (button, div, form, input, label, p, span, table, tbody_, td, td_, text, textarea, tr_) import Halogen.HTML.Events (onSubmit, onValueChange, onChecked, onClick) import Halogen.HTML.Properties (ButtonType(..), InputType(..), autocomplete, autofocus, checked, disabled, for, id, name, required, rows, title, type_, value) import Model (Bookmark) import Util (_curQuerystring, _loc, _doc, _lookupQueryStringValue, attr, class_, ifElseH, whenH) import Web.Event.Event (Event, preventDefault) import Web.HTML (window) import Web.HTML.HTMLDocument (referrer) import Web.HTML.Location (setHref, origin) data BAction = BEditField EditField | BEditSubmit Event | BDeleteAsk Boolean | BLookupTitle | BDestroy data EditField = Eurl String | Etitle String | Edescription String | Etags String | Eprivate Boolean | Etoread Boolean type BState = { bm :: Bookmark , edit_bm :: Bookmark , deleteAsk :: Boolean , loading :: Boolean , destroyed :: Boolean , apiError :: Maybe String } _bm :: Lens' BState Bookmark _bm = lens _.bm (_ { bm = _ }) _edit_bm :: Lens' BState Bookmark _edit_bm = lens _.edit_bm (_ { edit_bm = _ }) _apiError :: Lens' BState (Maybe String) _apiError = lens _.apiError (_ { apiError = _ }) addbmark :: forall q i o. Bookmark -> H.Component q i o Aff addbmark b' = H.mkComponent { initialState: const (mkState b') , render , eval: H.mkEval $ H.defaultEval { handleAction = handleAction } } where mkState b = { bm: b , edit_bm: b , deleteAsk: false , destroyed: false , loading: false , apiError: Nothing } render :: forall m. BState -> H.ComponentHTML BAction () m render s@{ bm, edit_bm, apiError } = ifElseH (not s.destroyed) display_edit display_destroyed where display_edit _ = form [ onSubmit BEditSubmit ] [ table [ class_ "w-100" ] [ tbody_ [ tr_ [ td [ class_ "w1" ] [ ] , td_ [ whenH (bm.bid > 0) display_exists, whenH (isJust apiError) (alert_notification (fromMaybe "" apiError)) ] ] , tr_ [ td_ [ label [ for "url" ] [ text "URL" ] ] , td_ [ input [ type_ InputUrl , id "url", class_ "w-100 mv1" , required true, name "url", autofocus (null bm.url) , value (edit_bm.url) , onValueChange (editField Eurl)] ] ] , tr_ [ td_ [ label [ for "title" ] [ text "title" ] ] , td [class_ "flex"] [ input [ type_ InputText , id "title", class_ "w-100 mv1 flex-auto" , name "title" , value (edit_bm.title) , onValueChange (editField Etitle)] , button [ disabled s.loading, type_ ButtonButton, onClick \_ -> BLookupTitle, class_ ("ml2 input-reset ba b--navy pointer f6 di dim pa1 ma1 mr0 " <> guard s.loading "bg-light-silver") ] [ text "fetch" ] ] ] , tr_ [ td_ [ label [ for "description" ] [ text "description" ] ] , td_ [ textarea [ class_ "w-100 mt1 mid-gray" , id "description", name "description", rows 4 , value (edit_bm.description) , onValueChange (editField Edescription)] ] ] , tr_ [ td_ [ label [ for "tags" ] [ text "tags" ] ] , td_ [ input [ type_ InputText , id "tags", class_ "w-100 mv1" , name "tags", autocomplete false, attr "autocapitalize" "off", autofocus (not $ null bm.url) , value (edit_bm.tags) , onValueChange (editField Etags)] ] ] , tr_ [ td_ [ label [ for "private" ] [ text "private" ] ] , td_ [ input [ type_ InputCheckbox , id "private", class_ "private pointer" , name "private" , checked (edit_bm.private) , onChecked (editField Eprivate)] ] ] , tr_ [ td_ [ label [ for "toread" ] [ text "read later" ] ] , td_ [ input [ type_ InputCheckbox , id "toread", class_ "toread pointer" , name "toread" , checked (edit_bm.toread) , onChecked (editField Etoread)] ] ] , tr_ [ td_ [ ] , td_ [ input [ type_ InputSubmit , class_ "ph3 pv2 input-reset ba b--navy bg-transparent pointer f6 dib mt1 dim" , value (if bm.bid > 0 then "update bookmark" else "add bookmark") ] ] ] ] ] ] display_exists _ = div [ class_ "alert" ] [ text "previously saved " , span [ class_ "link f7 dib gray pr3" , title (maybe bm.time snd mmoment) ] [ text (maybe " " fst mmoment) ] , div [ class_ "edit_links dib ml1" ] [ div [ class_ "delete_link di" ] [ button ([ type_ ButtonButton, onClick \_ -> BDeleteAsk true, class_ "delete" ] <> guard s.deleteAsk [ attr "hidden" "hidden" ]) [ text "delete" ] , span ([ class_ "confirm red" ] <> guard (not s.deleteAsk) [ attr "hidden" "hidden" ]) [ button [ type_ ButtonButton, onClick \_ -> BDeleteAsk false] [ text "cancel / " ] , button [ type_ ButtonButton, onClick \_ -> BDestroy, class_ "red" ] [ text "destroy" ] ] ] ] ] alert_notification alert_text _ = div [ class_ "alert alert-err" ] [ text alert_text ] display_destroyed _ = p [ class_ "red"] [text "you killed this bookmark"] editField :: forall a. (a -> EditField) -> a -> BAction editField f = BEditField <<< f mmoment = mmoment8601 bm.time -- toTextarea = -- drop 1 -- <<< foldMap (\x -> [br_, text x]) -- <<< S.split (Pattern "\n") handleAction :: BAction -> H.HalogenM BState BAction () o Aff Unit handleAction (BDeleteAsk e) = do H.modify_ (_ { deleteAsk = e }) handleAction BLookupTitle = do H.modify_ (_ { loading = true }) edit_bm <- H.gets _.edit_bm mtitle <- H.liftAff $ lookupTitle edit_bm case mtitle of Just title' -> _edit_bm %= (_ { title = title' }) Nothing -> pure $ unit H.modify_ (_ { loading = false }) handleAction (BDestroy) = do bid <- H.gets _.bm.bid void $ H.liftAff (destroy bid) H.modify_ (_ { destroyed = true }) handleAction (BEditField f) = do _edit_bm %= case f of Eurl e -> _ { url = e } Etitle e -> _ { title = e } Edescription e -> _ { description = e } Etags e -> _ { tags = e } Eprivate e -> _ { private = e } Etoread e -> _ { toread = e } handleAction (BEditSubmit e) = do liftEffect (preventDefault e) edit_bm <- use _edit_bm _apiError .= Nothing H.liftAff (editBookmark edit_bm) >>= case _ of Left affErr -> do _apiError .= Just (printError affErr) liftEffect $ log (printError affErr) Right { status: StatusCode s } | s >= 200 && s < 300 -> do _bm .= edit_bm qs <- liftEffect $ _curQuerystring doc <- liftEffect $ _doc ref <- liftEffect $ referrer doc loc <- liftEffect $ _loc org <- liftEffect $ origin loc case _lookupQueryStringValue qs "next" of Just "closeWindow" -> liftEffect $ closeWindow =<< window Just "back" -> liftEffect $ case stripPrefix (Pattern org) ref of Just _ -> setHref ref loc Nothing -> setHref org loc _ -> liftEffect $ closeWindow =<< window Right res -> do _apiError .= Just (res.body) liftEffect $ log (res.body)