صفحهٔ اصلی گشت‌و‌گذار راهنما
ثبت نام ورود
theenglishway
/
purescript_linked_in
دنبال کردن 1
ستاره دار 0
انشعاب 0
پرونده‌ها مشکلات 0 درخواست واکشی 0 ویکی
فهرست منبع

ref: move to Halogen for the sidebar

Jocelyn Boullier 5 سال پیش
والد
917bc24743
کامیت
d3da16905a
16فایلهای تغییر یافته به همراه336 افزوده شده و 451 حذف شده
مشاهده تقسیم شده نمایش آمار تفاوت ها
  1. 0 3
      extension/sidebar.html
  2. 0 5
      package-lock.json
  3. 0 3
      package.json
  4. 4 1
      packages.dhall
  5. 4 5
      spago.dhall
  6. 1 1
      src/Background.purs
  7. 15 13
      src/Browser/Tabs/OnUpdated.purs
  8. 0 24
      src/JQuery/Ext.js
  9. 0 10
      src/JQuery/Ext.purs
  10. 1 1
      src/Model.purs
  11. 0 176
      src/Sidebar.purs
  12. 32 0
      src/Sidebar/Components/Tab.purs
  13. 208 0
      src/Sidebar/Components/Tabs.purs
  14. 71 0
      src/Sidebar/Sidebar.purs
  15. 0 52
      src/Sortable/Sortable.js
  16. 0 157
      src/Sortable/Sortable.purs

+ 0 - 3
extension/sidebar.html
مشاهده فایل 

@@ -9,9 +9,6 @@
 
 
   <body>
 
     <div id="content">
 
-      <div id="menu">
 
-      </div>
 
-      <div id="tabs"></div>
 
     </div>
 
     <script src="sidebar.js"></script>
 
   </body>

+ 0 - 5
package-lock.json
مشاهده فایل 

@@ -6568,11 +6568,6 @@
 
         }
 
       }
 
     },
 
-    "sortablejs": {
 
-      "version": "1.10.2",
 
-      "resolved": "https://registry.npmjs.org/sortablejs/-/sortablejs-1.10.2.tgz",
 
-      "integrity": "sha512-YkPGufevysvfwn5rfdlGyrGjt7/CRHwvRPogD/lC+TnvcN29jDpCifKP+rBqf+LRldfXSTh+0CGLcSg0VIxq3A=="
 
-    },
 
     "source-map": {
 
       "version": "0.6.1",
 
       "resolved": "https://registry.npmjs.org/source-map/-/source-map-0.6.1.tgz",

+ 0 - 3
package.json
مشاهده فایل 

@@ -16,8 +16,5 @@
 
   "devDependencies": {
 
     "concurrently": "^5.2.0",
 
     "parcel": "^1.12.4"
 
-  },
 
-  "dependencies": {
 
-    "sortablejs": "^1.10.2"
 
   }
 
 }

+ 4 - 1
packages.dhall
مشاهده فایل 

@@ -121,7 +121,10 @@ let additions =
 
 let upstream =
 
       https://github.com/purescript/package-sets/releases/download/psc-0.13.6-20200309/packages.dhall sha256:9221987b4e7ea99ccd0efbe056f7bebc872cd92e0058efe5baa181d73359e7b3
 
 
-let overrides = {=}
 
+let overrides =
 
+      { halogen = upstream.halogen // { version = "v5.0.0-rc.9" }
 
+      , halogen-vdom = upstream.halogen-vdom // { version = "v6.1.3" }
 
+      }
 
 
 let additions = {=}

+ 4 - 5
spago.dhall
مشاهده فایل 

