diff --git a/chandlr.cabal b/chandlr.cabal
index 610bcff..c8ab120 100644
--- a/chandlr.cabal
+++ b/chandlr.cabal
@@ -82,6 +82,7 @@ executable chandlr
BodyParser
QuoteLinkParser
PostPartType
+ Component.TimeControl
-- LANGUAGE extensions used by modules in this package.
diff --git a/html/README.hs b/html/README.hs
new file mode 100644
index 0000000..5c26190
--- /dev/null
+++ b/html/README.hs
@@ -0,0 +1,5 @@
+You can use these snippets to generate Miso view syntax
+
+```bash
+cat timecontrol.html | miso-from-html
+```
diff --git a/html/scroll.js b/html/scroll.js
new file mode 100644
index 0000000..904bbe9
--- /dev/null
+++ b/html/scroll.js
@@ -0,0 +1,16 @@
+function onChange(e) {
+ console.log(e.target.value);
+}
+
+function main() {
+ console.log("Hello world");
+ var elem_range = document.querySelector("input.time-control");
+ console.log(elem_range);
+ elem_range.addEventListener('input', onChange);
+}
+
+if (document.readyState != "complete") {
+ window.addEventListener("load", main, { "once": true })
+} else {
+ main();
+}
diff --git a/html/scrollbar.html b/html/scrollbar.html
new file mode 100644
index 0000000..190d2f6
--- /dev/null
+++ b/html/scrollbar.html
@@ -0,0 +1,19 @@
+
+
+
+
+ Scrollbar demo
+
+
+
+
+
+
+
+
diff --git a/html/tc.css b/html/tc.css
new file mode 100644
index 0000000..cf572e1
--- /dev/null
+++ b/html/tc.css
@@ -0,0 +1,43 @@
+.timecontrol {
+ overflow-x: hidden;
+}
+
+.tc-scrollbar__wrapper,
+.time-control {
+ width: 70%;
+ margin-left: auto;
+ margin-right: auto;
+ display: block;
+}
+
+.tc-scrollbar__bar {
+ width: 100%;
+ height: 20px;
+ border-left: 2px solid black;
+ border-right: 2px dotted black;
+ position: relative;
+ box-sizing: border-box;
+}
+
+.tc-scrollbar__bar:before {
+ content: "";
+ display: block;
+ float: left;
+ width: 150%;
+ width: 100%;
+ height: 1px;
+ background-color: black;
+ position: relative;
+ top: calc(50% - .5px);
+}
+
+.tc-scrollbar__scroller {
+ height: 100%;
+ width: 20px;
+ box-sizing: border-box;
+ border: 3px solid black;
+ border-radius: 50%;
+ background-color: white;
+ position: absolute;
+ right: 0;
+}
diff --git a/html/timecontrol.html b/html/timecontrol.html
new file mode 100644
index 0000000..8f5ea64
--- /dev/null
+++ b/html/timecontrol.html
@@ -0,0 +1 @@
+
diff --git a/index.html b/index.html
index 5fc8ee2..672d21e 100644
--- a/index.html
+++ b/index.html
@@ -15,6 +15,13 @@
.post.reply.multifile .body {
clear: both;
}
+
+ .time-slider {
+ width: 70%;
+ margin-left: auto;
+ margin-right: auto;
+ display: block;
+ }
diff --git a/src/Action.hs b/src/Action.hs
index e60fc21..bba52fd 100644
--- a/src/Action.hs
+++ b/src/Action.hs
@@ -13,6 +13,8 @@ import Network.CatalogPostType (CatalogPost)
import Network.Http (HttpResult)
import Network.SiteType (Site)
import qualified Component.ThreadView as Thread
+import qualified Component.ThreadView as Thread
+import qualified Component.TimeControl as TC
data GetThreadArgs = GetThreadArgs
{ website :: Text
@@ -28,5 +30,6 @@ data Action
| HaveThread (HttpResult [ Site ])
| forall a. (FromJSON a) => ClientAction (HttpResult a -> Action) (C.Action a)
| ThreadAction Thread.Action
+ | TimeAction TC.Time
| ChangeURI URI
| NoAction
diff --git a/src/Component/TimeControl.hs b/src/Component/TimeControl.hs
new file mode 100644
index 0000000..66a2526
--- /dev/null
+++ b/src/Component/TimeControl.hs
@@ -0,0 +1,79 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Component.TimeControl where
+
+import Miso
+ ( View
+ , div_
+ , class_
+ , input_
+ , step_
+ , min_
+ , max_
+ , type_
+ , value_
+ , (<#)
+ , consoleLog
+ , Effect
+ , noEff
+ , onInput
+ , onChange
+ )
+
+import Miso.String (toMisoString)
+import Data.Time.Clock (UTCTime)
+import GHCJS.DOM.Types (JSString)
+
+data Time
+ = Now
+ | At UTCTime
+ | NoAction
+ | SlideInput JSString
+ | SlideChange JSString
+ deriving Show
+
+data Interface a = Interface
+ { passAction :: Time -> a
+ }
+
+view :: Interface a -> View a
+view iface =
+ div_
+ [ class_ "time-control"
+ ]
+ [ input_
+ [ class_ "time-slider"
+ , type_ "range"
+ , min_ "-500"
+ , max_ "0"
+ , step_ "1"
+ , value_ "0"
+ , onInput $ pass SlideInput
+ , onChange $ pass SlideChange
+ ]
+ ]
+
+ where
+ pass action = \t -> passAction iface $ action t
+
+update
+ :: Interface a
+ -> Time
+ -> ()
+ -> Effect a ()
+update iface (At time) m = m <# do
+ consoleLog $ toMisoString $ show time
+
+ return $ (passAction iface) NoAction
+
+update iface (SlideInput time) m = m <# do
+ consoleLog $ "Input: " <> time
+
+ return $ (passAction iface) NoAction
+
+update iface (SlideChange time) m = m <# do
+ consoleLog $ "Change: " <> time
+
+ return $ (passAction iface) NoAction
+
+update _ _ m = noEff m
diff --git a/src/Main.hs b/src/Main.hs
index 80d3f7d..d802233 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -46,6 +46,7 @@ import Network.CatalogPostType (CatalogPost)
import qualified Network.CatalogPostType as CatalogPost
import qualified Component.CatalogGrid as Grid
import qualified Component.ThreadView as Thread
+import qualified Component.TimeControl as TC
data Model = Model
@@ -144,6 +145,7 @@ mainView model = view
catalog_view :: Model -> View Action
catalog_view _ = div_ []
[ h1_ [] [ text "Overboard Catalog" ]
+ , TC.view iTime
, Grid.view iGrid (grid_model model)
]
@@ -203,8 +205,8 @@ mainUpdate (GetThread GetThreadArgs {..}) m = m <# do
show board_thread_id
}
-mainUpdate (ChangeURI old_uri) m = m { current_uri = old_uri } <# do
- consoleLog $ "ChangeURI! " `append` (pack $ show $ old_uri)
+mainUpdate (ChangeURI uri) m = m { current_uri = uri } <# do
+ consoleLog $ "ChangeURI! " `append` (pack $ show $ uri)
return NoAction
mainUpdate (GridAction ga) m =
@@ -222,6 +224,10 @@ mainUpdate (ThreadAction ta) model = do
noEff model { thread_model = tm }
+mainUpdate (TimeAction ta) m =
+ TC.update iTime ta ()
+ >> noEff m
+
iGrid :: Grid.Interface Action
iGrid = Grid.Interface
@@ -246,6 +252,9 @@ iClient action = Client.Interface
iThread :: Thread.Interface Action
iThread = Thread.Interface { Thread.passAction = ThreadAction }
+iTime :: TC.Interface Action
+iTime = TC.Interface { TC.passAction = TimeAction }
+
{-
- TODO:
- - Create the thread view