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