@@ -5,17 +5,17 @@ You can edit this file as you like.
 
 { name = "pure-tabs"
 
 , dependencies =
 
   [ "aff"
 
+  , "aff-coroutines"
 
   , "aff-promise"
 
-  , "argonaut"
 
-  , "argonaut-codecs"
 
-  , "argonaut-generic"
 
   , "console"
 
+  , "css"
 
   , "debug"
 
   , "effect"
 
   , "foreign"
 
   , "foreign-generic"
 
   , "generics-rep"
 
-  , "jquery"
 
+  , "halogen"
 
+  , "halogen-css"
 
   , "lists"
 
   , "numbers"
 
   , "profunctor"
 
@@ -23,7 +23,6 @@ You can edit this file as you like.
 
   , "psci-support"
 
   , "refs"
 
   , "st"
 
-  , "undefined"
 
   , "unordered-collections"
 
   , "web-dom"
 
   , "web-html"

+ 1 - 1
src/Background.purs
مشاهده فایل 

@@ -177,7 +177,7 @@ onTabActived stateRef (OnActivated.ActiveInfo aInfo) = do
 
   state <- Ref.modify (updateGlobalState aInfo.previousTabId aInfo.tabId) stateRef
 
   case (preview (_portFromWindowId aInfo.windowId) state) of
 
     Nothing -> pure unit
 
-    Just port -> Runtime.postMessageJson port $ BgTabActived aInfo.previousTabId aInfo.tabId
 
+    Just port -> Runtime.postMessageJson port $ BgTabActivated aInfo.previousTabId aInfo.tabId
 
   where
 
   updateGlobalState :: (Maybe TabId) -> TabId -> GlobalState -> GlobalState
 
   updateGlobalState prev new state =

+ 15 - 13
src/Browser/Tabs/OnUpdated.purs
مشاهده فایل 

@@ -16,20 +16,22 @@ import Foreign.Class (class Decode, class Encode)
 
 import Foreign.Generic (defaultOptions, genericDecode, genericEncode)
 
 import Prelude (Unit, bind, ($))
 
 
+type ChangeInfoRec
 
+  = { attention :: Maybe Boolean
 
+    , audible :: Maybe Boolean
 
+    , discarded :: Maybe Boolean
 
+    , favIconUrl :: Maybe String
 
+    , hidden :: Maybe Boolean
 
+    , isArticle :: Maybe Boolean
 
+    -- mutedInfo :: Maybe MutedInfo,
 
+    , pinned :: Maybe Boolean
 
+    , status :: Maybe String
 
+    , title :: Maybe String
 
+    , url :: Maybe String
 
+    }
 
+
 
 newtype ChangeInfo
 
-  = ChangeInfo
 
-  { attention :: Maybe Boolean
 
-  , audible :: Maybe Boolean
 
-  , discarded :: Maybe Boolean
 
-  , favIconUrl :: Maybe String
 
-  , hidden :: Maybe Boolean
 
-  , isArticle :: Maybe Boolean
 
-  -- mutedInfo :: Maybe MutedInfo,
 
-  , pinned :: Maybe Boolean
 
-  , status :: Maybe String
 
-  , title :: Maybe String
 
-  , url :: Maybe String
 
-  }
 
+  = ChangeInfo ChangeInfoRec
 
 
 derive instance newtypeChangeInfo :: Newtype ChangeInfo _

+ 0 - 24
src/JQuery/Ext.js
مشاهده فایل 

@@ -1,24 +0,0 @@
 
-"use strict";
 
-
 
-exports.after = function(ob) {
 
-    return function(ob1) {
 
-        return function() {
 
-            ob1.after(ob);
 
-        };
 
-    };
 
-};
 
-
 
-exports.prepend = function(ob) {
 
-    return function(ob1) {
 
-        return function() {
 
-            ob1.prepend(ob);
 
-        };
 
-    };
 
-};
 
-
 
-
 
-exports.getHtmlElem = function(ob) {
 
-  return function() {
 
-    return ob[0];
 
-  }
 
-}

+ 0 - 10
src/JQuery/Ext.purs
مشاهده فایل 

@@ -1,11 +0,0 @@
 
-module JQuery.Ext (after, prepend, getHtmlElem) where
 
-
 
-import Effect (Effect)
 
-import JQuery (JQuery)
 
-import Prelude (Unit)
 
-import Web.HTML (HTMLElement)
 
-
 
-foreign import after :: JQuery -> JQuery -> Effect Unit
 
-foreign import prepend :: JQuery -> JQuery -> Effect Unit
 
-foreign import getHtmlElem :: JQuery -> Effect HTMLElement

+ 1 - 1
src/Model.purs
مشاهده فایل 

@@ -159,7 +159,7 @@ data BackgroundEvent
 
   | BgTabDeleted TabId
 
   | BgTabUpdated TabId ChangeInfo Tab
 
   | BgTabMoved TabId Int Int
 
-  | BgTabActived (Maybe TabId) TabId
 
+  | BgTabActivated (Maybe TabId) TabId
 
   | BgTabAttached Tab
 
   | BgTabDetached TabId
 
   | BgTabHighlighted

+ 0 - 176
src/Sidebar.purs
مشاهده فایل 

@@ -1,176 +0,0 @@
 
-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.Foldable (traverse_)
 
-import Data.Maybe (Maybe(..), maybe)
 
-import Data.Monoid ((<>))
 
-import Data.Number (fromString)
 
-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 Effect.Exception (throw)
 
-import JQuery (getAttr, getTarget)
 
-import JQuery as J
 
-import JQuery.Ext (after, prepend, getHtmlElem) as J
 
-import Prelude (Unit, bind, ($), discard)
 
-import PureTabs.Model (BackgroundEvent(..), SidebarEvent(..))
 
-import Sortable (create, Event) as S
 
-import Web.DOM.Element (id)
 
-import Web.HTML.HTMLElement (toElement)
 
-
 
-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
 
-
 
-sortableOnUpdate :: Runtime.Port -> S.Event -> Effect Unit
 
-sortableOnUpdate port { item: item, newIndex: Just newIndex } = do
 
-  sTabId <- id $ toElement item
 
-  case fromString sTabId of
 
-    Nothing -> throw $ "couldn't convert to a tab id " <> sTabId
 
-    Just tabId' -> Runtime.postMessageJson port $ SbMoveTab (TabId tabId') newIndex
 
-
 
-sortableOnUpdate port _ = pure unit
 
-
 
-initSidebar :: Runtime.Port -> WindowId -> Effect Unit
 
-initSidebar port winId = do
 
-  log $ "windowId " <> (show winId)
 
-  Runtime.postMessageJson port $ SbHasWindowId winId
 
-  _ <- Runtime.onMessageJsonAddListener port onMsg
 
-  allTabs <- J.select "#tabs"
 
-  J.on "dblclick" (openNewTab winId port) allTabs
 
-  sortable <- S.create { onUpdate: sortableOnUpdate port } =<< J.getHtmlElem allTabs
 
-  pure unit
 
-  where
 
-  onMsg :: BackgroundEvent -> Effect Unit
 
-  onMsg event = case event of
 
-    BgTabCreated tab -> createTab port tab
 
-    BgTabDeleted tabId -> deleteTabElement tabId
 
-    BgInitialTabList tabs -> traverse_ (createTab port) 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"
 
-
 
-  openNewTab :: WindowId -> Runtime.Port -> J.JQueryEvent -> J.JQuery -> Effect Unit
 
-  openNewTab winId port' event _ = do
 
-    id <- getAttr "id" =<< getTarget event
 
-    case id of
 
-      Just "tabs" -> Runtime.postMessageJson port' $ SbCreateTab winId
 
-      _ -> pure unit
 
-
 
-createTab :: Runtime.Port -> Tab -> Effect Unit
 
-createTab port (Tab tab) = do
 
-  tabsDiv <- J.select "#tabs"
 
-  tabElem <- createTabElement port (Tab tab)
 
-  insertTabAt tab.index tabElem
 
-
 
-createTabElement :: Runtime.Port -> Tab -> Effect J.JQuery
 
-createTabElement port (Tab tab) = do
 
-  tabDiv <- J.create "<div>"
 
-  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)
 
