Add Concat and implement img body html
This commit is contained in:
		@@ -17,6 +17,7 @@ module DependencyGenerator
 | 
			
		||||
  , unzipDepGenM
 | 
			
		||||
 | 
			
		||||
  , appendStrings
 | 
			
		||||
  , concatStrings
 | 
			
		||||
  , joinPaths
 | 
			
		||||
  , fileComponents
 | 
			
		||||
  , isImageExtension
 | 
			
		||||
@@ -163,6 +164,9 @@ appendStrings (a, b) = do
 | 
			
		||||
  b' <- toToken b
 | 
			
		||||
  runFunction AppendStrings $ TupleToken (a', b')
 | 
			
		||||
 | 
			
		||||
concatStrings :: TokenableTo [String] a => a -> DepGenM' String
 | 
			
		||||
concatStrings a = runFunction ConcatStrings =<< toToken a
 | 
			
		||||
 | 
			
		||||
joinPaths :: (TokenableTo FilePath a, TokenableTo FilePath b) => (a, b) -> DepGenM' FilePath
 | 
			
		||||
joinPaths (a, b) = do
 | 
			
		||||
  a' <- toToken a
 | 
			
		||||
 
 | 
			
		||||
@@ -9,6 +9,9 @@ evalFunction f x = case (f, x) of
 | 
			
		||||
  (AppendStrings, Tuple (String _, String _)) ->
 | 
			
		||||
    String undefined
 | 
			
		||||
 | 
			
		||||
  (ConcatStrings, List _) ->
 | 
			
		||||
    String undefined
 | 
			
		||||
 | 
			
		||||
  (JoinPaths, Tuple (String _, String _)) ->
 | 
			
		||||
    String undefined
 | 
			
		||||
 | 
			
		||||
 
 | 
			
		||||
@@ -3,11 +3,19 @@ module SiteGenerator (generateSite) where
 | 
			
		||||
import Types
 | 
			
		||||
import DependencyGenerator
 | 
			
		||||
 | 
			
		||||
thumbnailImagePath :: Token FilePath -> Token FilePath -> DepGenM' FilePath
 | 
			
		||||
thumbnailImagePath outputDir filename = do
 | 
			
		||||
thumbnailImageFilename :: Token FilePath -> DepGenM' FilePath
 | 
			
		||||
thumbnailImageFilename filename = do
 | 
			
		||||
  (base, ext) <- untupleDepGenM (fileComponents filename)
 | 
			
		||||
  name <- appendStrings (appendStrings (base, inject "-thumbnail."), ext)
 | 
			
		||||
  joinPaths (outputDir, name)
 | 
			
		||||
  appendStrings (appendStrings (base, inject "-thumbnail."), ext)
 | 
			
		||||
 | 
			
		||||
makeImageHTML :: Token (FilePath, FilePath) -> DepGenM' String
 | 
			
		||||
makeImageHTML t = do
 | 
			
		||||
  (thumbnail, actual) <- untupleDepGenM t
 | 
			
		||||
  appendStrings (inject "<p><a href=\"",
 | 
			
		||||
                 appendStrings (actual,
 | 
			
		||||
                                appendStrings (inject "\"><img src=\"",
 | 
			
		||||
                                               appendStrings (thumbnail,
 | 
			
		||||
                                                              inject "\"></a></p>"))))
 | 
			
		||||
 | 
			
		||||
handleRecipeDir :: Token FilePath -> Token Template -> Token FilePath -> Token FilePath -> DepGenM ()
 | 
			
		||||
handleRecipeDir outputDir template indexName dir = do
 | 
			
		||||
@@ -20,11 +28,15 @@ handleRecipeDir outputDir template indexName dir = do
 | 
			
		||||
  imagePaths <- mapDepGenM (curry joinPaths dir) imageFilenames
 | 
			
		||||
  imagePathsOut <- mapDepGenM (curry joinPaths recipeDirOut) imageFilenames
 | 
			
		||||
  mapDepGenM_ copyFile' (ZipToken (imagePaths, imagePathsOut))
 | 
			
		||||
  thumbnailImagePaths <- mapDepGenM (thumbnailImagePath recipeDirOut) imageFilenames
 | 
			
		||||
  thumbnailImageFilenames <- mapDepGenM thumbnailImageFilename imageFilenames
 | 
			
		||||
  thumbnailImagePaths <- mapDepGenM (curry joinPaths recipeDirOut) thumbnailImageFilenames
 | 
			
		||||
  mapDepGenM_
 | 
			
		||||
    (\files -> convertImage (files, inject $ ResizeToWidth 800))
 | 
			
		||||
    (ZipToken (imagePaths, thumbnailImagePaths))
 | 
			
		||||
  htmlBody <- runPandoc (joinPaths (dir, inject "ret.md"))
 | 
			
		||||
  htmlBodyBase <- runPandoc (joinPaths (dir, inject "ret.md"))
 | 
			
		||||
  htmlBodyImages <- mapDepGenM makeImageHTML (ZipToken (thumbnailImageFilenames, imageFilenames))
 | 
			
		||||
  imagesHtml <- concatStrings htmlBodyImages
 | 
			
		||||
  htmlBody <- appendStrings (htmlBodyBase, imagesHtml)
 | 
			
		||||
  html <- applyTemplate (template, htmlBody)
 | 
			
		||||
  saveFile (html, joinPaths (recipeDirOut, indexName))
 | 
			
		||||
 | 
			
		||||
 
 | 
			
		||||
@@ -5,6 +5,7 @@ module Types.Function
 | 
			
		||||
import Language.Haskell.TH.Syntax (Lift)
 | 
			
		||||
 | 
			
		||||
data Function = AppendStrings
 | 
			
		||||
              | ConcatStrings
 | 
			
		||||
              | JoinPaths
 | 
			
		||||
              | FileComponents
 | 
			
		||||
              | IsImageExtension
 | 
			
		||||
 
 | 
			
		||||
		Reference in New Issue
	
	Block a user