--------------------------------------------------------------------------------
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE DeriveGeneric #-}
--------------------------------------------------------------------------------
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE DeriveGeneric #-}
import           Data.Monoid (mappend)
import           Hakyll
import Data.Maybe (fromMaybe)
import Text.Read (readMaybe)
import Control.Monad (liftM)
import Data.List ( sortBy, isInfixOf, intercalate )
import Data.Ord (comparing)
-- import           HakyllMedia.Image 
import System.FilePath.Posix ( takeDirectory
                             , takeBaseName
                             , (</>)
                             , splitFileName
                             )
import Control.Applicative (empty)


import qualified Data.HashMap.Strict            as HMS
import qualified Data.Set                       as S
import qualified Data.Text                      as T
import qualified Data.Yaml                      as Yaml
import qualified Data.Text   as T
import qualified Data.Vector as V
import           Data.Yaml
import           Data.Scientific

import Data.Yaml.Parser (FromYaml (fromYaml), YamlValue (Mapping), YamlParser)
import GHC.Generics (Generic)
import Data.Yaml (FromJSON)
import Data.Yaml.Aeson ((.:))
import qualified Data.Aeson.Key                 as AK
import qualified Data.Aeson.KeyMap              as KeyMap
import Data.Yaml.Aeson (Value(Object))
import Data.Map (mapMaybe)

--------------------------------------------------------------------------------
main :: IO ()
main = hakyll $ do
    match "content/images/*" $ do
        route rmContentPrefix
        compile copyFileCompiler

    match "content/css/*" $ do
        route rmContentPrefix
        compile compressCssCompiler

    match "content/cv/*" $ compile $ pandocCompiler
        >>= loadAndApplyTemplate "templates/cv-section.html" cvSecCtx
        >>= relativizeUrls
        >>= rmIndexHtml

    match (fromList ["content/about.md", "content/contact.md"]) $ compile $ pandocCompiler
        >>= loadAndApplyTemplate "templates/section.html" defaultContext
        >>= relativizeUrls
        >>= rmIndexHtml

    match "content/posts/*" $ do
        route $ rmContentPrefix `composeRoutes` niceRoute
        compile $ pandocCompiler
            >>= loadAndApplyTemplate "templates/post.html"    postCtx
            >>= loadAndApplyTemplate "templates/default.html" postCtx
            -- >>= mkResponsiveImage
            >>= relativizeUrls
            >>= rmIndexHtml

    create ["archive.html"] $ do
        route niceRoute
        compile $ do
            posts <- recentFirst =<< loadAll "content/posts/*"
            let archiveCtx =
                    listField "posts" postCtx (return posts) `mappend`
                    constField "title" "Archives"            `mappend`
                    defaultContext

            makeItem ""
                >>= loadAndApplyTemplate "templates/archive.html" archiveCtx
                >>= loadAndApplyTemplate "templates/default.html" archiveCtx
                >>= relativizeUrls
                >>= rmIndexHtml

    create ["cv.html"] $ do
        route niceRoute
        compile $ do
            sections <- byPriority =<< loadAll "content/cv/*"
            let cvCtx =
                  listField "sections" defaultContext (return sections) `mappend`
                  defaultContext

            makeItem ""
                >>= loadAndApplyTemplate "templates/cv.html" cvCtx
                >>= loadAndApplyTemplate "templates/default.html" cvCtx
                >>= relativizeUrls
                >>= rmIndexHtml

    match "content/index.html" $ do
        route rmContentPrefix
        compile $ do
            posts <- fmap (take 3) $ recentFirst =<< loadAll "content/posts/*"
            aboutStub <- loadBody "content/about.md"
            contactStub <- loadBody "content/contact.md"
            let indexCtx =
                    listField "posts" postCtx (return posts) `mappend`
                    constField "about" aboutStub `mappend`
                    constField "contact" contactStub `mappend`
                    defaultContext

            getResourceBody
                >>= applyAsTemplate indexCtx
                >>= loadAndApplyTemplate "templates/default.html" indexCtx
                >>= relativizeUrls
                >>= rmIndexHtml

    match "templates/*" $ compile templateBodyCompiler