-  if isDiscarded tab then (J.addClass "discarded" tabDiv) else (pure unit)
 
-  -- favicon
 
-  faviconDiv <- J.create "<div>"
 
-  J.addClass "tab-favicon" faviconDiv
 
-  setFaviconUrl tab.favIconUrl faviconDiv
 
-  J.append faviconDiv tabDiv
 
-  -- title
 
-  tabTitle <- J.create "<div>"
 
-  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 $ SbDeleteTab tab.id
 
-
 
-  onTabClick :: J.JQueryEvent -> J.JQuery -> Effect Unit
 
-  onTabClick event j = Runtime.postMessageJson port $ SbActivateTab tab.id
 
-
 
-  isDiscarded :: forall r. { discarded :: Maybe Boolean | r } -> Boolean
 
-  isDiscarded { discarded: Just true } = true
 
-
 
-  isDiscarded _ = false
 
-
 
-createCloseButton :: Effect J.JQuery
 
-createCloseButton = do
 
-  parent <- J.create "<div>"
 
-  J.addClass "close-button-parent" parent
 
-  outer <- J.create "<div>"
 
-  J.addClass "close-button-outer" outer
 
-  J.append outer parent
 
-  inner <- J.create "<div>"
 
-  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
 
-  let
 
-    tabIdSelec = "#" <> (show tid)
 
-  tabDiv <- J.select tabIdSelec
 
-  tabTitleDiv <- J.select (tabIdSelec <> " > .tab-title")
 
-  let
 
-    newTitle = case cinfo.status of
 
-      Just "loading" -> Just "Loading ..."
 
-      _ -> Just tab.title
 
-  maybe (pure unit) (\t -> J.setText t tabTitleDiv) newTitle
 
-  maybe (pure unit) (\discarded -> J.setClass "discarded" discarded tabDiv) tab.discarded
 
-  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
 
-  insertTabAt new tabDiv
 
-
 
-insertTabAt :: Int -> J.JQuery -> Effect Unit
 
-insertTabAt 0 tabDiv = do
 
-  allTabs <- J.select "#tabs"
 
-  J.prepend tabDiv allTabs
 
-
 
-insertTabAt pos tabDiv = do
 
-  child <- J.select $ "#tabs > .tab:nth-child(" <> (show pos) <> ")"
 
-  J.after tabDiv child

+ 32 - 0
src/Sidebar/Components/Tab.purs
مشاهده فایل 

@@ -0,0 +1,32 @@
 
+module PureTabs.Sidebar.Tab  where
 
+
 
+import Browser.Tabs (Tab(..))
 
