{-# LANGUAGE NoImplicitPrelude #-}


{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}


module Web.Geek.Post where

import Air.Env
import Data.Aeson.Generic (encode, decode)
import Data.Char
import Data.Maybe
import Data.Text (Text, pack, strip, stripStart)
import Data.Time
import GHC.Exts( IsString(..) )
import System.FilePath
import System.Locale
import Web.Geek.Config
import Web.Geek.Type
import qualified Data.Text as T
import qualified Data.Map as Map

post_tags :: Text -> Post -> [Text]
post_tags _meta_tag_keyword post =
  case post.meta.Map.lookup _meta_tag_keyword of
    Nothing -> []
    Just s -> s.T.splitOn ",".map T.strip

post_link :: Post -> URIEscapedText
post_link post =
  let
    text_link =
      case post.date of
        Just _date ->
          let
            link_format = "%Y/%m/%d"
            prefix = T.pack - formatTime defaultTimeLocale link_format - _date.utctDay
          in
          prefix + "/" + post.title
        Nothing ->
          "post/" + post.title
  in

  text_link.T.unpack.fromString

parse_title_and_date_from_path :: String -> FilePath -> (T.Text, Maybe UTCTime)
parse_title_and_date_from_path _post_date_format _path =
  let
    base_name = _path.takeBaseName
    _post_date_length = post_date_length - _post_date_format

    _title = base_name.drop _post_date_length
    _date = base_name.take _post_date_length.parseTime defaultTimeLocale _post_date_format
  in
  (_title.T.pack, _date)

markup :: [MarkupEngine] -> FilePath -> Text -> HTMLText
markup markups _path _body =
  let ext = _path.takeExtension.dropWhile (is '.').pack
  in

  case markups.select (extensions > has ext) of
    [] -> transformer def _body
    _markup:_ -> transformer _markup _body

parse_meta :: Text -> (Meta, Text)
parse_meta str =
  let no_meta = (def, str)
  in

  case str.T.stripStart.T.splitOn "---\n" of
    (x:y:zs) ->
      if x.T.all isSpace
        then
          let
            parse_line line =
              case line.T.splitOn ":" of
                w1:w2:[] -> Just (w1.strip, w2.strip)
                _ -> Nothing
          in

          let _meta = y.T.lines.reject (T.all isSpace).map parse_line.catMaybes .to_h
          in
          (_meta, zs.T.unlines.stripStart)
        else
          no_meta
    _ -> no_meta