content: {-# LANGUAGE FlexibleInstances          #-}
  {-# LANGUAGE GeneralizedNewtypeDeriving #-}
  {-# LANGUAGE OverloadedStrings          #-}
  {-# LANGUAGE RecordWildCards            #-}
  {-# LANGUAGE TypeSynonymInstances       #-}
  
  module Heckle where
  
  import Control.Applicative
  import Control.Monad
  import Data.Either
  import Data.Function (on)
  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.Time
  
  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
  
  displayDate :: UTCTime -> String
  displayDate = formatTime defaultTimeLocale "%-d %B %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  -- TODO make this more typed
    , postTitle   :: Title
    , postDate    :: UTCTime
    , format      :: Format
    , pd          :: Pandoc
    }  
    deriving (Show, Eq)
  
  instance Ord Post where
    compare = compare `on` postDate
  
  parseAbsoluteDate :: String -> Either String UTCTime
  parseAbsoluteDate s = case parseAbsoluteDate' s of
    Just a -> Right a
    Nothing -> Left "Date does not match valid formats"
  
  
  -- | Valid formats:
  -- | 6 January 2012
  -- | January 6, 2012
  -- | 9:47AM 6 January 2012
  -- | 9:47AM January 6, 2012
  parseAbsoluteDate' :: String -> Maybe UTCTime 
  parseAbsoluteDate' s = foldr (<|>) Nothing results  
    where
      results = map ($ s) options
      options = map (parseTimeM True defaultTimeLocale) formats
      formats = ["%-d %B %Y", "%B %-d, %Y", "%-l:%M%p %-d %B %Y", "%-l:%M%p %B %-d, %Y"]
  
  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{..}
  
  splitExtension :: String -> Maybe (String, String)
  splitExtension s = case splitOn "." s of
    [a,b] -> Just (a, b)
    _ -> Nothing
  
  fileToPost :: String -> IO (Either String Post)
  fileToPost fileName =
    case splitExtension fileName of
      Just (name, "pdf") ->
        return . createPost LaTeX name . readLaTeX def =<< readFile ("posts/" <> name <> ".tex")
      Just (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
  