Compare commits
5 commits
main
...
addParsers
Author | SHA1 | Date | |
---|---|---|---|
7107b0e99f | |||
a9c51756fc | |||
a051dba102 | |||
f5052e12bf | |||
a384414d4c |
12 changed files with 131 additions and 52 deletions
45
app/Main.hs
45
app/Main.hs
|
@ -9,6 +9,7 @@ import Hakyll
|
|||
|
||||
import Components
|
||||
import Core.Compilers
|
||||
import Core.Parsers
|
||||
import Core.Render ( )
|
||||
import Routes
|
||||
import Utils.FileTree
|
||||
|
@ -16,37 +17,37 @@ import Utils.Routes
|
|||
|
||||
import Kit.Templates.Archive
|
||||
import Kit.Templates.Index
|
||||
import Kit.Templates.Post ( postTemplate )
|
||||
import Kit.Templates.Post
|
||||
import Kit.Templates.Sitemap
|
||||
|
||||
resources :: Component ()
|
||||
resources = do
|
||||
mconcat [postTemplate, indexTemplate, archiveTemplate]
|
||||
return ()
|
||||
|
||||
assets :: [FilePath]
|
||||
assets = map tail . getPaths . getAssets $ resources
|
||||
|
||||
allCss :: String
|
||||
allCss = getCss resources
|
||||
|
||||
css :: Compiler (Item String)
|
||||
css = makeItem allCss
|
||||
|
||||
cssHash :: Identifier
|
||||
cssHash = fromString . show . hash $ allCss
|
||||
|
||||
main :: IO ()
|
||||
main = hakyll $ do
|
||||
main = do
|
||||
parseResult <- mkParse parseFile (local $ Post "test.md")
|
||||
let resources =
|
||||
parseResult
|
||||
>> mconcat [postTemplate, indexTemplate, archiveTemplate]
|
||||
>> return ()
|
||||
runHakyll resources
|
||||
|
||||
|
||||
runHakyll :: Component () -> IO ()
|
||||
runHakyll res = hakyll $ do
|
||||
|
||||
let assets = map (drop 1) . getPaths . getAssets $ res
|
||||
allCss = getCss res
|
||||
css = makeItem allCss
|
||||
cssHash = fromString . show . hash $ allCss
|
||||
|
||||
tags <- buildTags (patrn $ Post "*.md") (fromCapture . patrn $ Tag "*")
|
||||
|
||||
match (patrn $ Post "*.md") $ do
|
||||
route $ setExtension "html"
|
||||
compile $ do
|
||||
pandocCompiler
|
||||
getResourceBody
|
||||
>>= applyAsTemplate postCtx
|
||||
>>= renderPandoc
|
||||
>>= saveSnapshot "content"
|
||||
>>= componentTemplate postTemplate defaultContext
|
||||
>>= componentTemplate postTemplate postCtx
|
||||
. fmap demoteHeaders
|
||||
|
||||
create ["index.html"] $ do
|
||||
|
@ -61,7 +62,7 @@ main = hakyll $ do
|
|||
(archiveCtx tags)
|
||||
|
||||
create [cssHash] $ do
|
||||
route $ constRoute . tail . path $ DefaultStylesheet
|
||||
route $ constRoute . local $ DefaultStylesheet
|
||||
compile css
|
||||
|
||||
match (fromList . map fromFilePath $ assets) $ do
|
||||
|
|
BIN
assets/img/test/fluidGradientBG.png
Normal file
BIN
assets/img/test/fluidGradientBG.png
Normal file
Binary file not shown.
After Width: | Height: | Size: 1.2 MiB |
|
@ -20,6 +20,7 @@ library
|
|||
Components
|
||||
Core.Colors
|
||||
Core.Compilers
|
||||
Core.Parsers
|
||||
Core.Render
|
||||
Core.Routers
|
||||
Core.Rules
|
||||
|
@ -91,6 +92,7 @@ library
|
|||
, hashable
|
||||
, megaparsec
|
||||
, mtl
|
||||
, pandoc
|
||||
, split
|
||||
, text
|
||||
default-language: Haskell2010
|
||||
|
@ -118,6 +120,7 @@ executable etienne-moqueur-exe
|
|||
, hashable
|
||||
, megaparsec
|
||||
, mtl
|
||||
, pandoc
|
||||
, split
|
||||
, text
|
||||
default-language: Haskell2010
|
||||
|
@ -146,6 +149,7 @@ test-suite etienne-moqueur-test
|
|||
, hashable
|
||||
, megaparsec
|
||||
, mtl
|
||||
, pandoc
|
||||
, split
|
||||
, text
|
||||
default-language: Haskell2010
|
||||
|
|
|
@ -33,6 +33,7 @@ dependencies:
|
|||
- hashable
|
||||
- split
|
||||
- megaparsec
|
||||
- pandoc
|
||||
|
||||
ghc-options:
|
||||
- -Wall
|
||||
|
|
|
@ -46,8 +46,8 @@ import Text.Blaze.Html5.Attributes as A
|
|||
import Text.Blaze.Html.Renderer.Pretty
|
||||
|
||||
main :: IO ()
|
||||
main = putStr . renderHtml $ do
|
||||
ul ! class_ "foo" $ do
|
||||
main = putStr . renderHtml $$ do
|
||||
ul ! class_ "foo" $$ do
|
||||
li "bar"
|
||||
li "baz"
|
||||
```
|
||||
|
@ -72,7 +72,7 @@ import Clay
|
|||
import Data.Text.Lazy.IO as T
|
||||
|
||||
main :: IO ()
|
||||
main = T.putStr . render $ ul # byClass "foo" ? do
|
||||
main = T.putStr . render $$ ul # byClass "foo" ? do
|
||||
listStyle none outside none
|
||||
paddingLeft nil
|
||||
li ? do
|
||||
|
@ -110,14 +110,14 @@ compileHs = getResourceString
|
|||
>>= withItemBody (unixFilter "stack" ["runghc", "--", "-XOverloadedStrings"]
|
||||
|
||||
main :: IO ()
|
||||
main = hakyll $ do
|
||||
match "html.hs" $ do
|
||||
route $ constRoute "myUl.html"
|
||||
compile $ compileHs
|
||||
main = hakyll $$ do
|
||||
match "html.hs" $$ do
|
||||
route $$ constRoute "myUl.html"
|
||||
compile $$ compileHs
|
||||
|
||||
match "css.hs" $ do
|
||||
route $ constRoute "css/default.css"
|
||||
compile $ compileHs
|
||||
match "css.hs" $$ do
|
||||
route $$ constRoute "css/default.css"
|
||||
compile $$ compileHs
|
||||
```
|
||||
|
||||
**EDIT**: (2023-06-21) Actually, no need to make those main functions. Something like
|
||||
|
@ -127,10 +127,10 @@ import Text.Blaze.Html.Renderer.Pretty
|
|||
import Hakyll
|
||||
|
||||
main :: IO ()
|
||||
main = hakyll $ do
|
||||
create ["myUl.html"] $ do
|
||||
main = hakyll $$ do
|
||||
create ["myUl.html"] $$ do
|
||||
route idRoute
|
||||
compile $ makeItem (renderHtml someHtml) -- someHtml :: Html
|
||||
compile $$ makeItem (renderHtml someHtml) -- someHtml :: Html
|
||||
```
|
||||
will work just fine.
|
||||
|
||||
|
@ -185,14 +185,14 @@ import Data.Map (singleton, empty)
|
|||
|
||||
addCss :: String -> Css -> Component ()
|
||||
addCss name css = tell
|
||||
$ Prop
|
||||
$$ Prop
|
||||
{ cssMap = singleton name css
|
||||
, assetsTree = mempty
|
||||
}
|
||||
|
||||
addAsset :: FilePath -> Component ()
|
||||
addAsset fp = tell
|
||||
$ Prop
|
||||
$$ Prop
|
||||
{ cssMap = empty
|
||||
, assetsTree = build fp -- build :: FilePath -> FileTree
|
||||
}
|
||||
|
@ -212,12 +212,12 @@ comp :: Component (Html -> Html)
|
|||
comp = do
|
||||
addCss "comp" css
|
||||
addAsset asset
|
||||
return $ ... -- some Html -> Html function
|
||||
return $$ ... -- some Html -> Html function
|
||||
|
||||
comp' :: Component Html
|
||||
comp' = do
|
||||
addCss css'
|
||||
return $ ... -- some Html
|
||||
return $$ ... -- some Html
|
||||
|
||||
comp'' :: Html
|
||||
comp'' = comp <*> (comp' <> comp')
|
||||
|
|
11
posts/test.md
Normal file
11
posts/test.md
Normal file
|
@ -0,0 +1,11 @@
|
|||
---
|
||||
title: test post with image
|
||||
date: 2023-06-27
|
||||
tags: test
|
||||
---
|
||||
|
||||
This is just a test post with a very basic image integration to add the support for pictures.
|
||||
|
||||
<!--more-->
|
||||
|
||||
In the *idea*, a picture would just be included with a call like $img("test/fluidGradientBG.png")$. Maybe I'll add a couple arguments for img size and shape, but for the moment this is about it.
|
|
@ -1,20 +1,17 @@
|
|||
module Core.Compilers
|
||||
( runGHC
|
||||
, componentTemplate
|
||||
( componentTemplate
|
||||
, myPandocReaderOptions
|
||||
) where
|
||||
|
||||
import Components
|
||||
import Core.Render ( )
|
||||
import Hakyll
|
||||
import Text.Pandoc.Options
|
||||
|
||||
-- Redundant... Those default extensions should be kept in sync with package.yaml, but `stack runghc` won't take those in account.
|
||||
defaultExtensions :: [String]
|
||||
defaultExtensions =
|
||||
["--", "-XQuasiQuotes", "-XOverloadedStrings", "-XFlexibleInstances"]
|
||||
|
||||
runGHC :: Compiler (Item String)
|
||||
runGHC = getResourceString
|
||||
>>= withItemBody (unixFilter "stack" $ "runghc" : defaultExtensions)
|
||||
myPandocReaderOptions :: ReaderOptions
|
||||
myPandocReaderOptions = def
|
||||
{ readerExtensions = disableExtension Ext_tex_math_dollars pandocExtensions
|
||||
}
|
||||
|
||||
componentTemplate
|
||||
:: Show s => Component s -> Context a -> Item a -> Compiler (Item String)
|
||||
|
|
45
src/Core/Parsers.hs
Normal file
45
src/Core/Parsers.hs
Normal file
|
@ -0,0 +1,45 @@
|
|||
module Core.Parsers where
|
||||
|
||||
import Components
|
||||
import Control.Monad ( join )
|
||||
import Data.Functor
|
||||
import Data.Void
|
||||
import Routes
|
||||
import Text.Megaparsec
|
||||
import Text.Megaparsec.Char
|
||||
import Utils.FileTree
|
||||
|
||||
type Parser = Parsec Void String
|
||||
|
||||
parseFilePath :: Parser FilePath
|
||||
parseFilePath = some $ alphaNumChar <|> oneOf ("/-_., " :: String)
|
||||
|
||||
parseWord :: Parser (Component ())
|
||||
parseWord = fmap return $ some (alphaNumChar <|> punctuationChar) *> space
|
||||
|
||||
parseComment :: Parser (Component ())
|
||||
parseComment =
|
||||
mconcat <$> between (string "<!--") (string ">") (many parseWord) <* space
|
||||
|
||||
parseImgField :: Parser (Component ())
|
||||
parseImgField =
|
||||
addAsset
|
||||
. path
|
||||
. Img
|
||||
<$> between
|
||||
(char '$')
|
||||
(char '$')
|
||||
(string "img" *> between (string "(\"") (string "\")") parseFilePath)
|
||||
<* space
|
||||
|
||||
parseFile :: Parser (Component ())
|
||||
parseFile =
|
||||
mconcat <$> manyTill (choice [parseImgField, parseWord, parseComment]) eof
|
||||
|
||||
---------
|
||||
|
||||
mkParse :: Parser a -> FilePath -> IO a
|
||||
mkParse p f = do
|
||||
str <- readFile f
|
||||
let treat = either (const $ fail "parse failed") return
|
||||
treat $ runParser p f str
|
|
@ -2,10 +2,12 @@ module Kit.Atoms.Image
|
|||
( Shape(..)
|
||||
, img'
|
||||
, imgWithShape
|
||||
, imgCtx
|
||||
) where
|
||||
|
||||
import Clay as C
|
||||
import Components
|
||||
import Hakyll.Web.Template.Context
|
||||
import Routes
|
||||
import Text.Blaze.Html5 as H
|
||||
import Text.Blaze.Html5.Attributes as A
|
||||
|
@ -13,7 +15,6 @@ import Utils.Clay
|
|||
|
||||
data Shape = Square | Circle | Rounded | Drop
|
||||
|
||||
|
||||
baseCss :: Css
|
||||
baseCss = C.img ? do
|
||||
maxWidth (pct 100)
|
||||
|
@ -45,3 +46,12 @@ imgWithShape Drop file description =
|
|||
)
|
||||
return (H.! class_ "drop")
|
||||
<*> img' file description
|
||||
|
||||
imgCtx :: Context a
|
||||
imgCtx = functionField
|
||||
"img"
|
||||
(\args _ -> case args of
|
||||
[p] -> return $ show . getBody . img' p $ ""
|
||||
[p, a] -> return $ show . getBody . img' p $ a
|
||||
_ -> fail "img takes 1 or 2 arguments"
|
||||
)
|
||||
|
|
|
@ -1,9 +1,12 @@
|
|||
module Kit.Templates.Post
|
||||
( postTemplate
|
||||
, postCtx
|
||||
) where
|
||||
|
||||
import Components
|
||||
import Core.Render
|
||||
import Hakyll.Web.Template.Context
|
||||
import Kit.Atoms.Image ( imgCtx )
|
||||
import Kit.Atoms.Section
|
||||
import Kit.Organisms.Head
|
||||
import Kit.Organisms.TopMenu
|
||||
|
@ -17,3 +20,6 @@ postTemplate = docTypeHtml
|
|||
postBody = body $ do
|
||||
h1 "$title$"
|
||||
"$body$"
|
||||
|
||||
postCtx :: Context String
|
||||
postCtx = imgCtx <> defaultContext
|
||||
|
|
|
@ -13,4 +13,4 @@ uniform = join . join . join
|
|||
|
||||
-- |Get a selector from byClass.
|
||||
byClass' :: Text -> Selector
|
||||
byClass' c = selectorFromText "" # byClass c
|
||||
byClass' c = star # byClass c
|
||||
|
|
|
@ -1,9 +1,13 @@
|
|||
module Utils.Routes
|
||||
( patrn
|
||||
, local
|
||||
) where
|
||||
|
||||
import Hakyll
|
||||
import Routes
|
||||
|
||||
patrn :: Route -> Pattern
|
||||
patrn = fromGlob . tail . path
|
||||
patrn = fromGlob . local
|
||||
|
||||
local :: Route -> FilePath
|
||||
local = drop 1 . path
|
||||
|
|
Loading…
Reference in a new issue