From 01b36caec81e98020900dec7e8a51cef1465c371 Mon Sep 17 00:00:00 2001 From: towards-a-new-leftypol Date: Tue, 5 Mar 2024 20:49:08 -0500 Subject: [PATCH] Move TimeControl component into Common --- chandlr.cabal | 2 +- src/Common | 2 +- src/Component/TimeControl.hs | 121 ----------------------------------- src/Main.hs | 2 +- 4 files changed, 3 insertions(+), 124 deletions(-) delete mode 100644 src/Component/TimeControl.hs diff --git a/chandlr.cabal b/chandlr.cabal index 8cee7e1..a2f3d8c 100644 --- a/chandlr.cabal +++ b/chandlr.cabal @@ -85,7 +85,7 @@ executable chandlr Parsing.QuoteLinkParser Parsing.EmbedParser Parsing.PostPartType - Component.TimeControl + Common.Component.TimeControl Component.Search Common.Component.Search.SearchTypes diff --git a/src/Common b/src/Common index 2d5c169..a86310c 160000 --- a/src/Common +++ b/src/Common @@ -1 +1 @@ -Subproject commit 2d5c169087d67f2444a5d231f44dcf90bae43054 +Subproject commit a86310c33167d3cc5e5e6908c33abb9daefdaab5 diff --git a/src/Component/TimeControl.hs b/src/Component/TimeControl.hs deleted file mode 100644 index 6a54bc9..0000000 --- a/src/Component/TimeControl.hs +++ /dev/null @@ -1,121 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} - -module Component.TimeControl where - -import Miso - ( View - , div_ - , class_ - , input_ - , step_ - , min_ - , max_ - , type_ - , value_ - , (<#) - , consoleLog - , Effect - , noEff - , onInput - , onChange - ) - -import Miso.String (toMisoString, fromMisoString) -import GHCJS.DOM.Types (JSString) -import Data.Time.Clock - ( UTCTime (..) - , getCurrentTime - , diffUTCTime - , addUTCTime - , secondsToDiffTime - ) -import Data.Time.Calendar (fromGregorian) - -data Time - = Now - | NoAction - | SlideInput JSString - | SlideChange JSString - deriving Show - -data Interface a = Interface - { passAction :: Time -> a - , goTo :: UTCTime -> a - } - -data Model = Model - { whereAt :: Integer - } deriving Eq - -initialModel :: Integer -> Model -initialModel = Model - -view :: Interface a -> Model -> View a -view iface m = - div_ - [ class_ "time-control" - ] - [ input_ - [ class_ "time-slider" - , type_ "range" - , min_ "-500" - , max_ "0" - , step_ "1" - , value_ $ toMisoString $ show (whereAt m) - , onInput $ pass SlideInput - , onChange $ pass SlideChange - ] - ] - - where - pass action = \t -> passAction iface $ action t - -update - :: Interface a - -> Time - -> Model - -> Effect a Model -update iface (SlideInput nstr) m = m <# do - consoleLog $ "Input: " <> nstr - - return $ (passAction iface) NoAction - -update iface (SlideChange nstr) m = m { whereAt = n } <# do - consoleLog $ "Change: " <> nstr - - now <- getCurrentTime - - let newTime = interpolateTimeHours n now - - return $ (goTo iface) newTime - - where - n :: Integer - n = read $ fromMisoString nstr - -update _ _ m = noEff m - - -earliest :: UTCTime ---earliest = UTCTime (fromGregorian 2020 12 20) (secondsToDiffTime 82643) -earliest = UTCTime (fromGregorian 2020 12 20) (secondsToDiffTime 82644) - - --- Linear interpolation function using hours -interpolateTimeHours :: Integer -> UTCTime -> UTCTime -interpolateTimeHours n currentTime - | n == 0 = currentTime - | n == -500 = earliest - | otherwise = addUTCTime (fromIntegral hoursToAdjust * secondsInHour) currentTime - - where - -- Calculate the total number of hours between the current time and the target date - totalHours = diffUTCTime currentTime earliest / secondsInHour - - -- Calculate the number of hours to adjust based on linear interpolation - hoursToAdjust :: Integer - hoursToAdjust = round $ totalHours * (fromIntegral n / 500.0) - - -- One hour in seconds - secondsInHour = 3600 diff --git a/src/Main.hs b/src/Main.hs index ddcf505..6edd3b2 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -50,7 +50,7 @@ import Common.Network.CatalogPostType (CatalogPost) import qualified Common.Network.CatalogPostType as CatalogPost import qualified Component.CatalogGrid as Grid import qualified Component.ThreadView as Thread -import qualified Component.TimeControl as TC +import qualified Common.Component.TimeControl as TC import qualified Component.Search as Search import qualified Common.Component.Search.SearchTypes as Search