work on updates to get diagrams-doc to build

diagrams · Sep 17, 2021 · 5207e4b · 5207e4b
1 parent c1faa96
commit 5207e4b
Show file tree

Hide file tree

Showing 4 changed files with 50 additions and 47 deletions.
diff --git a/Shake.hs b/Shake.hs
@@ -1,24 +1,22 @@
 {-# LANGUAGE DeriveDataTypeable         #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 
-import           Control.Concurrent          (getNumCapabilities)
-import           Control.Monad               (when)
-import           Data.List                   (isPrefixOf)
-import           Data.Maybe                  (fromMaybe)
-import           Development.Shake           hiding ((<//>))
-import           Development.Shake.FilePath  (dropDirectory1, dropExtension,
-                                              takeBaseName, takeDirectory,
-                                              (-<.>), (<.>), (</>))
-import           Safe                        (readMay)
+import           Control.Concurrent         (getNumCapabilities)
+import           Control.Monad              (when)
+import           Data.List                  (isPrefixOf)
+import           Data.Maybe                 (fromMaybe)
+import           Development.Shake          hiding ((<//>))
+import           Development.Shake.FilePath (dropDirectory1, dropExtension,
+                                             takeBaseName, takeDirectory,
+                                             (-<.>), (<.>), (</>))
+import           Safe                       (readMay)
 import           System.Console.CmdArgs
-import           System.Directory            (createDirectoryIfMissing)
-import           System.Environment          (lookupEnv)
-import           System.Process              (system)
-import           System.Exit                 (ExitCode(..))
+import           System.Directory           (createDirectoryIfMissing)
+import           System.Environment         (lookupEnv)
+import           System.Exit                (ExitCode (..))
+import           System.Process             (system)
 
-import           Text.Docutils.CmdLine       (DocutilOpts(..))
-
-import           Prelude                     hiding ((*>))
+import           Text.Docutils.CmdLine      (DocutilOpts (..))
 
 import qualified BuildBanner
 import qualified BuildGallery
@@ -86,7 +84,7 @@ main = do
       action $ requireGallery
       action $ requireBanner
 
-      dist "//*.html" *> \out -> do
+      dist "//*.html" %> \out -> do
         let xml = obj . un $ out -<.> "xml"
         need [xml]
 
@@ -104,10 +102,10 @@ main = do
             ExitFailure code ->
               fail ("Xml2Html exited with code " ++ show code ++ " for " ++ out)
 
-      dist "blog/*.metadata" *> \out -> copyFile' (un out) out
-      dist "doc/*.metadata"  *> \out -> copyFile' (un out) out
+      dist "blog/*.metadata" %> \out -> copyFile' (un out) out
+      dist "doc/*.metadata"  %> \out -> copyFile' (un out) out
 
-      obj "//*.xml" *> \out -> do
+      obj "//*.xml" %> \out -> do
         let rst = un $ out -<.> "rst"
         need [rst]
         command_ [] "rst2xml" ["--input-encoding=utf8", rst, out]
@@ -116,21 +114,21 @@ main = do
         makeIcon out = runExe [] exe ["-w", "40", "-h", "40", "-o", out]
           where exe = takeBaseName out
 
-      dist ("doc/icons/Exercises" <.> imgExt) *> makeIcon
-      dist ("doc/icons/ToWrite"   <.> imgExt) *> makeIcon
-      dist ("doc/icons/Warning"   <.> imgExt) *> makeIcon
+      dist ("doc/icons/Exercises" <.> imgExt) %> makeIcon
+      dist ("doc/icons/ToWrite"   <.> imgExt) %> makeIcon
+      dist ("doc/icons/Warning"   <.> imgExt) %> makeIcon
 
       copyFiles "doc/static"
 
-      dist ("web/gallery/*.big" <.> imgExt) *> \out -> do
+      dist ("web/gallery/*.big" <.> imgExt) %> \out -> do
         need [dropExtension (un out) -<.> "lhs"]
         withResource ghcThreads 1 $ compileImg False out
 
-      dist ("web/gallery/*.thumb" <.> imgExt) *> \out -> do
+      dist ("web/gallery/*.thumb" <.> imgExt) %> \out -> do
         need [dropExtension (un out) -<.> "lhs"]
         withResource ghcThreads 1 $ compileImg True out
 
-      dist ("web/banner/banner" <.> imgExt) *> \out -> do
+      dist ("web/banner/banner" <.> imgExt) %> \out -> do
         need [dropExtension (un out) -<.> "hs"]
         let name = takeBaseName (takeBaseName out)
             hsName = "web/banner" </> name -<.> "hs"
@@ -147,7 +145,7 @@ compileImg isThumb outPath = do
   liftIO $ BuildGallery.compileExample thumb lhsName outPath
 
 copyFiles :: FilePath -> Rules ()
-copyFiles dir = dist (dir ++ "/*") *> \out -> copyFile' (un out) out
+copyFiles dir = dist (dir ++ "/*") %> \out -> copyFile' (un out) out
 
 requireIcons :: Action ()
 requireIcons = do

diff --git a/generate-stack-yaml.hs b/generate-stack-yaml.hs
@@ -41,6 +41,7 @@ mkYamlFile deps = Yaml.mapping
     , "pandoc-types-1.22"
     , "force-layout-0.4.0.6"
     , "svg-builder-0.1.1"
+    , "SVGFonts-1.7.0.1"
     , "hakyll-4.14.1.0"
     , "palette-0.3.0.2"
     , "active-0.2.0.15"
@@ -102,5 +103,4 @@ repoNames =
   , "docutils"
   , "dual-tree"
   , "monoid-extras"
-  , "SVGFonts"
   ]
diff --git a/web/Site.hs b/web/Site.hs
@@ -1,22 +1,24 @@
+{-# LANGUAGE FlexibleContexts          #-}
 {-# LANGUAGE NoMonomorphismRestriction #-}
 {-# LANGUAGE OverloadedStrings         #-}
-{-# LANGUAGE FlexibleContexts          #-}
 
 module Site where
 
-import           Control.Monad   (forM_, (>=>))
-import           Data.List       (isPrefixOf, sortOn)
-import           Data.Maybe      (fromMaybe)
-import           Data.Monoid     ((<>))
-import           Data.String     (IsString, fromString)
+import           Control.Monad         (forM_, (>=>))
+import           Data.List             (isPrefixOf, sortOn)
+import           Data.Maybe            (fromMaybe)
+import           Data.Monoid           ((<>))
+import           Data.String           (IsString, fromString)
 
-import           System.FilePath ((</>), splitFileName, replaceExtension)
+import           System.FilePath       (replaceExtension, splitFileName, (</>))
 
-import           Data.Text       (Text)
-import qualified Data.Text       as T
-import           Text.Pandoc     (writerTemplate, readMarkdown,
-                                  writeHtml5String, bottomUp, ReaderOptions,
-                                  WriterOptions, MathType(..), Inline(..), runPure)
+import           Data.Text             (Text)
+import qualified Data.Text             as T
+import           Text.Pandoc           (Inline (..), MathType (..),
+                                        ReaderOptions, WriterOptions, bottomUp,
+                                        readMarkdown, runPure, writeHtml5String,
+                                        writerTemplate)
+import qualified Text.Pandoc.Templates as PT
 
 import           Hakyll
 
@@ -237,11 +239,11 @@ escapeForTemplate = concatMap f
 
 buildBannerCSS :: Item String -> Compiler (Item String)
 buildBannerCSS b = do
-    t <- loadBody (fromFilePath "banner/template.css")
+  -- t <- loadBody "banner/template.css"
     m <- loadAndApplyTemplate "templates/banner.markdown" defaultContext b
     return $ renderMarkdownPandocWith
                defaultHakyllReaderOptions
-               defaultHakyllWriterOptions { writerTemplate = t }
+               defaultHakyllWriterOptions -- { writerTemplate = t }
                (T.pack <$> m)
 
 buildBannerHtml :: Item String -> Compiler (Item String)
@@ -261,9 +263,9 @@ renderMarkdownPandoc = renderMarkdownPandocWith
 withMathJax :: Item String -> Compiler (Item String)
 withMathJax = fmap (writePandoc . fmap (bottomUp latexToMathJax)) . readPandoc
   where latexToMathJax (Math InlineMath str)
-          = RawInline "html" ("\\(" ++ str ++ "\\)")
+          = RawInline "html" (T.concat["\\(", str, "\\)"])
         latexToMathJax (Math DisplayMath str)
-          = RawInline "html" ("\\[" ++ str ++ "\\]")
+          = RawInline "html" (T.concat["\\(", str, "\\)"])
         latexToMathJax x = x
 
 indexCompiler :: Context String -> Item String -> Compiler (Item String)
@@ -314,7 +316,7 @@ markdownFieldCtx f = field f $ \i -> do
         p <- readMarkdown defaultHakyllReaderOptions (T.pack markdown)
         writeHtml5String defaultHakyllWriterOptions p
   return $ case res of
-    Left e -> show e
+    Left e  -> show e
     Right r -> T.unpack r
 
 buildGallery :: Item String -> [Item String] -> Compiler (Item String)

diff --git a/web/gallery/Quasifuchsian.lhs b/web/gallery/Quasifuchsian.lhs
@@ -41,10 +41,13 @@ A *Moebius transformation* is a mapping of the (projective) complex plane `C` on
 
 Moebius transformations form a *group*. The composition of Moebius transformations follows the well-known laws for matrix multiplcation
 
+> instance Semigroup Moebius where
+>     (M a b c d) <> (M a1 b1 c1 d1) =
+>         M (a*a1 + b*c1) (a*b1 + b*d1) (c*a1 + d*c1) (c*b1 + d*d1)
+>
 > instance Monoid Moebius where
 >     mempty = M 1 0 0 1
->     mappend (M a b c d) (M a1 b1 c1 d1) =
->         M (a*a1 + b*c1) (a*b1 + b*d1) (c*a1 + d*c1) (c*b1 + d*d1)
+>     mappend = (<>)
 
 and so does taking their inverse.