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