From 92ad510218c7ebb648397423bc53a8d32a87ed67 Mon Sep 17 00:00:00 2001 From: Rhiannon Morris Date: Wed, 8 Jul 2020 05:28:09 +0200 Subject: [PATCH] add image page --- make-pages/ImagePage.hs | 95 +++++++++++++++++++++++++++++++++++++ make-pages/make-pages.cabal | 5 +- 2 files changed, 97 insertions(+), 3 deletions(-) create mode 100644 make-pages/ImagePage.hs 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" <> + "
\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