+import Control.Category (identity)
 
+import Data.Const (Const(..))
 
+import Data.Function (const, ($))
 
+import Data.Show (show)
 
+import Data.Unit (Unit)
 
+import Data.Void (Void)
 
+import Halogen as H
 
+import Halogen.HTML as HH
 
+import Halogen.HTML.Events as HE
 
+import Halogen.HTML.Properties as HP
 
+
 
+
 
+{-- type State = Tab                                                  --}
 
+
 
+{-- component :: forall q i o m. State -> H.Component HH.HTML q i o m --}
 
+{-- component t =                                                     --}
 
+{--   H.mkComponent                                                   --}
 
+{--     { initialState: const t                                       --}
 
+{--     , render: render                                              --}
 
+{--     , eval: H.mkEval H.defaultEval                                --}
 
+{--     }                                                             --}
 
+
 
+{-- render :: forall m. State -> H.ComponentHTML Unit () m            --}
 
+{-- render (Tab t) =                                                  --}
 
+{--   HH.div                                                          --}
 
+{--     [ HP.id_ $ show t.id                                          --}
 
+{--     , HP.class_ (H.ClassName "tab")                               --}
 
+{--     ]                                                             --}
 
+{--     [ HH.text t.title ]                                           --}

+ 208 - 0
src/Sidebar/Components/Tabs.purs
مشاهده فایل 

@@ -0,0 +1,208 @@
 
+module PureTabs.Sidebar.Tabs (component, Query(..)) where
 
+
 
+import Browser.Tabs (Tab(..), TabId(..))
 
+import Browser.Tabs.OnUpdated (ChangeInfo(..), ChangeInfoRec)
 
+import CSS.Background as CssBackground
 
