module PureTabs.Sidebar where
import Browser.Runtime as Runtime
import Browser.Tabs (Tab(..), TabId, WindowId)
import Browser.Tabs.OnUpdated (ChangeInfo(..))
import Browser.Windows (getCurrent)
import Control.Alternative (pure)
import Control.Bind ((>=>), (>>=))
import Data.CommutativeRing ((+))
import Data.Eq ((==))
import Data.Foldable (traverse_)
import Data.Function (flip)
import Data.Maybe (Maybe(..), maybe)
import Data.Monoid ((<>))
import Data.Show (show)
import Data.Unit (unit)
import Debug.Trace (traceM)
import Effect (Effect)
import Effect.Aff (Aff, launchAff_)
import Effect.Class (liftEffect)
import Effect.Console (log)
import JQuery as J
import JQuery.Ext (after) as J
import Prelude (Unit, bind, ($), discard)
import PureTabs.Model (BackgroundEvent(..), SidebarEvent(..))
main :: Effect Unit
main = do
log "started sidebar"
port <- Runtime.connect
launchAff_ $ runSidebar port
where
runSidebar :: Runtime.Port -> Aff Unit
runSidebar port = do
currentWindow <- getCurrent
liftEffect $ initSidebar port currentWindow.id
initSidebar :: Runtime.Port -> WindowId -> Effect Unit
initSidebar port winId = do
log $ "windowId " <> (show winId)
Runtime.postMessageJson port $ SbHasWindowId winId
tabsDiv <- J.select "#tabs"
_ <- Runtime.onMessageJsonAddListener port $ onMsg tabsDiv
pure unit
where
onMsg :: J.JQuery -> BackgroundEvent -> Effect Unit
onMsg contentDiv event = case event of
BgTabCreated tab -> do
tabElem <- createTabElement port tab
J.append tabElem contentDiv
pure unit
BgTabDeleted tabId -> deleteTabElement tabId
BgInitialTabList tabs -> traverse_ (createTabElement port >=> (flip J.append) contentDiv) tabs
BgTabUpdated tid cinfo tab -> updateTabInfo tid cinfo tab
BgTabActived prev new -> activateTab prev new
BgTabMoved tid prevPos newPos -> moveTab tid prevPos newPos
_ -> log "received unsupported message type"
createTabElement :: Runtime.Port -> Tab -> Effect J.JQuery
createTabElement port (Tab tab) = do
tabDiv <- J.create "
"
J.setAttr "class" "tab" tabDiv
J.setAttr "id" tab.id tabDiv
J.on "click" onTabClick tabDiv
if tab.active then (J.addClass "active" tabDiv) else (pure unit)
-- favicon
faviconDiv <- J.create "
"
J.addClass "tab-favicon" faviconDiv
setFaviconUrl tab.favIconUrl faviconDiv
J.append faviconDiv tabDiv
-- title
tabTitle <- J.create "
"
J.addClass "tab-title" tabTitle
J.setText tab.title tabTitle
J.append tabTitle tabDiv
-- close button
closeButton <- createCloseButton
J.append closeButton tabDiv
J.on "click" onCloseClick closeButton
pure tabDiv
where
onCloseClick :: J.JQueryEvent -> J.JQuery -> Effect Unit
onCloseClick event j = Runtime.postMessageJson port $ SbTabDeleted tab.id
onTabClick :: J.JQueryEvent -> J.JQuery -> Effect Unit
onTabClick event j = Runtime.postMessageJson port $ SbTabActived tab.id
createCloseButton :: Effect J.JQuery
createCloseButton = do
parent <- J.create "
"
J.addClass "close-button-parent" parent
outer <- J.create "
"
J.addClass "close-button-outer" outer
J.append outer parent
inner <- J.create "
"
J.addClass "close-button-inner" inner
J.append inner outer
pure parent
setFaviconUrl :: Maybe String -> J.JQuery -> Effect Unit
setFaviconUrl Nothing div = pure unit
setFaviconUrl (Just favData) div = J.css { "background-image": favUrl } div
where
favUrl = "url(" <> favData <> ")"
deleteTabElement :: TabId -> Effect Unit
deleteTabElement tabId = do
div <- J.select ("#" <> show tabId)
J.remove div
updateTabInfo :: TabId -> ChangeInfo -> Tab -> Effect Unit
updateTabInfo tid (ChangeInfo cinfo) (Tab tab) = do
tabTitleDiv <- J.select ("#" <> (show tid) <> " > .tab-title")
let
newTitle = case cinfo.status of
Just "loading" -> Just "Loading ..."
_ -> Just tab.title
maybe (pure unit) (\t -> J.setText t tabTitleDiv) newTitle
tabFaviconDiv <- J.select ("#" <> (show tid) <> " > .tab-favicon")
setFaviconUrl cinfo.favIconUrl tabFaviconDiv
activateTab :: (Maybe TabId) -> TabId -> Effect Unit
activateTab prev new = do
maybe (pure unit) (\p -> (J.select ("#" <> (show p))) >>= J.setClass "active" false) prev
newTab <- J.select ("#" <> (show new))
J.setClass "active" true newTab
moveTab :: TabId -> Int -> Int -> Effect Unit
moveTab tabId prev new =
do
tabDiv <- J.select $ "#" <> show tabId
J.remove tabDiv
if new == 0 then do
firstChild <- J.select $ "#tabs > .tab:nth-child(" <> (show $ new + 1) <> ")"
J.before tabDiv firstChild
else do
child <- J.select $ "#tabs > .tab:nth-child(" <> (show $ new) <> ")"
J.after tabDiv child