rmContentPrefix = gsubRoute "content/" (const "")

--------------------------------------------------------------------------------
postCtx :: Context String
postCtx =
    dateField "date" "%Y-%m-%d" `mappend`
    defaultContext

cvSecCtx :: Context String
cvSecCtx =
    customCtx "heading" `mappend`
    defaultContext `mappend`
    skillsCtx 

customCtx :: String -> Context a
customCtx key = field key $ \item -> do
    metadata <- getMetadata (itemIdentifier item)
    return $ fromMaybe "" $ lookupString key metadata

skillsCtx :: Context String
skillsCtx = field "skills" $ \item -> do
    metadata <- getMetadata (itemIdentifier item)
    let skills :: Maybe String
        skills = case KeyMap.lookup (AK.fromString "skills") metadata of
                    Just (Array a) -> do 
                        let 
                            x = V.toList $ V.catMaybes $ fmap getName a
                        Just $ intercalate "<br/>" x 
                    _ -> Just ("" :: String)
    return $ fromMaybe "" skills

getName :: Value -> Maybe String 
getName (Object v) = case KeyMap.lookup (AK.fromString "name") v of
                        Just (String x) -> Just (T.unpack x)
                        _ -> Nothing 
getName _ = Nothing 

priority :: MonadMetadata m => Item a -> m Int
priority i = do
    mStr <- getMetadataField (itemIdentifier i) "priority"
    return $ fromMaybe 0 (mStr >>= readMaybe)

byPriority :: MonadMetadata m => [Item a] -> m [Item a]
byPriority = sortByM priority
  where
    sortByM :: (Monad m, Ord k) => (a -> m k) -> [a] -> m [a]
    sortByM f xs = map fst . sortBy (comparing snd) <$>
                   mapM (\x -> fmap (x,) (f x)) xs

niceRoute :: Routes
niceRoute = customRoute createIndexRoute
    where createIndexRoute identifier =
            takeDirectory p </> takeBaseName p </> "index.html"
            where p = toFilePath identifier

rmIndexHtml :: Item String -> Compiler (Item String)
rmIndexHtml item = return $ fmap (withUrls rmIndexStr) item

rmIndexStr :: String -> String
rmIndexStr url = case splitFileName url of
    (dir, "index.html") | isLocal dir -> dir
                        | otherwise -> url
    _ -> url
    where
        isLocal :: String -> Bool
        isLocal uri = not ("://" `isInfixOf` uri)

data Skill = Skill
  { skillName :: T.Text
  , skillIntensity :: Float
  }
  deriving (Eq, Show, Generic)

instance FromJSON Skill where
  -- fromYaml (Mapping yv _ ) = Skill <$> yv .: "name" <*> (read . T.unpack <$> yv .: "intensity")
  -- fromYaml _ = error "bad input"


-- lookupStringList :: String -> Metadata -> Maybe [String]
-- lookupStringList key meta =
--     HMS.lookup (T.pack key) meta >>= Yaml.toList >>= mapM Yaml.toString
--
lookupStringList :: String -> Metadata -> Maybe [String]
lookupStringList key meta =
    KeyMap.lookup (AK.fromString key) meta >>= yamlToList >>= mapM yamlToString

yamlToString :: Yaml.Value -> Maybe String
yamlToString (Yaml.String t)     = Just (T.unpack t)
yamlToString (Yaml.Bool   True)  = Just "true"
yamlToString (Yaml.Bool   False) = Just "false"
yamlToString (Yaml.Number d) | isInteger d = Just (formatScientific Fixed (Just 0) d)
                             | otherwise   = Just (show d)
yamlToString _              = Nothing

yamlToList :: Yaml.Value -> Maybe [Yaml.Value]
yamlToList (Yaml.Array a) = Just (V.toList a)
yamlToList _         = Nothing