Working on assets

12 files changed, 193 insertions, 52 deletions

diff --git a/js/colors.js b/js/colors.js
new file mode 100644
index 0000000..158ad52
--- /dev/null
+++ b/js/colors.js
@@ -0,0 +1,16 @@
+// @license http://www.wtfpl.net/txt/copying/" WTFPL
+
+if ( localStorage.getItem("color-mode") === "dark" ||
+    ( !localStorage.getItem("color-mode") && window.matchMedia('(prefers-color-scheme: dark)').matches )
+) {
+    document.documentElement.setAttribute("color-mode", "dark");
+};
+
+function toggleColorMode() {
+    var doc = document.documentElement;
+    var color = doc.getAttribute("color-mode") == "dark" ? "light" : "dark";
+    doc.setAttribute("color-mode", color);
+    localStorage.setItem("color-mode", color);
+};
+
+// @license-end
diff --git a/js/toggle.js b/js/toggle.js
new file mode 100644
index 0000000..884e0bf
--- /dev/null
+++ b/js/toggle.js
@@ -0,0 +1,8 @@
+// @license http://www.wtfpl.net/txt/copying/" WTFPL
+
+function toggle(divid) {
+    var cont = document.getElementById(divid);
+    cont.style.display = cont.style.display == 'none' ? 'block' : 'none';
+}
+
+// @license-end
diff --git a/nix/build.nix b/nix/build.nix
index 0844618..e3b6f5f 100644
--- a/nix/build.nix
+++ b/nix/build.nix
@@ -1,10 +1,29 @@
-{ runCommand, buildAssets, ... }:
-runCommand "www-assets" {
+{ stdenvNoCC, buildAssets, nodePackages, fontawesome, ... }:
+stdenvNoCC.mkDerivation (finalAttrs: {
+  pname = "www-assets";
+  src = buildins.path {
+    path = ../.;
+    name = "assets";
+  };
   nativeBuildInputs = [
     buildAssets
+    nodePackages.katex
+    fontaweoms
   ];
-} ''
-  mkdir -p $out/{css,logos,favicon}
+  phases = "installPhase";
 
+  installPhase = ''
+    mkdir -p $out/{css,logos,favicon}
 
-''
+    # javascript
+    cp -r $src/js $out/js
+
+    # fontawesome
+    mkdir -p $out/fontawesome
+    cp -r ${fontawesome}/{css,webfonts} $out/fontawesome
+
+    # katex
+    cp -r ${nodePackages.katex}/lib/node_modules/katex/dist $out/katex
+
+  ''
+})
diff --git a/nix/fontawesome.nix b/nix/fontawesome.nix
new file mode 100644
index 0000000..e824ace
--- /dev/null
+++ b/nix/fontawesome.nix
@@ -0,0 +1,10 @@
+{ fetchFromGitHub, ... }:
+let
+  version = "6.7.2";
+in (fetchFromGitHub {
+    owner = "FortAwesome";
+    repo = "Font-Awesome";
+    rev = version;
+}) // {
+  inherit version;
+}
diff --git a/nix/overlay.nix b/nix/overlay.nix
index 0ca77ce..644829b 100644
--- a/nix/overlay.nix
+++ b/nix/overlay.nix
@@ -10,12 +10,15 @@ final: prev: let
     ];
   };
 in {
+  fontawesome = prev.callPackage ./fontawesome.nix {};
+
   haskellPackages = prev.haskellPackages.extend (hfinal: hprev: {
     www-assets = hfinal.callCabal2nix "www-assets" src {};
   });
 
   www-assets = prev.callPackage ./build.nix {
     buildAssets = final.haskell.lib.compose.justStaticExecutables final.haskellPackages.www-assets;
+    inherit (final) fontawesome;
   };
 
 }
diff --git a/package.yaml b/package.yaml
index 9ffd5a1..853c8a7 100644
--- a/package.yaml
+++ b/package.yaml
@@ -20,21 +20,22 @@ ghc-options:
   - -Wpartial-fields
   - -Wredundant-constraints
 
+default-extensions:
+  - BangPatterns
+  - DeriveGeneric
+  - DeriveLift
+  - DerivingStrategies
+  - DefaultSignatures
+  - FunctionalDependencies
+  - GADTs
+  - LambdaCase
+  - MultiWayIf
+  - OverloadedStrings
+  - PatternSynonyms
+  - TypeFamilies
+
 library:
   source-dirs: src
-  default-extensions:
-    - BangPatterns
-    - DeriveGeneric
-    - DeriveLift
-    - DerivingStrategies
-    - DefaultSignatures
-    - FunctionalDependencies
-    - GADTs
-    - LambdaCase
-    - MultiWayIf
-    - OverloadedStrings
-    - PatternSynonyms
-    - TypeFamilies
   dependencies:
     - clay
     - colour
