heckle 2.0.0.4 → 2.0.1.0
raw patch · 6 files changed
+282/−274 lines, 6 filesdep +filepathdep +heckledep +optparse-applicativedep ~base
Dependencies added: filepath, heckle, optparse-applicative, optparse-generic
Dependency ranges changed: base
Files
- Files.hs +0/−52
- Heckle.hs +0/−136
- Main.hs +0/−61
- heckle.cabal +31/−25
- heckle/Main.hs +95/−0
- src/Heckle.hs +156/−0
− Files.hs
@@ -1,52 +0,0 @@-module Files where---exampleTeXPost :: String-exampleTeXPost = unlines- [ "\\documentclass{article}"- , "\\author{Rushi Shah}"- , "\\date{1 January 2015}"- , "\\title{Example LaTeX Post}"- , "\\begin{document}"- , "\\maketitle"- , "This is an example LaTeX/PDF post."- , "\\end{document}"- ]--exampleMDPost :: String-exampleMDPost = unlines - [ "% Example MD Post"- , "% Rushi Shah"- , "% 1 January 2016"- , ""- , "This is an example MD/HTML post"- ]- -exampleIndexFile :: String-exampleIndexFile = unlines- [ "<ul id='blog-posts'></ul>"]--exampleResFile :: String-exampleResFile = unlines- ["<ul id=\"blog-posts\">"- ," <li class=\"blog-post\">"- ," <a class=\"post-link\" href=\"posts/example-markdown.html\">"- ," Example MD Post"- ," </a>"- ," <div class=\"post-date\">"- ," 1 January 2016"- ," </div>"- ," </li>"- ," <li class=\"blog-post\">"- ," <a class=\"post-link\" href=\"posts/example-latex.pdf\">"- ," Example Post"- ," </a>"- ," <div class=\"post-date\">"- ," 1 January 2015"- ," </div>"- ," </li>"- ,"</ul>"]--exampleTemplateFile :: String-exampleTemplateFile = unlines- [ "<div id='blog-post'></div>"]
− Heckle.hs
@@ -1,136 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeSynonymInstances #-}-{-# LANGUAGE FlexibleInstances #-}--module Heckle where----Stuff for BlazeHTML-import Text.Blaze.Html5 as H hiding (main, map)-import Text.Blaze.Html5.Attributes as A-import Text.Blaze.Html.Renderer.Pretty----Stuff for TagSoup-import Text.HTML.TagSoup----Stuff for Dates-import Data.Dates----Pandoc-import Text.Pandoc.Options (def)-import Text.Pandoc.Readers.Markdown (readMarkdown)-import Text.Pandoc.Readers.LaTeX (readLaTeX)-import Text.Pandoc.Definition-import Text.Pandoc.Writers.HTML (writeHtmlString)-import Text.Pandoc.Shared (stringify)----Other stuff I'm using-import Data.List.Split (splitOn)-import Data.Either-import Control.Applicative-import Control.Monad-import Data.Monoid--instance Show Html where- show = renderHtml--showMonth :: Int -> String-showMonth i = months !! (i-1)- where months = ["January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December"]--displayDate :: DateTime -> String-displayDate (DateTime y m d h mins s) = show d ++ " " ++ showMonth m ++ " " ++ show y--postsToHtml :: [Post] -> Html-postsToHtml xs = do- ul ! A.id "blog-posts" $- forM_ xs postToHtml--postToHtml :: Post -> Html-postToHtml p = li ! class_ "blog-post" $ do- a ! class_ "post-link" ! href (stringValue ("posts/"++fileName p++ext)) $ toHtml (postTitle p)- H.div ! class_ "post-date" $ toHtml ((displayDate . postDate) p)- where- ext = case p of- (MD _ _ _ _) -> ".html"- (LaTeX _ _ _ _) -> ".pdf"- -data Post - = LaTeX {- fileName :: String- , postTitle :: String- , postDate :: DateTime- , pd :: Pandoc- }- | MD {- fileName :: String- , postTitle :: String- , postDate :: DateTime- , pd :: Pandoc- }- deriving (Eq, Show)--instance Ord Post where- compare p1 p2 = compare (postDate p1) (postDate p2)--{--Relative dates aren't supported by BlaTeX-(it makes no sense for a post to always be written "yesterday", a specific date should be given)-However parsing the date requires the current datetime to be given to parse relative dates-Originally I went through the IO hurdles of getting current datetime-But that introduced unnecessary sideeffects-So this is just a cleaner function to parse absolute dates-(It will give nonsensical results for relative dates: use carefully!)-I also wanted to stick with strings for error messages, so this just shows the ParseErrors from parseDate--}-parseAbsoluteDate :: String -> Either String DateTime-parseAbsoluteDate s = case parseDate mempty s of- (Left e) -> Left (show e)- (Right res) -> (Right res)--getMeta :: (Meta -> [Inline]) -> Pandoc -> Either String String-getMeta f (Pandoc m _) = case f m of- [] -> Left "Couldn't find it"- (xs) -> Right (stringify xs)----Creates a post given a constructor for a post---The long function in the type signature is just---A constructor for a post (either `LaTeX` or `MD`)-createPost :: Show a =>- (String -> String -> DateTime -> Pandoc -> Post)- -> String -> Either a Pandoc -> Either String Post-createPost _ _ (Left e) = Left (show e)-createPost t fn (Right pd) = - t <$> pure fn <*> title <*> date <*> pure pd- where- date = (getMeta docDate pd) >>= parseAbsoluteDate- title = getMeta docTitle pd--fileToPost :: String -> IO (Either String Post)-fileToPost fn = - case splitOn "." fn of- [fn, "pdf"] -> - return . createPost LaTeX fn . readLaTeX def =<< readFile ("posts/" ++ fn ++ ".tex")- [fn, "md"] -> - return . createPost MD fn . readMarkdown def =<< readFile ("posts/" ++ fn ++ ".md")- _ -> return (Left "Not a LaTeX or MD file")--injectIndex :: String -> Html -> Either String String -injectIndex layout ul = injectAt [(TagOpen "ul" [("id","blog-posts")]), (TagClose "ul")] layout (show ul)--injectTemplate :: String -> Post -> Either String String -injectTemplate layout (MD fn _ _ t) = injectAt tags layout inp - where - tags = [(TagOpen "div" [("id","blog-post")]), (TagClose "div")]- inp = "<div id='blog-post'>" ++ (writeHtmlString def t) ++ "</div>"--injectAt :: [Text.HTML.TagSoup.Tag String] -> String -> String -> Either String String-injectAt p layout insert = case splitOn p (parseTags layout) of - [beg, end] -> Right (renderTags (beg ++ parseTags insert ++ end))- _ -> Left "Broken layout file"--writeHTML :: String -> Post -> IO ()-writeHTML template p@(MD fn _ _ t) = do- case injectTemplate template p of- Right html -> writeFile ("posts/" ++ fn ++ ".html") html - _ -> return ()-writeHTML _ (LaTeX _ _ _ _) = return ()
− Main.hs
@@ -1,61 +0,0 @@-import System.Directory -import Data.Either-import Data.List-import System.Environment (getArgs)-import System.Process (readProcess)-import Control.Exception-import Files-import Heckle--main = do- args <- getArgs- case args of- ["build"] -> do- - putStrLn "Reading directory and turning into native posts"- postsToBeCreated <- mapM fileToPost =<< (getDirectoryContents "posts")- let posts = (reverse . sort . rights) (postsToBeCreated)- putStrLn ("Number of posts found: " ++ (show (length posts)))-- putStrLn "Writing markdown files into template HTML"- template <- readFile "template.html.hkl"- mapM_ (writeHTML template) posts-- putStrLn "Creating HTML <ul> element for index file"- let generatedHtml = postsToHtml posts-- putStrLn "Inserting HTML <ul> element into layout file"- layoutFile <- readFile "index.html.hkl"- let injectedOutput = layoutFile `injectIndex` generatedHtml- case injectedOutput of- (Left e) -> putStrLn e- (Right s) -> do- writeFile "index.html" s- putStrLn "Success building!"--- ["init"] -> do- --Create the basic layout file- writeFile "index.html.hkl" exampleIndexFile --Change to layout when testing, index when deploying"- writeFile "template.html.hkl" exampleTemplateFile- writeFile "index.html" exampleResFile- --Create directory for posts and basic post- createDirectoryIfMissing True "posts"- setCurrentDirectory "posts"- writeFile "example-markdown.md" exampleMDPost- - --Compile the LaTeX file into a PDF- --Could do this for every .tex file if wanted to- writeFile "example-latex.tex" exampleTeXPost- x <- try (readProcess "pdflatex" ["example-latex.tex"] "")- case x of- Left e -> do- let err = show (e :: IOException)- putStrLn "Warning: LaTeX installation not found, removing LaTeX post"- removeFile "example-latex.tex"- return "LaTeX not found"- Right r -> return "Success"-- putStrLn "Success initializing!"- - _ -> putStrLn "That's not a valid command"
heckle.cabal view
@@ -1,38 +1,44 @@--- Initial heckle.cabal generated by cabal init. For further --- documentation, see http://haskell.org/cabal/users-guide/- name: heckle-version: 2.0.0.4+version: 2.0.1.0 synopsis: Jekyll in Haskell (feat. LaTeX)-description: A static site generator that supports LaTeX/PDF and Markdown/HTML posts. Care has been taken to make it configurable, easy to use, and unopinionated. +description: A static site generator that supports LaTeX/PDF and Markdown/HTML posts. Care has been taken to make it configurable, easy to use, and unopinionated. homepage: https://github.com/2016rshah/heckle license: MIT author: Rushi Shah maintainer: 2016rshah@gmail.com--- copyright: category: Web build-type: Simple cabal-version: >=1.10 -executable heckle- main-is: Main.hs- -- other-modules: - other-extensions: OverloadedStrings- build-depends: base >=4.7 && <4.8- , blaze-html >= 0.8.1.1- , directory >=1.2 && <1.3- , process >= 1.2.0.0- , split >=0.2 && <0.3- , tagsoup >= 0.13.3- , dates >= 0.2.2.1- , pandoc >= 1.17.0.3- , pandoc-types >= 1.16.1- - -- hs-source-dirs: - default-language: Haskell2010- other-modules: Files- , Heckle- source-repository head type: git location: https://github.com/2016rshah/heckle.git++library+ hs-source-dirs: src+ exposed-modules: Heckle+ build-depends: base >= 4.7 && <5+ , filepath >= 1.4.0.0+ , blaze-html >= 0.8.1.1+ , directory >=1.2 && <1.3+ , process >= 1.2.0.0+ , split >=0.2 && <0.3+ , tagsoup >= 0.13.3+ , dates >= 0.2.2.1+ , pandoc >= 1.17.0.3+ , pandoc-types >= 1.16.1+ default-language: Haskell2010++executable heckle+ hs-source-dirs: heckle+ main-is: Main.hs+ build-depends: base >=4.7 && <5+ , heckle+ , directory >=1.2 && <1.3+ , filepath >= 1.4.0.0+ , process >= 1.2.0.0+ , split >=0.2 && <0.3+ , optparse-applicative >= 0.12.0.0 && <0.13.0.0+ , optparse-generic ==1.1.*+ other-extensions: OverloadedStrings+ default-language: Haskell2010
+ heckle/Main.hs view
@@ -0,0 +1,95 @@+module Main where++import Control.Exception+import Data.Either+import Data.List+import Data.Maybe+import Options.Applicative+import System.Directory+import System.FilePath+import System.Environment (getArgs)+import System.Process (readProcess)++import Heckle+import Files++data Command+ = Build+ | Init++withInfo :: InfoMod a -> Parser a -> ParserInfo a+withInfo im p = info (helper <*> p) im++infixr 1 ==>+(==>) = withInfo . progDesc++mainFlags :: ParserInfo Command+mainFlags = withInfo (fullDesc <> progDesc "heckle: a simple, configurable static site generator") parser+ where+ parser :: Parser Command+ parser = subparser $ mconcat+ [ command "build" $ "Generate site"+ ==> pure Build+ , command "init" $ "Make new site template"+ ==> pure Init+ ]++buildSite :: IO ()+buildSite = do+ putStrLn "Reading directory and turning into native posts"+ postsToBeCreated <- mapM fileToPost =<< getDirectoryContents "posts"+ let posts = reverse . sort . rights $ postsToBeCreated+ putStrLn $ "Number of posts found: " ++ show (length posts)++ putStrLn "Writing markdown files into template HTML"+ template <- readFile "template.html.hkl"+ sequence $ mapMaybe (writeHTML template) posts++ putStrLn "Creating HTML <ul> element for index file"+ let generatedHtml = postsToHtml posts++ putStrLn "Inserting HTML <ul> element into layout file"+ layoutFile <- readFile "index.html.hkl"+ let injectedOutput = layoutFile `injectIndex` generatedHtml+ case injectedOutput of+ Nothing -> putStrLn "Error with templating"+ Just s -> do+ writeFile "index.html" s+ putStrLn "Success building!"++initSite :: IO ()+initSite = do+ --curDir <- getCurrentDirectory+ let example = "example"+ createDirectoryIfMissing True example+ setCurrentDirectory example++ -- Create the basic layout file+ writeFile "index.html.hkl" exampleIndexFile -- Change to layout when testing, index when deploying"+ writeFile "template.html.hkl" exampleTemplateFile+ writeFile "index.html" exampleResFile++ -- Create directory for posts and basic post+ createDirectoryIfMissing True "posts"+ setCurrentDirectory "posts"+ writeFile "example-markdown.md" exampleMDPost++ -- Compile the LaTeX file into a PDF+ -- Could do this for every .tex file if wanted to+ writeFile "example-latex.tex" exampleTeXPost+ x <- try (readProcess "pdflatex" ["example-latex.tex"] "")+ case x of+ Left e -> do+ let err = show (e :: IOException)+ putStrLn "Warning: LaTeX installation not found, removing LaTeX post"+ removeFile "example-latex.tex"+ return "LaTeX not found"+ Right r -> return "Success"++ putStrLn "Success initializing!"++main = do+ command <- execParser mainFlags+ case command of+ Build -> buildSite+ Init -> initSite
+ src/Heckle.hs view
@@ -0,0 +1,156 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeSynonymInstances #-}++module Heckle where++import Control.Applicative+import Control.Monad+import Data.Bifunctor+import Data.Either+import Data.Function (on)+import Data.List+import Data.List.Split (splitOn)+import Data.String (IsString)+import Data.Monoid+import System.FilePath++import Text.Blaze.Html5 as H hiding (main, map)+import Text.Blaze.Html5.Attributes as A+import Text.Blaze.Html.Renderer.Pretty++import qualified Text.HTML.TagSoup as TagSoup++import Data.Dates hiding (month)++import Text.Pandoc.Definition hiding (Format)+import Text.Pandoc.Options (def)+import Text.Pandoc.Readers.LaTeX (readLaTeX)+import Text.Pandoc.Readers.Markdown (readMarkdown)+import Text.Pandoc.Shared (stringify)+import Text.Pandoc.Writers.HTML (writeHtmlString)++instance Show Html where+ show = renderHtml++data Month+ = January+ | February+ | March+ | April+ | May+ | June+ | July+ | August+ | September+ | October+ | November+ | December+ deriving (Show, Eq, Bounded, Enum)++month :: Int -> Month+month n = toEnum (n-1)++displayDate :: DateTime -> String+displayDate (DateTime y m d h mins s) =+ intercalate " " [ show d, show (month m), show y ]++postsToHtml :: [Post] -> Html+postsToHtml xs = do+ ul ! A.id "blog-posts" $+ forM_ xs postToHtml++postToHtml :: Post -> Html+postToHtml Post{..} = li ! class_ "blog-post" $ do+ a ! class_ "post-link" ! href (stringValue ("posts/" ++ fileName ++ ext)) $ toHtml postTitle+ H.div ! class_ "post-date" $ toHtml (displayDate postDate)+ where+ ext = getOutputExtension format++--data InputFormat =+data Format = LaTeX | Markdown+ deriving (Show, Eq)++getOutputExtension :: Format -> String+getOutputExtension LaTeX = ".pdf"+getOutputExtension Markdown = ".html"++-- data FileName = FileName { getFileName :: String, getExtension :: }+newtype Title = Title { getTitle :: String } deriving (Show, Eq, IsString, ToMarkup)++data Post = Post+ { fileName :: String -- TODO make this more typed+ , postTitle :: Title+ , postDate :: DateTime+ , format :: Format+ , pd :: Pandoc+ } deriving (Show, Eq)++instance Ord Post where+ compare = compare `on` postDate++-- | Relative dates aren't supported by BlaTeX (it makes no sense for a post to+-- always be written "yesterday", a specific date should be given) However+-- parsing the date requires the current datetime to be given to parse relative+-- dates.+--+-- Originally I went through the IO hurdles of getting current datetime, but+-- that introduced unnecessary side-effects so this is just a cleaner function+-- to parse absolute dates. (It will give nonsensical results for relative+-- dates: use carefully!)+--+-- I also wanted to stick with strings for error messages, so this just shows+-- the ParseErrors from parseDate+parseAbsoluteDate :: String -> Either String DateTime+parseAbsoluteDate = first show . parseDate mempty++getMeta :: (Meta -> [Inline]) -> Pandoc -> Either String String+getMeta f (Pandoc m _) = case f m of+ [] -> Left "Couldn't find it"+ xs -> Right (stringify xs)++-- | Creates a post given a constructor for a post+createPost+ :: Show a+ => Format+ -> String+ -> Either a Pandoc+ -> Either String Post+createPost _ _ (Left e) = Left (show e)+createPost format fileName (Right pd) = do+ postTitle <- Title <$> getMeta docTitle pd+ postDate <- getMeta docDate pd >>= parseAbsoluteDate+ return Post{..}++fileToPost :: String -> IO (Either String Post)+fileToPost fileName =+ case splitExtension fileName of+ (name, ".pdf") ->+ return . createPost LaTeX name . readLaTeX def =<< readFile ("posts/" <> name <> ".tex")+ (name, ".md") ->+ return . createPost Markdown name . readMarkdown def =<< readFile ("posts/" <> fileName)+ _ -> pure (Left "Not a LaTeX or MD file")++injectIndex :: String -> Html -> Maybe String+injectIndex layout ul = injectAt [ TagSoup.TagOpen "ul" [("id","blog-posts")]+ , TagSoup.TagClose "ul"]+ layout (show ul)++injectTemplate :: String -> Post -> Maybe String+injectTemplate layout post+ | format post == Markdown = injectAt tags layout inp+ | otherwise = Nothing+ where+ tags = [TagSoup.TagOpen "div" [("id","blog-post")], TagSoup.TagClose "div"]+ inp = "<div id='blog-post'>" <> writeHtmlString def (pd post) <> "</div>"++injectAt :: [TagSoup.Tag String] -> String -> String -> Maybe String+injectAt p layout insert = case splitOn p (TagSoup.parseTags layout) of+ [beg, end] -> Just $ TagSoup.renderTags (beg <> TagSoup.parseTags insert <> end)+ _ -> Nothing++writeHTML :: String -> Post -> Maybe (IO ())+writeHTML template p@Post{..} =+ writeFile ("posts/" <> fileName <> ".html") <$> injectTemplate template p