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 (n1)
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 Format = LaTeX | Markdown
deriving (Show, Eq)
getOutputExtension :: Format -> String
getOutputExtension LaTeX = ".pdf"
getOutputExtension Markdown = ".html"
newtype Title = Title { getTitle :: String } deriving (Show, Eq, IsString, ToMarkup)
data Post = Post
{ fileName :: String
, postTitle :: Title
, postDate :: DateTime
, format :: Format
, pd :: Pandoc
} deriving (Show, Eq)
instance Ord Post where
compare = compare `on` postDate
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)
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