+import Control.Alt ((<#>), (<$>), (<|>))
 
+import Control.Alternative (empty, pure, (*>), (<*>))
 
+import Control.Bind (bind, discard, (>=>), (>>=))
 
+import Control.Category (identity, (<<<), (>>>))
 
+import Data.Array (catMaybes, deleteAt, filter, findIndex, head, insertAt, modifyAt, (!!)) as A
 
+import Data.Array (foldl)
 
+import Data.Const (Const(..))
 
+import Data.Eq ((==))
 
+import Data.Function (const, flip, (#), ($))
 
+import Data.Lens (over)
 
+import Data.Maybe (Maybe(..), fromMaybe, maybe)
 
+import Data.Show (show)
 
+import Data.Symbol (SProxy(..))
 
+import Data.Unit (Unit, unit)
 
+import Data.Void (Void)
 
+import Effect.Aff.Class (class MonadAff)
 
+import Effect.Class (class MonadEffect)
 
+import Effect.Class.Console (log)
 
+import Halogen as H
 
+import Halogen.HTML as HH
 
+import Halogen.HTML.CSS as CSS
 
+import Halogen.HTML.Events as HE
 
+import Halogen.HTML.Properties as HP
 
+import PureTabs.Model (BackgroundEvent(..), SidebarEvent(..))
 
+import PureTabs.Model (_tabs)
 
+import PureTabs.Sidebar.Tab as TabC
 
+import Web.Event.Event (Event)
 
+import Web.Event.Event as Event
 
+import Web.UIEvent.MouseEvent (toEvent) as ME
 
+
 
+data Query a
 
+  = InitialTabList (Array Tab) a
 
+  | TabCreated Tab a
 
+  | TabDeleted TabId a
 
+  | TabActivated (Maybe TabId) TabId a
 
+  | TabMoved TabId Int Int a
 
+  | TabInfoChanged TabId ChangeInfo a
 
+
 
+data Action
 
+  = UserClosedTab TabId Event
 
+  | UserActivatedTab TabId Event
 
+
 
+type State
 
+  = { tabs :: Array Tab
 
+    }
 
+
 
+component :: forall i m. MonadEffect m => H.Component HH.HTML Query i SidebarEvent m
 
+component =
 
+  H.mkComponent
 
+    { initialState
 
+    , render: render
 
+    , eval:
 
+        H.mkEval
 
+          $ H.defaultEval
 
+              { handleQuery = handleQuery
 
+              , handleAction = handleAction
 
+              }
 
+    }
 
+
 
+initialState :: forall i. i -> State
 
+initialState _ = { tabs: empty }
 
+
 
+_tab :: SProxy "tab"
 
+_tab = SProxy
 
+
 
+render :: forall m. State -> H.ComponentHTML Action () m
 
+render state =
 
+  HH.div
 
+    [ HP.id_ "tabs"
 
+    ]
 
+    (renderTab <$> state.tabs)
 
+  where
 
+  renderTab (Tab t) =
 
+    HH.div
 
+      [ HP.id_ $ show t.id
 
+      , HE.onClick (\ev -> Just (UserActivatedTab t.id (ME.toEvent ev)))
 
+      , HP.classes $ H.ClassName
 
+          <$> A.catMaybes
 
+              [ Just "tab"
 
+              , if t.active then Just "active" else Nothing
 
+              , if isDiscarded t then Just "discarded" else Nothing
 
+              ]
 
+      ]
 
+      [ HH.div [ HP.class_ $ H.ClassName "tab-favicon", faviconStyle t.favIconUrl ] []
 
+      , HH.div [ HP.class_ $ H.ClassName "tab-title" ]
 
+          [ HH.text
 
+              $ case t.status of
 
+                  Just "loading" -> "Loading ..."
 
+                  _ -> t.title
 
+          ]
 
+      , HH.div
 
+          [ HP.class_ $ H.ClassName "close-button-parent"
 
+          , HE.onClick (\ev -> Just (UserClosedTab t.id (ME.toEvent ev)))
 
+          ]
 
+          [ HH.div [ HP.class_ $ H.ClassName "close-button-outer" ]
 
+              [ HH.div [ HP.class_ $ H.ClassName "close-button-inner" ] []
 
+              ]
 
+          ]
 
+      ]
 
+
 
+  faviconStyle favicon' =
 
+    CSS.style
 
+      $ do
 
+          case favicon' of
 
+            Nothing -> pure unit
 
+            Just favicon -> CssBackground.backgroundImage $ CssBackground.url favicon
 
+
 
+  isDiscarded :: forall r. { discarded :: Maybe Boolean | r } -> Boolean
 
+  isDiscarded { discarded: Just true } = true
 
+
 
+  isDiscarded _ = false
 
+
 
+handleAction :: forall m. MonadEffect m => Action -> H.HalogenM State Action () SidebarEvent m Unit
 
+handleAction = case _ of
 
+  UserClosedTab tid ev -> do
 
+    H.liftEffect $ do 
+        Event.preventDefault ev 
+        Event.stopPropagation ev
 
+    H.liftEffect $ log "sb: closed a tab"
 
+    H.raise $ SbDeleteTab tid
 
+  UserActivatedTab tid ev -> do
 
+    H.liftEffect $ do 
+        Event.preventDefault ev 
+        Event.stopPropagation ev
 
+    H.liftEffect $ log "sb: activated a tab"
 
+    H.raise $ SbActivateTab tid
 
+
 
+handleQuery :: forall act o m a. Query a -> H.HalogenM State act () o m (Maybe a)
 
+handleQuery = case _ of
 
+  InitialTabList tabs a -> H.put { tabs } *> pure (Just a)
 
+  TabCreated (Tab t) a ->
 
+    H.modify_
 
+      (over _tabs $ \tabs -> fromMaybe tabs $ A.insertAt t.index (Tab t) tabs)
 
+      *> pure (Just a)
 
+  TabDeleted tid a ->
 
+    H.modify_
 
+      ( over _tabs
 
+          $ applyAtTabId tid A.deleteAt
 
+      {-- $ \tabs -> fromMaybe tabs $ findIndexTabId tid tabs >>= (flip A.deleteAt) tabs --}
 
+      )
 
+      *> pure (Just a)
 
+  TabActivated oldTid tid a ->
 
+    H.modify_
 
+      ( over _tabs
 
+          $ maybe identity (\old -> applyAtTabId old $ setTabActiveAtIndex false) oldTid
 
+          >>> applyAtTabId tid (setTabActiveAtIndex true)
 
+      )
 
+      *> pure (Just a)
 
+  TabMoved tid prev next a -> do
 
+    state <- H.get
 
+    let
 
+      tab' = state.tabs A.!! prev
 
+    maybeFlipped tab' (pure unit) \tab ->
 
+      H.modify_
 
+        ( over _tabs \tabs ->
 
+            fromMaybe tabs $ (A.deleteAt prev >=> A.insertAt next tab) tabs
 
+        )
 
+    pure (Just a)
 
+  TabInfoChanged tid cinfo a ->
 
+    H.modify_
 
+      ( over _tabs
 
+          $ \tabs ->
 
+              fromMaybe tabs
 
+                $ (findIndexTabId tid >=> \index -> A.modifyAt index (updateTabFromInfo cinfo) tabs) tabs
 
+      )
 
+      *> pure (Just a)
 
+
 
+setTabActive :: Boolean -> Tab -> Tab
 
+setTabActive act (Tab t) = Tab (t { active = act })
 
+
 
+setTabActiveAtIndex :: Boolean -> Int -> Array Tab -> Maybe (Array Tab)
 
+setTabActiveAtIndex act i = A.modifyAt i (setTabActive act)
 
+
 
+findTabByTabId :: TabId -> Array Tab -> Maybe Tab
 
+findTabByTabId tid = A.head <<< A.filter \(Tab t) -> t.id == tid
 
+
 
+findIndexTabId :: TabId -> Array Tab -> Maybe Int
 
+findIndexTabId tid = A.findIndex \(Tab t) -> t.id == tid
 
+
 
+applyAtTabId :: TabId -> (Int -> Array Tab -> Maybe (Array Tab)) -> Array Tab -> Array Tab
 
+applyAtTabId tid f a = fromMaybe a $ findIndexTabId tid a >>= (flip f) a
 
+
 
+maybeFlipped :: forall a b. Maybe a -> b -> (a -> b) -> b
 
+maybeFlipped ma b f = maybe b f ma
 
+
 
+updateTabFromInfo :: ChangeInfo -> Tab -> Tab
 
+updateTabFromInfo (ChangeInfo cinfo) (Tab t) =
 
+  let
 
+    updateField :: forall r a. { acc :: ChangeInfoRec -> Maybe a, update :: a -> r -> r } -> r -> r
 
+    updateField { acc, update } tab = case acc cinfo of
 
+      Nothing -> tab
 
+      Just field -> update field tab
 
+
 
+    applyChange =
 
+      updateField { acc: _.title, update: (\val -> _ { title = val }) }
 
+        >>> updateField { acc: _.status, update: (\val -> _ { status = Just val }) }
 
+        >>> updateField { acc: _.discarded, update: (\val -> _ { discarded = Just val }) }
 
+        >>> updateField { acc: _.url, update: (\val -> _ { url = Just val }) }
 
+        >>> updateField { acc: _.pinned, update: (\val -> _ { pinned = val }) }
 
+        >>> updateField { acc: _.hidden, update: (\val -> _ { hidden = val }) }
 
+        >>> updateField { acc: _.favIconUrl, update: (\val -> _ { favIconUrl = Just val }) }
 
+  in
 
+    Tab (applyChange t)

+ 71 - 0
src/Sidebar/Sidebar.purs
مشاهده فایل 

@@ -0,0 +1,71 @@
 
+module PureTabs.Sidebar where
 
+
 
+import Browser.Runtime as Runtime
 
+import Browser.Windows (getCurrent)
 
+import Control.Alt (void)
 
+import Control.Alternative (pure)
 
+import Control.Coroutine as CR
 
+import Control.Coroutine.Aff (emit)
 
+import Control.Coroutine.Aff as CRA
 
+import Control.Monad.Error.Class (throwError)
 
+import Data.Function (($))
 
+import Data.Maybe (Maybe(..))
 
+import Data.Unit (Unit, unit)
 
+import Effect (Effect)
 
+import Effect.Aff (Aff, error)
 
+import Effect.Class (liftEffect)
 
+import Halogen as H
 
+import Halogen.Aff as HA
 
+import Halogen.VDom.Driver (runUI)
 
+import Prelude (bind, discard)
 
+import PureTabs.Model (BackgroundEvent(..), SidebarEvent(..))
 
+import PureTabs.Sidebar.Tabs as Tabs
 
+import Web.DOM.ParentNode (QuerySelector(..))
 
+
 
+main :: Effect Unit
 
+main = do
 
+  port <- Runtime.connect
 
+  HA.runHalogenAff do
 
+    currentWindow <- getCurrent
 
+    liftEffect $ Runtime.postMessageJson port $ SbHasWindowId currentWindow.id
 
+    content' <- HA.selectElement (QuerySelector "#content")
 
+    io <- case content' of
 
+      Nothing -> throwError (error "Could not find #content")
 
+      Just content -> runUI Tabs.component unit content
 
+    io.subscribe $ onSidebarMsg port
 
+    CR.runProcess ((onBackgroundMsgProducer port) CR.$$ onBackgroundMsgConsumer io.query)
 
+
 
+onBackgroundMsgProducer :: Runtime.Port -> CR.Producer BackgroundEvent Aff Unit
 
+onBackgroundMsgProducer port =
 
+  CRA.produce \emitter ->
 
+    liftEffect $ void $ Runtime.onMessageJsonAddListener port (emit emitter)
 
+
 
+onBackgroundMsgConsumer :: (forall a. Tabs.Query a -> Aff (Maybe a)) -> CR.Consumer BackgroundEvent Aff Unit
 
+onBackgroundMsgConsumer query =
 
+  CR.consumer
 
+    $ case _ of
 
+        BgInitialTabList tabs -> do
 
+          void $ query $ H.tell $ Tabs.InitialTabList tabs
 
+          pure Nothing
 
+        BgTabCreated tab -> do
 
+          void $ query $ H.tell $ Tabs.TabCreated tab
 
+          pure Nothing
 
+        BgTabDeleted tabId -> do
 
+          void $ query $ H.tell $ Tabs.TabDeleted tabId
 
+          pure Nothing
 
+        BgTabActivated prev next -> do
 
+          void $ query $ H.tell $ Tabs.TabActivated prev next
 
+          pure Nothing
 
+        BgTabMoved tabId prev next -> do
 
+          void $ query $ H.tell $ Tabs.TabMoved tabId prev next
 
+          pure Nothing
 
+        BgTabUpdated tabId cinfo tab -> do
 
+          void $ query $ H.tell $ Tabs.TabInfoChanged tabId cinfo
 
+          pure Nothing
 
+        _ -> pure Nothing
 
+
 
+onSidebarMsg :: Runtime.Port -> CR.Consumer SidebarEvent Aff Unit
 
+onSidebarMsg port =
 
+  CR.consumer \msg -> do
 
+    liftEffect $ Runtime.postMessageJson port msg
 
+    pure Nothing

+ 0 - 52
src/Sortable/Sortable.js
مشاهده فایل 

@@ -1,52 +0,0 @@
 
-"use strict";
 
-
 
-var Sortable = require("../../node_modules/sortablejs/Sortable.min.js");
 
-
 
-const optionsEventField = [
 
-  "onChoose",
 
-  "onUnchoose",
 
-  "onStart",
 
-  "onEnd",
 
-  "onAdd",
 
-  "onUpdate",
 
-  "onSort",
 
-  "onRemove",
 
-  "onFilter",
 
-  "onClone",
 
-  "onChange",
 
-];
 
-const optionsEffectField = optionsEventField.concat(["onMove"]);
 
-
 
-exports["create'"] = function (options, el, parseEvent) {
 
-
 
-  const optionsCopy = Object.assign({}, options);
 
-  for (const field of optionsEffectField) {
 
-    if (field in optionsCopy) {
 
-      let func = optionsCopy[field];
 
-      if (optionsEventField.includes(field)) {
 
-        func = parseEvent(func);
 
-      }
 
-      optionsCopy[field] = unEffect(func);
 
-    }
 
-  }
 
-
 
-  return function () {
 
-    return Sortable.create(el, optionsCopy);
 
-  };
 
-};
 
-
 
-exports.isTrue = function (b) {
 
-  return b === true;
 
-};
 
-exports.isFalse = function (b) {
 
-  return b === false;
 
-};
 
-exports.isClone = function (b) {
 
-  return b === "clone";
 
-};
 
-const unEffect = function (f) {
 
-  return function (event) {
 
-    console.log(event);
 
-    return f(event)();
 
-  };
 
-};

+ 0 - 157
src/Sortable/Sortable.purs
مشاهده فایل 

@@ -1,157 +0,0 @@
 
-module Sortable (Sortable, Options, Event, MoveEvent, PullMode, create) where
 
-
 
-import Control.Alt ((<$>))
 
-import Control.Alternative (pure)
 
-import Control.Bind ((>>=))
 
-import Control.Category ((<<<), (>>>))
 
-import Control.Monad.Except (mapExcept, runExcept, throwError)
 
-import Data.Array (intercalate)
 
-import Data.Boolean (otherwise)
 
-import Data.BooleanAlgebra ((||))
 
-import Data.Either (Either(..))
 
-import Data.Function (($))
 
-import Data.Function.Uncurried (Fn3, runFn3)
 
-import Data.List.NonEmpty (NonEmptyList(..))
 
-import Data.Maybe (Maybe(..))
 
-import Data.Symbol (class IsSymbol)
 
-import Data.Traversable (traverse)
 
-import Data.Unit (Unit)
 
-import Effect (Effect)
 
-import Effect.Exception (throw)
 
-import Foreign (F, Foreign, ForeignError(..), fail, isNull, isUndefined, readInt, readNull, readNullOrUndefined, readNumber, renderForeignError, tagOf, unsafeFromForeign)
 
-import Foreign.Index ((!))
 
-import Prelude (bind)
 
-import Prim.Row (class Union, class Cons) as Row
 
-import Web.HTML (HTMLElement)
 
-import Web.HTML.Event.DataTransfer (DataTransfer)
 
-import Web.HTML.HTMLElement (DOMRect)
 
-
 
-foreign import data Sortable :: Type
 
-
 
-foreign import isTrue :: Foreign -> Boolean
 
-
 
-foreign import isFalse :: Foreign -> Boolean
 
-
 
-foreign import isClone :: Foreign -> Boolean
 
-
 
-data PullMode
 
-  = Clone
 
-  | Bool Boolean
 
-  | NotDefined
 
-
 
-readPullMode :: Foreign -> F PullMode
 
-readPullMode value
 
-  | isNull value || isUndefined value = pure NotDefined
 
-  | isTrue value = pure (Bool true)
 
-  | isFalse value = pure (Bool false)
 
-  | isClone value = pure Clone
 
-  | otherwise = fail $ TypeMismatch "PullMode" (tagOf value)
 
-
 
-type Event
 
-  = { to :: HTMLElement
 
-    , from :: HTMLElement
 
-    , item :: HTMLElement
 
-    , clone :: HTMLElement
 
-    , oldIndex :: Maybe Int
 
-    , newIndex :: Maybe Int
 
-    , oldDraggableIndex :: Maybe Int
 
-    , newDraggableIndex :: Maybe Int
 
-    , pullMode :: PullMode
 
-    }
 
-
 
-{-- foreign import data ForeignEvent :: Type --}
 
-readEvent :: Foreign -> F Event
 
-readEvent value = do
 
-  to <- value ! "to" >>= (pure <<< unsafeFromForeign)
 
-  from <- value ! "from" >>= (pure <<< unsafeFromForeign)
 
-  item <- value ! "item" >>= (pure <<< unsafeFromForeign)
 
-  clone <- value ! "clone" >>= (pure <<< unsafeFromForeign)
 
-  oldIndex <- value ! "oldIndex" >>= readNullOrUndefined >>= traverse readInt
 
-  newIndex <- value ! "newIndex" >>= readNullOrUndefined >>= traverse readInt
 
-  oldDraggableIndex <- value ! "oldDraggableIndex" >>= readNullOrUndefined >>= traverse readInt
 
-  newDraggableIndex <- value ! "newDraggableIndex" >>= readNullOrUndefined >>= traverse readInt
 
-  pullMode <- value ! "pullMode" >>= readPullMode
 
-  pure { to, from, item, clone, oldIndex, newIndex, oldDraggableIndex, newDraggableIndex, pullMode }
 
-
 
-type MoveEvent
 
-  = { to :: HTMLElement
 
-    , from :: HTMLElement
 
-    , dragged :: HTMLElement
 
-    , draggedRect :: DOMRect
 
-    , related :: HTMLElement
 
-    , relatedRect :: DOMRect
 
-    , willInsertAfter :: Boolean
 
-    }
 
-
 
-type Options
 
-  = ( group :: String
 
-    , sort :: Boolean
 
-    , delay :: Int
 
-    , delayOnTouchOnly :: Boolean
 
-    , touchStartThreshold :: Int
 
-    , disabled :: Boolean
 
-    , {-- store ::  --} animation :: Int
 
-    , easing :: String
 
-    , handle :: String
 
-    , filter :: String
 
-    , preventOnFilter :: Boolean
 
-    , draggable :: String
 
-    , dataIdAttr :: String
 
-    , ghostClass :: String
 
-    , chosenClass :: String
 
-    , dragClass :: String
 
-    , swapThreshold :: Int
 
-    , invertSwap :: Boolean
 
-    , invertedSwapThreshold :: Int
 
-    , direction :: String
 
-    , forceFallback :: Boolean
 
-    , fallbackClass :: String
 
-    , fallbackOnBody :: Boolean
 
-    , fallbackTolerance :: Int
 
-    , dragoverBubble :: Boolean
 
-    , removeCloneOnHide :: Boolean
 
-    , emptyInsertThreshold :: Number
 
-    {-- , setData :: DataTransfer -> HTMLElement -> Effect Unit --}
 
-    , onChoose :: Event -> Effect Unit
 
-    , onUnchoose :: Event -> Effect Unit
 
-    , onStart :: Event -> Effect Unit
 
-    , onEnd :: Event -> Effect Unit
 
-    , onAdd :: Event -> Effect Unit
 
-    , onUpdate :: Event -> Effect Unit
 
-    , onSort :: Event -> Effect Unit
 
-    , onRemove :: Event -> Effect Unit
 
-    , onFilter :: Event -> Effect Unit
 
-    , onMove :: MoveEvent -> Effect Unit
 
-    , onClone :: Event -> Effect Unit
 
-    , onChange :: Event -> Effect Unit
 
-    )
 
-
 
-foreign import create' ::
 
-  forall given.
 
-  Fn3
 
-    { | given }
 
-    HTMLElement
 
-    ((Event -> Effect Unit) -> (Foreign -> Effect Unit))
 
-    (Effect Sortable)
 
-
 
-parseEvent :: (Event -> Effect Unit) -> (Foreign -> Effect Unit)
 
-parseEvent f = wrappedF
 
-  where
 
-  wrappedF :: Foreign -> Effect Unit
 
-  wrappedF =
 
-    readEvent >>> runExcept
 
-      >>> ( case _ of
 
-            Left err -> throw $ formatErr err
 
-            Right event -> f event
 
-        )
 
-
 
-  formatErr :: NonEmptyList ForeignError -> String
 
-  formatErr err = intercalate ", " $ renderForeignError <$> err
 
-
 
-create ::
 
-  forall given trash.
 
-  Row.Union given trash Options =>
 
-  { | given } ->
 
-  HTMLElement ->
 
-  Effect Sortable
 
-create options elem = runFn3 create' options elem parseEvent