Inline trivial definitions

This commit is contained in:
Niels G. W. Serup 2024-10-14 23:33:05 +02:00
parent 740cb67d66
commit b56853d133
No known key found for this signature in database
GPG Key ID: 38EEEBCE67324F19
7 changed files with 22 additions and 54 deletions

View File

@ -26,7 +26,6 @@ library
Types.Dependency
Types
DependencyGenerator
Functions.General
Functions.Image
Functions.Pandoc
Functions.Paths

View File

@ -1,13 +1,11 @@
module Functions
( module Functions.General
, module Functions.Image
( module Functions.Image
, module Functions.Pandoc
, module Functions.Paths
, module Functions.Template
, module Functions.Text
) where
import Functions.General
import Functions.Image
import Functions.Pandoc
import Functions.Paths

View File

@ -1,9 +0,0 @@
module Functions.General
( elemOf
) where
import Types (Token)
import DependencyGenerator (DepGenM, TokenableTo(..), onTupleToken)
elemOf :: (Eq t, TokenableTo t a, TokenableTo [t] b) => a -> b -> DepGenM (Token Bool)
elemOf = onTupleToken elem

View File

@ -19,12 +19,11 @@ runPandoc m = case P.runPure m of
Right result -> result
readMarkdown :: TokenableTo Text a => a -> DepGenM (Token Pandoc)
readMarkdown = onToken $ \contents ->
let settings = P.def { P.readerExtensions = P.extensionsFromList [ P.Ext_raw_html ] }
in runPandoc $ P.readMarkdown settings contents
readMarkdown = onToken $ runPandoc . P.readMarkdown settings
where settings = P.def { P.readerExtensions = P.extensionsFromList [ P.Ext_raw_html ] }
writeHtml :: TokenableTo Pandoc a => a -> DepGenM (Token Text)
writeHtml = onToken $ \pandoc -> runPandoc $ P.writeHtml5String P.def pandoc
writeHtml = onToken $ runPandoc . P.writeHtml5String P.def
extractTitle :: TokenableTo Pandoc a => a -> DepGenM (Token Text)
extractTitle = onToken $ \(PD.Pandoc _ blocks) -> case blocks of

View File

@ -9,12 +9,11 @@ module Functions.Paths
, copyTo
) where
import Functions.Text (lowerString)
import Functions.General (elemOf)
import Types (IsFunctionIO(..), Token(..))
import DependencyGenerator (DepGenM, TokenableTo(..), onToken, onTupleToken, toTupleToken,
runFunctionIO, runFunctionIO_, untupleSndDepGenM)
import Data.Char (toLower)
import qualified System.Directory as SD
joinPaths :: (TokenableTo FilePath a, TokenableTo FilePath b) => a -> b -> DepGenM (Token FilePath)
@ -30,8 +29,8 @@ fileComponents = onToken $ \s ->
hasExtension :: (TokenableTo [String] a, TokenableTo FilePath b) => a -> b -> DepGenM (Token Bool)
hasExtension exts filename = do
ext <- lowerString =<< untupleSndDepGenM =<< fileComponents filename
ext `elemOf` exts
ext <- onToken (map toLower) =<< untupleSndDepGenM =<< fileComponents filename
onTupleToken elem ext exts
data ListDirectory = ListDirectory deriving Show

View File

@ -1,34 +1,15 @@
module Functions.Text
( concatStrings
, concatTexts
, lowerString
, toText
, readTextFile
( readTextFile
, saveTextFile
) where
import Types (IsFunctionIO(..), Token)
import DependencyGenerator (DepGenM, TokenableTo(..), onToken, toTupleToken,
import DependencyGenerator (DepGenM, TokenableTo(..), toTupleToken,
runFunctionIO, runFunctionIO_)
import Data.Char (toLower)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as T
concatStrings :: TokenableTo [String] a => a -> DepGenM (Token String)
concatStrings = onToken concat
concatTexts :: TokenableTo [Text] a => a -> DepGenM (Token Text)
concatTexts = onToken T.concat
lowerString :: TokenableTo String a => a -> DepGenM (Token String)
lowerString = onToken (map toLower)
toText :: TokenableTo String a => a -> DepGenM (Token Text)
toText = onToken T.pack
data ReadTextFile = ReadTextFile deriving Show
instance IsFunctionIO ReadTextFile FilePath Text where
evalFunctionIO ReadTextFile s =

View File

@ -5,6 +5,7 @@ import DependencyGenerator
import Functions
import Data.Text (Text)
import qualified Data.Text as T
import Control.Monad (forM_)
handleRecipeDir :: Token FilePath -> Token Template -> Token FilePath -> Token FilePath -> DepGenM (Token Text)
@ -17,26 +18,26 @@ handleRecipeDir outputDir htmlTemplate indexName dir = do
path <- joinPaths dir name
path `copyTo` outputDir
(base, ext) <- untupleDepGenM $ fileComponents name
thumbnailName <- concatStrings [ pure base, inject "-thumbnail.", pure ext ]
thumbnailName <- onToken concat [ pure base, inject "-thumbnail.", pure ext ]
imageResized <- convertImage (openImage path) (inject (ResizeToWidth 800))
saveImage imageResized (joinPaths recipeDirOut thumbnailName)
concatTexts [ inject "<p class=\"image\"><a href=\""
, toText name
, inject "\"><img src=\""
, toText thumbnailName
, inject "\"></a></p>\n"
]
onToken T.concat [ inject "<p class=\"image\"><a href=\""
, onToken T.pack name
, inject "\"><img src=\""
, onToken T.pack thumbnailName
, inject "\"></a></p>\n"
]
ingredienserHeadline <- inject "## Ingredienser"
mdTemplate <- makeTemplate
(readTextFile (joinPaths dir (inject "ret.md")))
ingredienserHeadline
pandoc <- readMarkdown
$ applyTemplate mdTemplate
$ concatTexts [ inject "<p class=\"imagetext\">Opskrift fortsætter efter billedet.</p>\n"
, concatTexts htmlBodyImages
, inject "\n"
, pure ingredienserHeadline
]
$ onToken T.concat [ inject "<p class=\"imagetext\">Opskrift fortsætter efter billedet.</p>\n"
, onToken T.concat htmlBodyImages
, inject "\n"
, pure ingredienserHeadline
]
title <- extractTitle pandoc
html <- applyTemplate htmlTemplate
$ writeHtml pandoc