packages feed

espial-0.0.3: purs/src/BMark.purs

module BMark where

import Prelude

import App (fetchUrlEnc)
import Control.Monad.Maybe.Trans (runMaybeT)
import Control.Monad.Trans.Class (lift)
import Data.Array (mapMaybe, filter)
import Data.Foldable (for_, traverse_)
import Data.FormURLEncoded (FormURLEncoded(..))
import Data.HTTP.Method (Method(..))
import Data.Maybe (Maybe(..), fromMaybe)
import Data.String (Pattern(..), Replacement(..), joinWith, length, replaceAll, split, take, trim)
import Data.Traversable (for, traverse)
import Data.Tuple (Tuple(..))
import Effect (Effect)
import Effect.Aff (Aff, launchAff)
import Effect.Class (liftEffect)
import Effect.Class.Console (log)
import Globals (closest, createFormArray, getDataAttribute, innerHtml, moment8601, setInnerHtml)
import Network.HTTP.Affjax (AffjaxResponse)
import Network.HTTP.Affjax.Response as AXRes
import Util (_body, _doc, _fromElement, _fromNode, _getElementById, _mt, _mt_pure, _queryBoth, _queryBoth', _querySelector, _querySelectorAll)
import Web.DOM (Node)
import Web.DOM.ChildNode (remove) as DCN
import Web.DOM.DOMTokenList (contains, toggle, toggleForce, remove, add) as DTL
import Web.DOM.Document (createElement)
import Web.DOM.Element (removeAttribute, setAttribute, setClassName, toChildNode, toNode)
import Web.DOM.Node (appendChild, deepClone, fromEventTarget, insertBefore, setTextContent, textContent)
import Web.Event.Event (Event, preventDefault, target)
import Web.HTML.HTMLDocument (toDocument)
import Web.HTML.HTMLElement (classList, fromNode, toElement) as HE
import Web.HTML.HTMLFormElement (fromNode) as HFE
import Web.HTML.HTMLInputElement (fromElement, setValue, value, setChecked, checked) as HIE
import Web.HTML.HTMLTextAreaElement (fromElement, setValue, value) as HTAE

-- replaceIsoTimestamps

replaceIsoTimestamps :: Unit -> Effect Unit
replaceIsoTimestamps u = do
  body <- _body 
  xs <- _querySelectorAll ".js-moment" (HE.toElement body)
  for_ xs \x -> do
    getDataAttribute "iso8601" (_fromNode x) >>= \s' ->
      for_ s' \s -> do
        Tuple rel fmt <- moment8601 s
        setTextContent rel x 
        setAttribute "title" fmt (_fromNode x)
        setAttribute "style" "visibility:visible" (_fromNode x)

-- deleteAskE

deleteAskE :: Event -> Effect Unit
deleteAskE e = do
  preventDefault e
  traverse_ (toggleDelete true) (fromEventTarget =<< target e)

-- deleteCancelE

deleteCancelE :: Event -> Effect Unit
deleteCancelE e = do
  preventDefault e
  traverse_ (toggleDelete false) (fromEventTarget =<< target e)

toggleDelete :: Boolean -> Node -> Effect Unit
toggleDelete toggle n = void $ runMaybeT $ do
  dl <- _mt $ closest ".delete_link" n
  c <- _mt $ _querySelector ".confirm" (_fromNode dl)
  d <- _mt $ _querySelector ".delete" (_fromNode dl)
  lift $ removeAttribute "hidden" (if toggle then c else d)
  lift $ setAttribute "hidden" "hidden" (if not toggle then c else d)


-- destroyE

destroyE :: Event -> Int -> Boolean -> Effect Unit
destroyE e bid isPopup = do
  preventDefault e
  void $ launchAff $ do
    void $ destroy bid
    liftEffect $ 
      if isPopup
        then removeBody unit
        else removeBookmarkNode unit
  where
    removeBody _ = do
      body <- _body 
      void $ setInnerHtml "<p class=\'error\'>you killed this bookmark</p>" body 
    removeBookmarkNode _ =
      void $ runMaybeT $ do
        eNode <- _mt_pure $ fromEventTarget =<< target e
        bm <- _mt $ closest ".bookmark" eNode
        lift $ DCN.remove (toChildNode (_fromNode bm))

destroy :: Int -> Aff (AffjaxResponse Unit)
destroy bid =
  fetchUrlEnc DELETE ("bm/" <> show bid) Nothing AXRes.ignore

-- markReadE

markReadE :: Event -> Int -> Effect Unit
markReadE e bid = do
  preventDefault e
  void $ launchAff $ do
    void $ markRead bid
    liftEffect $ runMaybeT $ do
      eNode <- _mt_pure $ fromEventTarget =<< target e
      removeUnreadClass eNode
      removeReadNode eNode
  where
    removeUnreadClass eNode = do
      bm <- _mt $ closest ".bookmark" eNode 
      bt <- _mt $ _querySelector ".bookmark_title" (_fromNode bm)
      lift $ HE.classList (_fromElement bt) >>= (_ `DTL.remove` "unread")
    removeReadNode eNode = do
      rd <- _mt $ closest ".mark_read" eNode 
      lift $ DCN.remove (toChildNode (_fromNode rd))

markRead :: Int -> Aff (AffjaxResponse Unit)
markRead bid = do
  let path = "bm/" <> show bid <> "/read"
  fetchUrlEnc POST path Nothing AXRes.ignore

-- toggleStarE
  
data StarAction = Star | UnStar
instance showStar :: Show StarAction where
  show Star = "star"
  show UnStar = "unstar"

toggleStarE :: Event -> Int -> Effect Unit
toggleStarE e bid = do
  preventDefault e
  mstarEl <- runMaybeT $ do
    eNode <- _mt_pure $ fromEventTarget =<< target e
    starNode <- _mt $ closest ".star" eNode 
    _mt_pure $ HE.fromNode starNode
  for_ mstarEl \starEl -> do
    starClassList <- HE.classList starEl
    let selected_star = "selected_star"
    hasSelectedStar <- starClassList `DTL.contains` selected_star
    void $ launchAff $ toggleStar bid (if hasSelectedStar then UnStar else Star)
    void $ DTL.toggle starClassList selected_star

toggleStar :: Int -> StarAction -> Aff Unit
toggleStar bid action = do
  let path = "bm/" <> show bid <> "/" <> show action
  void $ fetchUrlEnc POST path Nothing AXRes.ignore

-- editHideE

editHideE :: Event -> Effect Unit
editHideE e = do
  preventDefault e
  body <- _body 
  showDisplay (HE.toElement body)
  removeEdit (HE.toElement body)
  where
    showDisplay body = do
      xs <- _querySelectorAll ".display" body
      for_ xs $ _fromNode >>> removeAttribute "hidden" 
    removeEdit body = do
      xs <- _querySelectorAll ".edit_bookmark_form.active" body
      for_ xs $ _fromNode >>> (toChildNode >>> DCN.remove) 


editE :: Event -> Int -> Effect Unit
editE e bid = do
  editHideE e
  body <- _body 
  doc <- _doc
  void $ runMaybeT $ do
    t <- _mt_pure $ fromEventTarget =<< target e
    bm <- _mt $ (map >>> map) _fromNode (closest ".bookmark" t)
    d <- _mt $ _querySelector ".display" bm
    el' <- _mt $ _getElementById "edit_bookmark_form_template" doc
    lift $ do
      el <- deepClone (toNode el')
      let ele = _fromNode el

      removeAttribute "id" ele
      removeAttribute "hidden" ele

      HE.classList (_fromElement ele) >>= (_ `DTL.add` "active")

      _querySelector "input[name=bid]" ele >>= \me ->
        for_ (me >>= HIE.fromElement) (HIE.setValue (show bid))

      _queryBoth (Tuple ".url" ele) (Tuple ".url_display" bm) \a b -> do
        url <- textContent (toNode b)
        for_ (HIE.fromElement a) (HIE.setValue (trim url))

      _queryBoth (Tuple ".title" ele) (Tuple ".bookmark_title" bm) \a b -> do
        title <- textContent (toNode b)
        for_ (HIE.fromElement a) (HIE.setValue (trim title))

      _queryBoth (Tuple ".description" ele) (Tuple ".description" bm) \a b -> do
        descr <- innerHtml (_fromElement b)
        let descr' = trim $ replaceAll (Pattern "<br>") (Replacement "\n") descr
        for_ (HTAE.fromElement a) (HTAE.setValue descr')

      _queryBoth' (Tuple ".tags" ele) (Tuple ".tag" bm) \a bs -> do
        tags <- traverse textContent bs
        for_ (HIE.fromElement a) (HIE.setValue (joinWith " " tags))

      _querySelector "input[name=private]" ele >>= \me -> do
        isPrivate <- HE.classList (_fromElement bm) >>= (_ `DTL.contains` "private")
        for_ (me >>= HIE.fromElement) (HIE.setChecked isPrivate)

      _queryBoth (Tuple "input[name=toread]" ele) (Tuple ".read .mark_read" bm) \a _ -> do
        for_ (HIE.fromElement a) (HIE.setChecked true)

      setAttribute "hidden" "hidden" d
      void $ insertBefore el (toNode d) (toNode bm)

editSubmitE :: Event -> Effect Unit
editSubmitE e = do
  preventDefault e
  body <- _body 
  doc <- _doc
  void $ runMaybeT $ do
    f <- _mt_pure $ fromEventTarget =<< target e
    let fe = _fromNode f
    fe' <- _mt_pure $ HFE.fromNode f
    bm <- _mt $ (map >>> map) _fromNode (closest ".bookmark" f)
    d <- _mt $ _querySelector ".display" bm
  
    lift $ launchAff $ do
      let dat = Just $ FormURLEncoded $ mapMaybe _mpair (createFormArray fe')
      void $ fetchUrlEnc POST "add?inline=true" dat AXRes.ignore
      liftEffect $ do

        toread <- _querySelector "input[name=toread]" fe >>= \me -> do
          for (me >>= HIE.fromElement) HIE.checked >>= fromMaybe false >>> pure

        private <- _querySelector "input[name=private]" fe >>= \me -> do
          for (me >>= HIE.fromElement) HIE.checked >>= fromMaybe false >>> pure

        _queryBoth (Tuple ".url" fe) (Tuple ".url_display" d) \a b -> do
          url <- for (HIE.fromElement a) HIE.value >>= fromMaybe "" >>> pure
          setTextContent url (toNode b) 

        _queryBoth (Tuple ".title" fe) (Tuple ".bookmark_title" d) \a b -> do
          title <- for (HIE.fromElement a) HIE.value >>= fromMaybe "" >>> pure
          setTextContent title (toNode b) 
          void $ HE.classList (_fromElement b) >>= \cl -> DTL.toggleForce cl "unread" toread
  
        _queryBoth (Tuple ".description" fe) (Tuple ".description" d) \a b -> do
          descr <- for (HTAE.fromElement a) HTAE.value >>= fromMaybe "" >>> pure
          let descr' = trim $ replaceAll (Pattern "\n") (Replacement "<br>") descr
          void $ setInnerHtml descr' (_fromElement b) 
  
        void $ HE.classList (_fromElement bm) >>= \cl -> DTL.toggleForce cl "private" private

        username <- _querySelector ".banner_username" (HE.toElement body) >>= \me -> do
          join <$> for me (getDataAttribute "username") >>= fromMaybe "" >>> pure

        _queryBoth (Tuple ".tags" fe) (Tuple ".tags" d) \a b -> do
          void $ setInnerHtml "" (_fromElement b)
          tags <- for (HIE.fromElement a) HIE.value >>= fromMaybe "" >>> pure
          for_ (words tags) \w -> do
            tag <- createElement "a" (toDocument doc)
            setClassName ("tag" <> (if take 1 w == "." then " private" else "")) tag
            setAttribute "href" ("/u:" <> username <> "/t:" <> w) tag
            setTextContent w (toNode tag)
            appendChild (toNode tag) (toNode b)

        _querySelector ".read" d >>= \me -> do
          for_ me \m -> do
            void $ setInnerHtml "" (_fromElement m)
            when toread $ do
              bid <- getDataAttribute "bid" bm >>= fromMaybe "" >>> pure
              log (bid)
              el <- createElement "a" (toDocument doc)
              setClassName "mark_read" el
              setAttribute "href" "#" el
              setAttribute "onclick" ("PS['BMark'].markReadE(event)(" <> bid <> ")();") el
              setTextContent "mark as read" (toNode el)
              void $ appendChild (toNode el) (toNode m)

        editHideE e
  where
    words = filter ((0 < _) <<< length) <<< split (Pattern " ")
    _mpair = case _ of
      [k, v] -> Just $ Tuple k (Just v)
      _ -> Nothing