diff --git a/make-pages/ImagePage.hs b/make-pages/ImagePage.hs
new file mode 100644
index 0000000..0e37441
--- /dev/null
+++ b/make-pages/ImagePage.hs
@@ -0,0 +1,95 @@
+{-# OPTIONS_GHC -fdefer-typed-holes #-}
+module ImagePage
+ (make)
+where
+
+import Info hiding (Text)
+import qualified Data.Text as Strict
+import qualified Data.Text.Lazy as Lazy
+import Data.Text.Lazy.Builder
+import Data.Time (formatTime, defaultTimeLocale)
+import qualified Data.Char as Char
+import qualified Data.Vector as Vector
+
+
+make :: Info -> Lazy.Text
+make = toLazyText . make'
+
+make' :: Info -> Builder
+make' (Info {..}) =
+ "\n" <>
+ "\n" <>
+ "\n" <>
+ "\n\n" <>
+ "" <> esc title <> "\n\n" <>
+ "\n" <>
+ " " <> esc title <> "
\n" <>
+ " " <> formatDate date <> "
\n" <>
+ " \n" <>
+ "\n\n" <>
+ "\n" <>
+ " ![](\"")
path0 <> "\">\n" <>
+ " \n" <>
+ indent 4 description <>
+ " \n\n" <>
+ " links
\n" <>
+ " \n" <>
+ foldMap extLink links <>
+ "
\n" <>
+ "\n\n" <>
+ "\n"
+ where
+ path0 = let Image {..} = Vector.head images in fromText path
+
+
+esc :: Strict.Text -> Builder
+esc = foldMap esc1 . Strict.unpack where
+ esc1 '<' = "<"
+ esc1 '>' = ">"
+ esc1 '&' = "&"
+ esc1 '"' = """
+ esc1 '\'' = "&squot;"
+ esc1 c = singleton c
+
+formatDate :: Day -> Builder
+formatDate = fromString . formatTime defaultTimeLocale "%e %#B %Y"
+
+altButton :: Int -> Image -> Builder
+altButton i (Image {..}) =
+ " \n" <>
+ " checked <> "id=\"" <> idLabel <> "\" " <>
+ "name=variant autocomplete=off\n" <>
+ " value=\"" <> fromText path <> "\">\n" <>
+ " \n"
+ where
+ checked = if i == 0 then "checked " else ""
+ idLabel = escId label
+
+escId :: Strict.Text -> Builder
+escId = foldMap esc1 . Strict.unpack where
+ esc1 c
+ | Char.isSpace c = ""
+ | c < 'ΓΏ' && not (Char.isAlphaNum c || c == '-') = "_"
+ | otherwise = singleton c
+
+indent :: Int -> Strict.Text -> Builder
+indent n txt = spaces <> go (Strict.unpack txt) where
+ go "" = mempty
+ go "\n" = "\n"
+ go ('\n':cs) = singleton '\n' <> spaces <> go cs
+ go (c:cs) = singleton c <> go cs
+ spaces = fromString $ replicate n ' '
+
+extLink :: Link -> Builder
+extLink (Link {..}) =
+ " \n" <>
+ " fromText url <> "\">\n" <>
+ " " <> fromText title <> "\n" <>
+ " \n"
diff --git a/make-pages/make-pages.cabal b/make-pages/make-pages.cabal
index 509acca..96fcd95 100644
--- a/make-pages/make-pages.cabal
+++ b/make-pages/make-pages.cabal
@@ -9,7 +9,7 @@ maintainer: Rhiannon Morris
executable make-pages
hs-source-dirs: .
main-is: Main.hs
- other-modules: Info
+ other-modules: Info, ImagePage
default-language: Haskell2010
default-extensions:
BlockArguments,
@@ -23,7 +23,6 @@ executable make-pages
time ^>= 1.8.0.2,
text ^>= 1.2.3.1,
vector ^>= 0.12.1.2,
- HsYAML ^>= 0.2.1.0,
- blaze-html ^>= 0.9.1.2
+ HsYAML ^>= 0.2.1.0
ghc-options:
-Wall -threaded -rtsopts -with-rtsopts=-N