diff --git a/src/WWW/Colors.hs b/src/WWW/Colors.hs
index a266414..eff09f4 100644
--- a/src/WWW/Colors.hs
+++ b/src/WWW/Colors.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE QuasiQuotes #-}
 module WWW.Colors
     ( Gruvbox (..)
@@ -22,39 +23,82 @@ data Gruvbox a = Gruvbox
     { _bg, _red, _green, _yellow, _blue, _purple, _aqua, _gray, _gray', _red', _green', _yellow', _blue', _purple', _aqua', _fg, _bg0h, _bg0, _bg0s, _bg1, _bg2, _bg3, _bg4, _gray'', _orange, _fg4, _fg3, _fg2, _fg1, _fg0, _orange' :: !a
     } deriving stock (Foldable, Functor, Eq, Show, Traversable)
 
+instance Applicative Gruvbox where
+    pure a = Gruvbox a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a
+    {-# INLINE pure #-}
+    (<*>) :: Gruvbox (a -> b) -> Gruvbox a -> Gruvbox b
+    g <*> x = Gruvbox
+        { _bg = ag _bg g x
+        , _red = ag _red g x
+        , _green = ag _green g x
+        , _yellow = ag _yellow g x
+        , _blue = ag _blue g x
+        , _purple = ag _purple g x
+        , _aqua = ag _aqua g x
+        , _gray = ag _gray g x
+        , _gray' = ag _gray' g x
+        , _red' = ag _red' g x
+        , _green' = ag _green' g x
+        , _yellow' = ag _yellow' g x
+        , _blue' = ag _blue' g x
+        , _purple' = ag _purple' g x
+        , _aqua' = ag _aqua' g x
+        , _fg = ag _fg g x
+        , _bg0h = ag _bg0h g x
+        , _bg0 = ag _bg0 g x
+        , _bg0s = ag _bg0s g x
+        , _bg1 = ag _bg1 g x
+        , _bg2 = ag _bg2 g x
+        , _bg3 = ag _bg3 g x
+        , _bg4 = ag _bg4 g x
+        , _gray'' = ag _gray'' g x
+        , _orange = ag _orange g x
+        , _fg4 = ag _fg4 g x
+        , _fg3 = ag _fg3 g x
+        , _fg2 = ag _fg2 g x
+        , _fg1 = ag _fg1 g x
+        , _fg0 = ag _fg0 g x
+        , _orange' = ag _orange g x
+        }
+    {-# INLINE (<*>) #-}
+
+ag :: (forall x . Gruvbox x -> x) -> Gruvbox (a -> b) -> Gruvbox a -> b
+ag f g x = f g $ f x
+{-# INLINE ag #-}
+
 gruvboxVar :: IsString s => Gruvbox s
 gruvboxVar = Gruvbox
-    { _bg = "gb_bg"
-    , _red = "gb_red"
-    , _green = "gb_green"
-    , _yellow = "gb_yellow"
-    , _blue = "gb_blue"
-    , _purple = "gb_purple"
-    , _aqua = "gb_aqua"
-    , _gray = "gb_gray"
-    , _gray' = "gb_gray'"
-    , _red' = "gb_red'"
-    , _green' = "gb_green'"
-    , _yellow' = "gb_yellow'"
-    , _blue' = "gb_blue'"
-    , _purple' = "gb_purple'"
-    , _aqua' = "gb_aqua'"
-    , _fg = "gb_fg"
-    , _bg0h = "gb_bg0h"
-    , _bg0 = "gb_bg0"
-    , _bg0s = "gb_bg0s"
-    , _bg1 = "gb_bg1"
-    , _bg2 = "gb_bg2"
-    , _bg3 = "gb_bg3"
-    , _bg4 = "gb_bg4"
-    , _gray'' = "gb_gray''"
-    , _orange = "gb_orange"
-    , _fg4 = "gb_fg4"
-    , _fg3 = "gb_fg3"
-    , _fg2 = "gb_fg2"
-    , _fg1 = "gb_fg1"
-    , _fg0 = "gb_fg0"
-    , _orange' = "gb_orange'"
+    { _bg = "bg"
+    , _red = "red"
+    , _green = "green"
+    , _yellow = "yellow"
+    , _blue = "blue"
+    , _purple = "purple"
+    , _aqua = "aqua"
+    , _gray = "gray"
+    , _gray' = "gray'"
+    , _red' = "red'"
+    , _green' = "green'"
+    , _yellow' = "yellow'"
+    , _blue' = "blue'"
+    , _purple' = "purple'"
+    , _aqua' = "aqua'"
+    , _fg = "fg"
+    , _bg0h = "bg0h"
+    , _bg0 = "bg0"
+    , _bg0s = "bg0s"
+    , _bg1 = "bg1"
+    , _bg2 = "bg2"
+    , _bg3 = "bg3"
+    , _bg4 = "bg4"
+    , _gray'' = "gray''"
+    , _orange = "orange"
+    , _fg4 = "fg4"
+    , _fg3 = "fg3"
+    , _fg2 = "fg2"
+    , _fg1 = "fg1"
+    , _fg0 = "fg0"
+    , _orange' = "orange'"
     }
 
 hard :: Gruvbox a -> Gruvbox a
diff --git a/src/WWW/Colors/Instances.hs b/src/WWW/Colors/Instances.hs
index 3fc7667..3dd6e6a 100644
--- a/src/WWW/Colors/Instances.hs
+++ b/src/WWW/Colors/Instances.hs
@@ -2,6 +2,7 @@
 module WWW.Colors.Instances where
 
 import Clay.Color qualified as Clay
+import Clay.Property qualified as Clay
 import Data.Colour
 import Data.Colour.SRGB (toSRGB24, sRGB24, RGB (..))
 import Diagrams.Attributes
@@ -13,7 +14,7 @@ instance Color Clay.Color where
     toAlphaColour col = case Clay.toRgba col of
                             Clay.Rgba r g b a ->
                                 let rgb = sRGB24 (fromInteger r) (fromInteger g) (fromInteger b)
-                                 in alphaColourConvert $ withOpacity rgb a
+                                 in alphaColourConvert $ rgb `withOpacity` a
                             _ -> error "Should not happen"
 
     fromAlphaColour :: AlphaColour Double -> Clay.Color
@@ -21,3 +22,6 @@ instance Color Clay.Color where
         let a = alphaChannel $ alphaColourConvert col
             RGB r g b = toInteger <$> toSRGB24 (fromAlphaColour @(Colour Double) col)
          in Clay.rgba r g b a
+
+instance Clay.Val SomeColor where
+    value = Clay.value . fromAlphaColour @Clay.Color . someToAlpha
diff --git a/src/WWW/Colors/QQ.hs b/src/WWW/Colors/QQ.hs
index 281a93a..f1dc256 100644
--- a/src/WWW/Colors/QQ.hs
+++ b/src/WWW/Colors/QQ.hs
@@ -20,7 +20,7 @@ data Color' = Color' !Double !Double !Double !Double
     deriving Lift
 
 instance Color Color' where
-    toAlphaColour (Color' r g b a) = withOpacity (sRGB r g b) a
+    toAlphaColour (Color' r g b a) = sRGB r g b `withOpacity` a
     fromAlphaColour col =
         let a = alphaChannel col
             RGB r g b = toSRGB $ fromAlphaColour @(Colour Double) col
diff --git a/src/WWW/Css.hs b/src/WWW/Css.hs
index 164b2af..05aec62 100644
--- a/src/WWW/Css.hs
+++ b/src/WWW/Css.hs
@@ -3,6 +3,8 @@ module WWW.Css where
 import Control.Monad
 import Clay
 import Clay.Flexbox qualified as F
+import Clay.Stylesheet
+import Data.Foldable (fold)
 import Data.Text (Text)
 import Diagrams.Attributes (SomeColor)
 
@@ -12,7 +14,13 @@ import WWW.Colors qualified as G
 
 colorVariables :: G.Gruvbox SomeColor -> Css
 colorVariables gb = do
-    "--html-bg" -: "test"
+    fold $ key <$> (("--" <>) <$> G.gruvboxVar) <*> gb
+    key "--html-bg" $ G._bg1 gb
+    key "--href" $ G._orange gb
+    key "--href-hover" $ G._orange' gb
+    key "--hr" $ G._gray gb
+    key "--code-bg" $ G._bg gb
+
 
 rootColors :: Css
 rootColors = do
diff --git a/src/WWW/Logos/Abacus.hs b/src/WWW/Logos/Abacus.hs
new file mode 100644
index 0000000..81653f6
--- /dev/null
+++ b/src/WWW/Logos/Abacus.hs
@@ -0,0 +1 @@
+module WWW.Logos.Abacus where
diff --git a/www-assets.cabal b/www-assets.cabal
index 140c2dc..aad8311 100644
--- a/www-assets.cabal
+++ b/www-assets.cabal
@@ -18,6 +18,7 @@ library
       WWW.Colors.Instances
       WWW.Colors.QQ
       WWW.Css
+      WWW.Logos.Abacus
   other-modules:
       Paths_www_assets
   hs-source-dirs:
@@ -52,6 +53,19 @@ executable css
       Paths_www_assets
   hs-source-dirs:
       app/css
+  default-extensions:
+      BangPatterns
+      DeriveGeneric
+      DeriveLift
+      DerivingStrategies
+      DefaultSignatures
+      FunctionalDependencies
+      GADTs
+      LambdaCase
+      MultiWayIf
+      OverloadedStrings
+      PatternSynonyms
+      TypeFamilies
   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints
   build-depends:
       base >=4.7 && <5
@@ -64,6 +78,19 @@ executable logos
       Paths_www_assets
   hs-source-dirs:
       app/logos
+  default-extensions:
+      BangPatterns
+      DeriveGeneric
+      DeriveLift
+      DerivingStrategies
+      DefaultSignatures
+      FunctionalDependencies
+      GADTs
+      LambdaCase
+      MultiWayIf
+      OverloadedStrings
+      PatternSynonyms
+      TypeFamilies
   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints
   build-depends:
       base >=4.7 && <5