diff --git a/byg/src/DependencyGenerator.hs b/byg/src/DependencyGenerator.hs index 92129a9..0a6f4d8 100644 --- a/byg/src/DependencyGenerator.hs +++ b/byg/src/DependencyGenerator.hs @@ -4,6 +4,7 @@ module DependencyGenerator ( DepGenM , DepGenM' , evalDepGenM + , TokenableTo(..) , inject , runFunction , runFunctionIO @@ -24,7 +25,8 @@ module DependencyGenerator , concatTexts , joinPaths , fileComponents - , hasImageExtension + , lowerString + , elemOf , applyTemplate , toText , listDirectory @@ -38,6 +40,8 @@ module DependencyGenerator , runPandoc ) where +import Prelude hiding (String, FilePath) + import Types.Token (Token(..)) import Types.Values import Types.Value (Valuable(..)) @@ -200,8 +204,14 @@ joinPaths a b = do fileComponents :: TokenableTo FilePath a => a -> DepGenM' (String, String) fileComponents a = runFunction FileComponents =<< toToken a -hasImageExtension :: TokenableTo FilePath a => a -> DepGenM' Bool -hasImageExtension a = runFunction HasImageExtension =<< toToken a +lowerString :: TokenableTo String a => a -> DepGenM' String +lowerString a = runFunction LowerString =<< toToken a + +elemOf :: (TokenableTo String a, TokenableTo [String] b) => a -> b -> DepGenM' Bool +elemOf a b = do + a' <- toToken a + b' <- toToken b + runFunction ElemOf $ TupleToken (a', b') applyTemplate :: (TokenableTo Template a, TokenableTo Text b) => a -> b -> DepGenM' Text applyTemplate a b = do diff --git a/byg/src/Evaluation/Function.hs b/byg/src/Evaluation/Function.hs index cd3e0d7..aa96038 100644 --- a/byg/src/Evaluation/Function.hs +++ b/byg/src/Evaluation/Function.hs @@ -2,28 +2,36 @@ module Evaluation.Function ( evalFunction ) where -import Types (Function(..), Value(..), Template(..), fromValue) +import Prelude hiding (String, FilePath) +import qualified Prelude + +import Types (Function(..), Value(..), String(..), Template(..), fromValue) import Data.Char (toLower) import qualified Data.Text as T -fileComponents :: String -> (String, String) +fileComponents :: Prelude.String -> (Prelude.String, Prelude.String) fileComponents s = let (lastRev, firstRev) = span (/= '.') $ reverse s in case firstRev of _ : firstRev' -> (reverse firstRev', reverse lastRev) [] -> (reverse lastRev, "") -isImageExtension :: String -> Bool -isImageExtension = (`elem` ["jpg"]) . map toLower +makeString :: Prelude.String -> Value +makeString = String . StringWrapper + +unStringWrapper :: Value -> Prelude.String +unStringWrapper = \case + String (StringWrapper s) -> s + _ -> error "unexpected" evalFunction :: Function -> Value -> Value evalFunction f x = case (f, x) of - (AppendStrings, Tuple (String s0, String s1)) -> - String (s0 ++ s1) + (AppendStrings, Tuple (String (StringWrapper s0), String (StringWrapper s1))) -> + makeString (s0 ++ s1) (ConcatStrings, List vs) -> - String $ concatMap fromValue vs + makeString $ concatMap unStringWrapper vs (AppendTexts, Tuple (Text t0, Text t1)) -> Text $ T.append t0 t1 @@ -31,21 +39,23 @@ evalFunction f x = case (f, x) of (ConcatTexts, List vs) -> Text $ T.concat $ map fromValue vs - (JoinPaths, Tuple (String s0, String s1)) -> - String (s0 ++ "/" ++ s1) + (JoinPaths, Tuple (String (StringWrapper s0), String (StringWrapper s1))) -> + makeString (s0 ++ "/" ++ s1) - (FileComponents, String s) -> + (FileComponents, String (StringWrapper s)) -> let (base, ext) = fileComponents s - in Tuple (String base, String ext) + in Tuple (makeString base, makeString ext) - (HasImageExtension, String s) -> - let (_, ext) = fileComponents s - in Bool $ isImageExtension ext + (LowerString, String (StringWrapper s)) -> + makeString $ map toLower s + + (ElemOf, Tuple (y, List ys)) -> + Bool (y `elem` ys) (ApplyTemplate, Tuple (Template (TemplateParts beforeContent afterContent), Text t)) -> Text $ T.concat [beforeContent, t, afterContent] - (ToText, String s) -> + (ToText, String (StringWrapper s)) -> Text $ T.pack s _ -> diff --git a/byg/src/Evaluation/FunctionIO.hs b/byg/src/Evaluation/FunctionIO.hs index a6e7d06..c478c96 100644 --- a/byg/src/Evaluation/FunctionIO.hs +++ b/byg/src/Evaluation/FunctionIO.hs @@ -2,6 +2,8 @@ module Evaluation.FunctionIO ( evalFunctionIO ) where +import Prelude hiding (String, FilePath) + import Types.Values import Types (FunctionIO(..), Value(..), toValue) @@ -16,20 +18,20 @@ import System.Directory (listDirectory, doesDirectoryExist, createDirectory, cop evalFunctionIO :: FunctionIO -> Value -> IO Value evalFunctionIO f x = case (f, x) of - (ListDirectory, String s) -> - (List . map toValue) <$> listDirectory s + (ListDirectory, String (StringWrapper s)) -> + (List . map (toValue . StringWrapper)) <$> listDirectory s - (IsDirectory, String s) -> + (IsDirectory, String (StringWrapper s)) -> Bool <$> doesDirectoryExist s - (ReadTemplate, String s) -> do + (ReadTemplate, String (StringWrapper s)) -> do t <- T.readFile s let c = "CONTENT" (beforeContent, after) = T.breakOn c t afterContent = T.drop (T.length c) after pure $ Template $ TemplateParts beforeContent afterContent - (ConvertImage, Tuple (Tuple (String source, String target), + (ConvertImage, Tuple (Tuple (String (StringWrapper source), String (StringWrapper target)), ImageConversionSettings (ResizeToWidth widthResized))) -> do imageOrig <- CP.readImage source let imageOrig' = case imageOrig of @@ -42,19 +44,19 @@ evalFunctionIO f x = case (f, x) of CP.saveJpgImage 90 target $ CP.ImageRGB8 imageResized pure Empty - (SaveFile, Tuple (Text t, String s)) -> do + (SaveFile, Tuple (Text t, String (StringWrapper s))) -> do T.writeFile s t pure Empty - (CopyFile, Tuple (String source, String target)) -> do + (CopyFile, Tuple (String (StringWrapper source), String (StringWrapper target))) -> do copyFile source target pure Empty - (MakeDir, String s) -> do + (MakeDir, String (StringWrapper s)) -> do createDirectory s pure Empty - (RunPandoc, String s) -> do + (RunPandoc, String (StringWrapper s)) -> do contents <- T.readFile s html <- P.runIOorExplode (P.writeHtml5 P.def =<< P.readMarkdown (P.def { P.readerExtensions = P.extensionsFromList [ P.Ext_raw_html ] }) contents) pure $ Text $ TL.toStrict $ B.renderHtml html diff --git a/byg/src/SiteGenerator.hs b/byg/src/SiteGenerator.hs index 21953b4..6edd2bd 100644 --- a/byg/src/SiteGenerator.hs +++ b/byg/src/SiteGenerator.hs @@ -1,5 +1,7 @@ module SiteGenerator (generateSite) where +import Prelude hiding (String, FilePath) + import Types import DependencyGenerator @@ -25,13 +27,18 @@ makeImageHTML t = do (toText thumbnail) (inject "\">

")))) +hasExtension :: (TokenableTo [String] a, TokenableTo FilePath b) => a -> b -> DepGenM' Bool +hasExtension exts filename = do + ext <- lowerString $ untupleSndDepGenM $ fileComponents filename + ext `elemOf` exts + handleRecipeDir :: Token FilePath -> Token FilePath -> Token Template -> Token FilePath -> Token FilePath -> DepGenM () handleRecipeDir inputDir outputDir template indexName name = do dir <- joinPaths inputDir name recipeDirOut <- joinPaths outputDir name makeDir recipeDirOut dirContents <- listDirectory dir - areImageFilenames <- mapDepGenM hasImageExtension dirContents + areImageFilenames <- mapDepGenM (hasExtension $ inject ["jpg"]) dirContents imageFilenames <- filterDepGenM areImageFilenames dirContents imagePaths <- mapDepGenM (joinPaths dir) imageFilenames imagePathsOut <- mapDepGenM (joinPaths recipeDirOut) imageFilenames @@ -74,3 +81,19 @@ generateSite = do forM_ ["mad-icon.png", "mad-logo.png"] $ \name -> do val <- inject name copyFile (joinPaths imgName val) (joinPaths imgPathOut val) + fontsDir <- inject "fonts" + fontsNames <- listDirectory fontsDir + fontsPaths <- mapDepGenM (joinPaths fontsDir) fontsNames + fontsPathsAreSubdirs <- mapDepGenM isDirectory fontsPaths + fontsPaths' <- filterDepGenM fontsPathsAreSubdirs fontsPaths + makeDir (joinPaths outputDir fontsDir) + mapDepGenM_ (handleFontDir outputDir) fontsPaths' + +handleFontDir :: Token FilePath -> Token FilePath -> DepGenM () +handleFontDir outputDir fontPath = do + makeDir (joinPaths outputDir fontPath) + files <- listDirectory fontPath + paths <- mapDepGenM (joinPaths fontPath) files + mask <- mapDepGenM (hasExtension $ inject ["woff2", "css"]) paths + paths' <- filterDepGenM mask paths + mapDepGenM_ (\p -> copyFile p (joinPaths outputDir p)) paths' diff --git a/byg/src/Types/Function.hs b/byg/src/Types/Function.hs index 984f052..f9ff42c 100644 --- a/byg/src/Types/Function.hs +++ b/byg/src/Types/Function.hs @@ -10,7 +10,8 @@ data Function = AppendStrings | ConcatTexts | JoinPaths | FileComponents - | HasImageExtension + | LowerString + | ElemOf | ApplyTemplate | ToText deriving (Show, Lift) diff --git a/byg/src/Types/Value.hs b/byg/src/Types/Value.hs index 40efe7a..383ab70 100644 --- a/byg/src/Types/Value.hs +++ b/byg/src/Types/Value.hs @@ -3,11 +3,17 @@ module Types.Value , Valuable(..) ) where +import Prelude hiding (String) + import Types.Values import Data.Text (Text) import Language.Haskell.TH.Syntax (Lift) +-- Note: We use a wrapper for the String type in order to be able to define the +-- general Valuable [a] instance further down. Otherwise it would conflict with +-- our Valuable String instance, since the non-wrapped String type is just an +-- alias for [Char]. data Value = String String | Text Text | Bool Bool @@ -16,7 +22,7 @@ data Value = String String | Empty | Tuple (Value, Value) | List [Value] - deriving (Show, Lift) + deriving (Eq, Show, Lift) class Valuable a where toValue :: a -> Value @@ -45,3 +51,9 @@ instance Valuable ImageConversionSettings where fromValue = \case ImageConversionSettings a -> a _ -> error "unexpected" + +instance Valuable a => Valuable [a] where + toValue = List . map toValue + fromValue = \case + List a -> map fromValue a + _ -> error "unexpected" diff --git a/byg/src/Types/Values.hs b/byg/src/Types/Values.hs index 6504794..c3d72b6 100644 --- a/byg/src/Types/Values.hs +++ b/byg/src/Types/Values.hs @@ -1,13 +1,27 @@ module Types.Values - ( ImageConversionSettings(..) + ( String(..) + , FilePath + , ImageConversionSettings(..) , Template(..) ) where +import Prelude hiding (String, FilePath) +import qualified Prelude + +import Data.String (IsString(..)) import Data.Text (Text) import Language.Haskell.TH.Syntax (Lift) +newtype String = StringWrapper Prelude.String + deriving (Eq, Show, Lift) + +type FilePath = String + +instance IsString String where + fromString = StringWrapper + data ImageConversionSettings = ResizeToWidth Int - deriving (Show, Lift) + deriving (Eq, Show, Lift) data Template = TemplateParts Text Text - deriving (Show, Lift) + deriving (Eq, Show, Lift)