"]
-
-exampleTemplateFile :: String
-exampleTemplateFile = unlines
- [ ""]
diff --git a/Heckle.hs b/Heckle.hs
deleted file mode 100644
--- a/Heckle.hs
+++ /dev/null
@@ -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 = "
" ++ (writeHtmlString def t) ++ "
"
-
-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 ()
diff --git a/Main.hs b/Main.hs
deleted file mode 100644
--- a/Main.hs
+++ /dev/null
@@ -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
element for index file"
- let generatedHtml = postsToHtml posts
-
- putStrLn "Inserting HTML
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"
diff --git a/heckle.cabal b/heckle.cabal
--- a/heckle.cabal
+++ b/heckle.cabal
@@ -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
diff --git a/heckle/Main.hs b/heckle/Main.hs
new file mode 100644
--- /dev/null
+++ b/heckle/Main.hs
@@ -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
element for index file"
+ let generatedHtml = postsToHtml posts
+
+ putStrLn "Inserting HTML
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
diff --git a/src/Heckle.hs b/src/Heckle.hs
new file mode 100644
--- /dev/null
+++ b/src/Heckle.hs
@@ -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 = "
" <> writeHtmlString def (pd post) <> "
"
+
+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