/ frontend / src / Theme.hs
Theme.hs
 1  module Theme (setDarkModeOn, getSystemDarkModeEvent) where
 2  
 3  import Data.Text (Text)
 4  import JSDOM (currentDocumentUnchecked, currentWindowUnchecked)
 5  import JSDOM.Generated.Document (getDocumentElementUnchecked)
 6  import JSDOM.Generated.Element (setAttribute)
 7  import JSDOM.Generated.MediaQueryList (getMatches)
 8  import JSDOM.Generated.Window (matchMedia)
 9  import Language.Javascript.JSaddle (JSM, liftJSM)
10  import Reflex.Dom.Core
11  import Reflex.Extra (onClient)
12  
13  setDarkMode :: Bool -> JSM ()
14  setDarkMode dark = do
15    documentElement <- getDocumentElementUnchecked =<< currentDocumentUnchecked
16    setAttribute documentElement ("data-theme" :: Text) theme
17    where
18      theme :: Text
19      theme
20        | dark = "dark"
21        | otherwise = "light"
22  
23  setDarkModeOn ::
24    forall m t.
25    ( Prerender t m,
26      Applicative m
27    ) =>
28    Event t Bool ->
29    m (Event t ())
30  setDarkModeOn = onClient . performEvent . fmap (liftJSM . setDarkMode)
31  
32  getSystemDarkMode :: JSM Bool
33  getSystemDarkMode = currentWindowUnchecked >>= flip matchMedia query >>= getMatches
34    where
35      query :: Text
36      query = "(prefers-color-scheme: dark)"
37  
38  getSystemDarkModeEvent ::
39    forall m t. (Prerender t m, Monad m, MonadHold t m) => m (Event t Bool)
40  getSystemDarkModeEvent = do
41    dyDarkMode <- prerender (pure False) . liftJSM $ getSystemDarkMode
42    -- Return only the first event, we're only interested in the initial value
43    headE $ updated dyDarkMode