{-# LANGUAGE OverloadedStrings, NoImplicitPrelude, DeriveGeneric #-}
module Youtube (indexYTVideos) where
import System.IO (IO)
import Data.Int (Int)
import Prelude ((/=), Show, (*), not, const, String)
import Control.Concurrent (threadDelay)
import Data.Function (($), (.))
import Data.Tuple (snd)
import Control.Monad
import Data.Maybe
import Data.Monoid (mappend)
import GHC.Generics
import Data.List
import Network.HTTP.Types.Status (statusCode)
import qualified Network.HTTP.Conduit as HTTP
import qualified Data.ByteString.Lazy as L
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import qualified Network.URL as URL
import qualified Data.Aeson as Aeson
import Text.HTML.TagSoup hiding (parseTags, renderTags)
import Text.HTML.TagSoup.Fast.Utf8Only

import qualified DB

subInterval :: Int
subInterval = 5 * 1000  -- 5 seconds             

data VideoTitle = VideoTitle { title :: String } deriving (Generic, Show)
instance Aeson.FromJSON VideoTitle

data Snippet = Snippet { snippet :: VideoTitle } deriving (Generic, Show)
instance Aeson.FromJSON Snippet

data ApiResponse = ApiResponse { items :: [Snippet] } deriving (Generic, Show)
instance Aeson.FromJSON ApiResponse

getVideoTitleFromGoogle :: T.Text -> T.Text -> IO (Maybe T.Text)
getVideoTitleFromGoogle api_key video_id = do
  request' <- HTTP.parseUrl $ T.unpack $ mkYoutubeAPITitleRequest api_key video_id
  let request = request' { HTTP.checkStatus = \_ _ _ -> Nothing }
  res <- HTTP.withManager $ HTTP.httpLbs request
  return $ if (statusCode $ HTTP.responseStatus res) /= 200
           then Nothing
           else extractTitle (HTTP.responseBody res)
  where
    decode :: L.ByteString -> Maybe ApiResponse
    decode = Aeson.decode
    extractTitle :: L.ByteString -> Maybe T.Text
    extractTitle bytes = fmap (T.pack . title . snippet) $ decode bytes >>= (listToMaybe . items)
    mkYoutubeAPITitleRequest :: T.Text -> T.Text -> T.Text
    mkYoutubeAPITitleRequest key vid =
      "https://www.googleapis.com/youtube/v3/videos?id=" `mappend` vid
      `mappend` "&key=" `mappend` key
      `mappend` "&fields=items(snippet(title))&part=snippet"

period :: Int
period = 24  * 60 * 60 * 1000 -- once a day

indexYTVideos :: DB.Db -> T.Text -> IO ()
indexYTVideos db api_key = do
  threadDelay period
  -- extract all raw youtube video ids from all posts and store them into DB
  postIdsWithVideos <- DB.getPostIdsWithYoutubeLink db
  forM_ (chunkPostIds 10 postIdsWithVideos)  (\chunk_of_postIds -> do
                                                 postsText <- fmap (fmap DB.rawHTML) $ DB.getPostsByIds db chunk_of_postIds
                                                 let postIdVideoIdsPairs = zip chunk_of_postIds (fmap extractVideoIDsFromPost postsText)
                                                     video_ids = concatMap snd postIdVideoIdsPairs in
                                                   do
                                                     mapM_ (DB.storeNewYoutubeVideoId db) video_ids
                                                     mapM_ (DB.storePostYoutubeVideoIdPair db) $ concatMap (\(post_id, vids) -> zip (repeat post_id) vids) postIdVideoIdsPairs
                                                 threadDelay subInterval)
  -- walk over stored youtube video ids and update new ones
  newYoutubeVideoIds <- DB.getNewYoutubeVideoIds db
  forM_ newYoutubeVideoIds (\video_id -> do
                               maybeTitle <- getVideoTitleFromGoogle api_key video_id
                               let newState = maybe video_is_dead (const video_is_alive) maybeTitle in
                                 DB.updateYoutubeVideo db video_id (newState,  maybeTitle)
                               threadDelay subInterval)
  indexYTVideos db api_key
  where
    video_is_dead :: Int
    video_is_dead = 2
    video_is_alive = 1
    chunkPostIds :: Int  -> [DB.PostId] -> [[DB.PostId]]
    chunkPostIds  _ [] = []                
    chunkPostIds size whole = (take size whole) : chunkPostIds size (drop size whole)
  
extractVideoId :: URL.URL -> Maybe T.Text
extractVideoId url =
  case URL.url_type url of
    URL.Absolute host -> let packedHost = T.pack $ URL.host host in
                            if "youtu.be"  `T.isSuffixOf` packedHost
                            then Just $ T.pack $ URL.url_path url
                            else if "youtube.com" `T.isSuffixOf` packedHost
                                   then fmap T.pack $ lookup "v" (URL.url_params url)
                                   else Nothing
    _ -> Nothing

extractVideoIDsFromPost :: T.Text -> [T.Text]
extractVideoIDsFromPost post_text =
  let all_tags = parseTagsT $ E.encodeUtf8 post_text
      all_anchors = filter (isTagOpenName "a") all_tags
      all_hrefs = fmap (fromAttrib "href") all_anchors
      non_empty_hrefs = filter (not . T.null) all_hrefs
      all_urls = mapMaybe (URL.importURL . T.unpack) non_empty_hrefs in
  mapMaybe extractVideoId all_urls
