module Component.Add where import Prelude hiding (div) import App (destroy, editBookmark) import Data.Array (drop, foldMap) import Data.Lens (Lens', lens, use, (%=), (.=)) import Data.Maybe (Maybe(..), maybe) import Data.Monoid (guard) import Data.String (null) import Data.String (split) as S import Data.String.Pattern (Pattern(..)) import Data.Tuple (fst, snd) import Effect.Aff (Aff) import Effect.Class (liftEffect) import Globals (app', closeWindow, mmoment8601) import Halogen as H import Halogen.HTML (HTML, br_, button, div, div_, form, input, label, p, span, table, tbody_, td, td_, text, textarea, tr_) import Halogen.HTML.Events (onSubmit, onValueChange, onChecked, onClick) import Halogen.HTML.Events as HE import Halogen.HTML.Properties (autofocus, ButtonType(..), InputType(..), autocomplete, checked, for, id_, name, required, rows, title, type_, value) import Model (Bookmark) import Util (_curQuerystring, _loc, _lookupQueryStringValue, attr, class_) import Web.Event.Event (Event, preventDefault) import Web.HTML (window) import Web.HTML.Location (setHref) data BQuery a = BEditField EditField a | BEditSubmit Event a | BDeleteAsk Boolean a | BDestroy a data EditField = Eurl String | Etitle String | Edescription String | Etags String | Eprivate Boolean | Etoread Boolean type BState = { bm :: Bookmark , edit_bm :: Bookmark , deleteAsk :: Boolean , destroyed :: Boolean } _bm :: Lens' BState Bookmark _bm = lens _.bm (_ { bm = _ }) _edit_bm :: Lens' BState Bookmark _edit_bm = lens _.edit_bm (_ { edit_bm = _ }) addbmark :: Bookmark -> H.Component HTML BQuery Unit Unit Aff addbmark b' = H.component { initialState: const (mkState b') , render , eval , receiver: const Nothing } where app = app' unit mkState b = { bm: b , edit_bm: b , deleteAsk: false , destroyed: false } render :: BState -> H.ComponentHTML BQuery render s@{ bm, edit_bm } = div_ [ if not s.destroyed then display_edit else display_destroyed ] where display_edit = form [ onSubmit (HE.input BEditSubmit) ] [ table [ class_ "w-100" ] [ tbody_ [ tr_ [ td [ class_ "w1" ] [ ] , td_ $ guard (bm.bid > 0) [ display_exists ] ] , 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_ [ input [ type_ InputText , id_ "title", class_ "w-100 mv1" , name "title" , value (edit_bm.title) , onValueChange (editField Etitle)] ] ] , 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 (HE.input_ (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 (HE.input_ (BDeleteAsk false))] [ text "cancel / " ] , button [ type_ ButtonButton, onClick (HE.input_ BDestroy), class_ "red" ] [ text "destroy" ] ] ] ] ] display_destroyed = p [ class_ "red"] [text "you killed this bookmark"] editField :: forall a. (a -> EditField) -> a -> Maybe (BQuery Unit) editField f = HE.input BEditField <<< f mmoment = mmoment8601 bm.time toTextarea = drop 1 <<< foldMap (\x -> [br_, text x]) <<< S.split (Pattern "\n") eval :: BQuery ~> H.ComponentDSL BState BQuery Unit Aff eval (BDeleteAsk e next) = do H.modify_ (_ { deleteAsk = e }) pure next eval (BDestroy next) = do bid <- H.gets _.bm.bid void $ H.liftAff (destroy bid) H.modify_ (_ { destroyed = true }) pure next eval (BEditField f next) = 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 } pure next eval (BEditSubmit e next) = do H.liftEffect (preventDefault e) edit_bm <- use _edit_bm void $ H.liftAff (editBookmark edit_bm) _bm .= edit_bm loc <- liftEffect _loc win <- liftEffect window qs <- liftEffect _curQuerystring case _lookupQueryStringValue qs "next" of Just n -> liftEffect (setHref n loc) _ -> liftEffect (closeWindow win) pure next