{-# LANGUAGE OverloadedStrings #-}

module Inf.DB where

import           Control.Monad (forM)
import qualified Data.ByteString as BS
import qualified Data.Text as TS
import qualified Data.Text.Lazy as T
import qualified Data.Time as Time

import qualified Inf.DB.Monad as DB
import           Inf.Types

submitPost :: User -> RawPost -> DB.DB ()
submitPost uname rp = case rpId rp of
  Just (PostId n) | uname == rpAuthor rp -> do
    invalidateCachedMarkup (PostId n)
    DB.execute
      "UPDATE posts \
      \ SET title = ?, author = ?, contents = ? \
      \ WHERE id = ?"
      [ DB.f (rpTitle rp)
      , DB.f (userName (rpAuthor rp))
      , DB.f (rpContents rp)
      , DB.f n
      ]
  Just _ -> DB.raise DB.BadUserError
  Nothing -> do
    now <- DB.io Time.getCurrentTime
    prev <- fmap (fmap DB.fromOnly) (DB.queryMb "SELECT id FROM posts ORDER BY time DESC LIMIT 1" [])
    DB.execute
     "INSERT INTO posts \
      \ (title, contents, author, time, next, prev) \
      \ VALUES (?, ?, ?, ?, ?, ?)"
      [DB.f (rpTitle rp), DB.f (rpContents rp), DB.f (rpAuthor rp), DB.f now, DB.f (Nothing :: Maybe Int), DB.f (prev :: Maybe Int)]

    new <- DB.lastRow
    case prev of
      Just p -> DB.execute
        "UPDATE posts SET next = ? WHERE id = ?" [DB.f new, DB.f p]
      Nothing -> pure ()

    let (year, month, _) = Time.toGregorian (Time.utctDay now)
    DB.execute
      "INSERT INTO lookup (year, month, time, slug, post_id) \
      \ VALUES (?, ?, ?, ?, ?)"
      [DB.f year, DB.f month, DB.f now, DB.f (slugify (rpTitle rp)), DB.f new]

deletePost :: RawPost -> DB.DB ()
deletePost rp
  | Just post <- rpId rp = do
  vals <- DB.query "SELECT next, prev FROM posts WHERE id = ?" [DB.f post]

  (oldNext :: Maybe Int, oldPrev :: Maybe Int) <- case vals of
    [] -> DB.raise (DB.MissingPost post)
    (x, y):_ -> pure (x, y)

  case oldPrev of
    Just n -> DB.execute
      "UPDATE posts SET next = ? WHERE id = ?" [DB.f oldNext, DB.f n]
    Nothing -> pure ()

  case oldNext of
    Just n -> DB.execute
      "UPDATE posts SET prev = ? WHERE id = ?" [DB.f oldPrev, DB.f n]
    Nothing -> pure ()

  DB.execute "DELETE FROM lookup WHERE post_id = ?" [DB.f post]
  DB.execute "DELETE FROM posts WHERE id = ?" [DB.f post]
deletePost _ = DB.raise DB.NoSuchPost



newestPost :: DB.DB (Maybe Post)
newestPost = do
  values <- DB.queryMb
    "SELECT p.title, p.contents, p.author, p.time, p.next, p.prev, l.slug \
    \ FROM posts p, lookup l WHERE p.id == l.post_id ORDER BY time DESC LIMIT 1"
    []
  forM values $ \(pId, title, contents, author, date, next, prev, slug) -> do
    nextRef <- mapM postRefById next
    prevRef <- mapM postRefById prev
    pure Post
      { postId = pId
      , postDate = date
      , postTitle = title
      , postSlug = slug
      , postContents = contents
      , postAuthor = author
      , postNext = nextRef
      , postPrev = prevRef
      }

postRefById :: PostId -> DB.DB PostRef
postRefById pId = do
  (year, month, slug, name, date) <-
    DB.queryOne "SELECT l.year, l.month, l.slug, p.title, p.time \
                \ FROM lookup l, posts p \
                \ WHERE l.post_id = p.id and p.id = ?" [DB.f pId]
  pure PostRef
    { prYear = year
    , prMonth = month
    , prSlug = slug
    , prName = name
    , prDate = date
    }


newestPostRef :: DB.DB PostRef
newestPostRef = do
  vals <- DB.queryOne "SELECT id FROM posts ORDER BY time DESC LIMIT 1" []
  postRefById (DB.fromOnly vals)

oldestPostRef :: DB.DB PostRef
oldestPostRef = do
  vals <- DB.queryOne "SELECT id FROM posts ORDER BY time ASC LIMIT 1" []
  postRefById (DB.fromOnly vals)

staticPage :: TS.Text -> DB.DB Page
staticPage name = do
  pg <- DB.queryMb "SELECT title, contents FROM pages WHERE slug = ?"
    [DB.f name]
  case pg of
    Nothing -> DB.raise (DB.MissingPage name)
    Just x  -> pure x

allPosts :: DB.DB [Post]
allPosts = do
  values <- DB.query
    "SELECT p.id, p.time, p.title, p.contents, p.author, l.slug \
    \ FROM posts p, lookup l WHERE p.id == l.post_id " []
  pure [ Post pId date title slug content author Nothing Nothing
       | (pId, date, title, content, author, slug) <- values
       ]

allPostRefs :: DB.DB [PostRef]
allPostRefs = do
  posts <- DB.query "SELECT l.year, l.month, l.slug, p.title, p.time \
                    \ FROM lookup l, posts p WHERE p.id = l.post_id \
                    \ ORDER BY p.time DESC" []
  pure [ PostRef
           { prYear  = year
           , prMonth = month
           , prSlug  = slug
           , prName  = title
           , prDate  = date
           }
       | (year, month, slug, title, date) <- posts
       ]


postByDateAndSlug :: TS.Text -> TS.Text -> TS.Text -> DB.DB Post
postByDateAndSlug year month slug = do
  values <- DB.queryMb
    "SELECT post_id FROM lookup WHERE year = ? AND month = ? AND slug = ?"
    [DB.f year, DB.f month, DB.f slug]
  case values of
    Just p -> postById (DB.fromOnly p)
    Nothing -> DB.raise (DB.NoPostFound year month slug)

postById :: PostId -> DB.DB Post
postById pId = do
  (title, contents, author, date, next, prev, slug)
    <- DB.queryOne
         "SELECT p.title, p.contents, p.author, p.time, p.next, p.prev, l.slug \
         \ FROM posts p, lookup l WHERE p.id = l.post_id AND p.id = ?" [DB.f pId]
  nextRef <- mapM postRefById next
  prevRef <- mapM postRefById prev
  pure Post
    { postId = pId
    , postDate = date
    , postTitle = title
    , postSlug  = slug
    , postContents = contents
    , postAuthor = author
    , postNext = nextRef
    , postPrev = prevRef
    }


userAuthData :: TS.Text -> DB.DB (Maybe BS.ByteString)
userAuthData user =
  fmap DB.fromOnly <$>
    DB.queryMb "SELECT password FROM snap_auth_user WHERE login = ?"
      [DB.f user]

storeCachedRSS :: BS.ByteString -> DB.DB ()
storeCachedRSS prerendered = do
  DB.execute
    "INSERT INTO rsscache (prerendered) VALUES (?)"
    [DB.f prerendered]

cachedRSS :: DB.DB (Maybe BS.ByteString)
cachedRSS = do
  fmap DB.fromOnly <$>
    DB.queryMb "SELECT prerendered FROM rsscache" []

cachedMarkup :: PostId -> DB.DB (Maybe T.Text)
cachedMarkup pId = do
  fmap DB.fromOnly <$>
    DB.queryMb
      "SELECT prerendered FROM postcache WHERE post_id = ?"
      [DB.f pId]

storeCachedMarkup :: PostId -> T.Text -> DB.DB ()
storeCachedMarkup pId prerendered = do
  DB.execute
    "INSERT INTO postcache (prerendered, post_id) VALUES (?, ?)"
    [DB.f prerendered, DB.f pId]

invalidateCachedMarkup :: PostId -> DB.DB ()
invalidateCachedMarkup pId = do
  DB.execute "DELETE FROM postcache WHERE post_id = ?" [DB.f pId]
  DB.execute "DELETE FROM rsscache" []