--------------------------------------------------------------------------------
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}

import Hakyll

import Control.Applicative  ((<$>)) 
import Control.Monad    (liftM,foldM,(>=>))
import Control.Arrow(first)

import qualified Data.Set as S
import qualified Data.Map as M

import Data.Ord (comparing)
import Data.List (sortBy, groupBy)
import Data.Monoid (mappend,mconcat,(<>))
--import Data.Maybe (catMaybes,fromMaybe, listToMaybe)

import Data.Function (on)

import Data.Time.Format (formatTime, defaultTimeLocale)

-- System modules
--import System.Environment
--import System.FilePath (takeFileName)

import           Text.Pandoc.Options


--------------------------------------------------------------------------------
-- Configuration (in Inre)
--------------------------------------------------------------------------------



--------------------------------------------------------------------------------
-- Rule sets
--------------------------------------------------------------------------------

main :: IO ()
main = hakyll $ do
-- templates
    match "templates/*" $ compile templateCompiler

-- assets + static 
-- .. move to top-level
    match "static/**" $ do
      route $ gsubRoute "static/" (const "")

------------------------------
-- Site
------------------------------

-- index
      match "index.html" $ do
        route idRoute
        compile $ genCompiler tags 
-- archive
      match "archive.html" $ do
        route idRoute
        compile $ genCompiler
------------------------------
-- Feed postCtx 
-- !! postCtx feedCtx renderAtom myFeedConfiguration
------------------------------
-- atom
create ["atom.xml"] $ do
  route idRoute
  compile $ do 
      let feedCtx = postCtx `mappend` bodyField "description"
      posts <- fmap (take 10) . recentFirst =<<
        loadAllSnapshots ("blog/*" .&&. hasNoVersion) "teaser"
      renderAtom myFeedConfiguration feedCtx posts
-- sitemap
create ["sitemap.xml"] $ do
  route idRoute
  compile $ do
    posts <- recentFirst =<< loadAll "blog/*"
    
--    let sitemapCtx = mconcat [ listField "entries" ]


--------------------------------------------------------------------------------
-- Compilers
--------------------------------------------------------------------------------

indexCompiler :: String -> Routes -> Pattern -> Rules ()
indexCompiler name path itemsPattern =
  create [fromFilePath $ name ++ ".html"] $ do
    route path
    compile $ do
      makeItem ""
        >>= loadAndApplyTemplate "templates/index.html" (archiveCtx itemsPattern)
        >>= loadAndApplyTemplate "templates/layout.html" defaultCtx

contentCompiler :: Content -> Channels -> Streams -> Rules ()
contentCompiler content channels streams =
  match pattern $ do
    route $ niceRoute routeRewrite
    compile $ pandocCompiler streams
      >>= webSocketPipe channels
      >>= loadAndApplyTemplate itemTemplate context
      >>= loadAndApplyTemplate "templates/layout.html" layoutContext
  where pattern       = contentPattern content
        routeRewrite  = contentRoute content
        template      = contentTemplate content
        context       = contentContext content
        layoutContext = contentLayoutContext content
        itemTemplate  = fromFilePath $ "templates/" ++ template ++ ".html"

sassCompiler :: Compiler (Item String)
sassCompiler = loadBody (fromFilePath "scss/screen.scss")
                 >>= makeItem
                 >>= withItemBody (unixFilter "scss" args)
  where args = ["-s", "-I", "provider/scss/",
                "--cache-location", "generated/scss"]



niceItemUrl :: Item a -> Compiler String
niceItemUrl =
  fmap (maybe "" (removeIndexStr . toUrl)) . getRoute . setVersion Nothing . itemIdentifier
  where removeIndexStr url = case splitFileName url of
          (dir, "index.html") -> dir
          _ -> url

--------------------------------------------------------------------------------
-- rules
--------------------------------------------------------------------------------


--------------------------------------------------------------------------------
-- Contexts
--------------------------------------------------------------------------------

defaultCtx :: Context String
defaultCtx = mconcat
  [ bodyField "body"
  , metadataField
  , titleField
  , niceUrlField "url"
  , pathField "path"
  , missingField
  ]


postCtx :: Context String
postCtx =
    dateField "date" "%e %B %Y" `mappend`
    defaultContext

postCtx :: Bool -> Context String
postCtx preview = mconcat
  [ dateField "datePost" "%e %b %Y"
  , dateField "dateArchive" "%b %e"
  , gitTag "git"
  , socialTag "social"
  , defaultCtx
  ]



--tagsCtx :: Pattern -> String -> Context String
--tagsCtx pat tag = mconcat
--  [ constField "tag" tag
--  , customTitleField $ "Tagged: " ++ tag
--  , archiveCtx pat
--  ]

--titleField :: Context String
--titleField = field "pageTitle" $ \item -> do
--  title <- getMetadataField (itemIdentifier item) "title"
--  maybe (return "Infinite regress") (return . ("In re: " ++ )) title

--customTitleField :: String -> Context String
--customTitleField value = constField "pageTitle" $ " In re:" ++ value

-- url field without /index.html
niceUrlField :: String -> Context a
niceUrlField key = field key niceItemUrl

gitTag :: String -> Context String
gitTag key = field key $ \_ -> do
  unsafeCompiler $ do
    sha <- readProcess "git" ["log", "-1", "HEAD", "--pretty=format:%H"] []
    message <- readProcess "git" ["log", "-1", "HEAD", "--pretty=format:%s"] []
    return ("<a href=\"https://github.com/dled/inre/commit/" ++ sha ++
           "\" title=\"" ++ message ++ "\">" ++ (take 8 sha) ++ "</a>")

--------------------------------------------------------------------------------
-- Patterns + helpers
--------------------------------------------------------------------------------
-- postLst identifier
postLst :: Pattern -> Identifier -> Context String -> ([Item String] -> Compiler [Item String]) -> Compiler String
postLst pattern template context sortFilter = do
  posts <- return =<< sortFilter =<< loadAll (pattern .&&. hasNoVersion)
  itemTpl <- loadBody template
  applyTemplateList itemTpl (teaserField "teaser" "teaser" `mappend` context) posts

  
  postList :: Pattern -> ([Item String] -> Compiler [Item String]) -> Compiler String
  postList searchPattern = postLst searchPattern "templates/post-item.html" postCtx

-- !
  dateExtractor :: String -> Item String -> Compiler String
  dateExtractor format p = do
    utcTime <- getItemUTC defaultTimeLocale $ itemIdentifier p
    return $ formatTime defaultTimeLocale format utcTime

   postListMonthly :: Tags -> Pattern