{-# LANGUAGE OverloadedStrings #-}
module Application where

import Memblog.Common

import LIO
import LIO.DCLabel
import LIO.Web.Simple
import LIO.Web.Simple.Auth
import LIO.Web.Simple.DCLabel
import Web.Frank

import Data.Aeson
import qualified Data.ByteString.Char8 as S8
import Data.Maybe

app :: (SimpleDCApplication -> DC ()) -> DC ()
app runner = do
  settings <- newAppSettings

  runner $ \currentPriv -> controllerApp settings $ do
    get "/" $ do
      posts <- getAllPosts
      ctx <- debugGetCtx
      render "index.html" $ object ["posts" .= posts, "ctx" .= ctx ]
    get "/new" $ do
      render "new.html" ()
    get "/login" $ withUser $ \user ->
      render "login.html" $ object ["user" .= user]
    get "/logout" $ do
      muser <- currentUser
      respond $ case muser of
                  Nothing -> redirectTo "/"
                  Just _  -> requestLogin
    get "/:pId" $ do
      pId   <- queryParam' "pId"
      post  <- getPostById pId
      muser <- currentUser
      let showEdit = Just (S8.pack $ postAuthor post) == muser
      render "show.html" $ object [ "post" .= post, "showEdit" .= showEdit]
    get "/:pId/edit" $ do
      pId     <- queryParam' "pId"
      curPost <- getPostById pId
      render "edit.html" curPost
    post "/" $ withUser $ \user -> do
      curPost <- formToPost user Nothing
      pId     <- insertPost currentPriv curPost
      respond . redirectTo . S8.pack $ "/" ++ pId
    post "/:pId" $ withUser $ \user -> do
      pId     <- queryParam' "pId"
      curPost <- formToPost user (Just pId)
      updatePost currentPriv curPost
      respond . redirectTo . S8.pack $ "/" ++ pId

formToPost :: UserName -> Maybe PostId -> DCController AppSettings Post
formToPost user mpId = do
  (params, _) <- parseForm
  let mpost :: Maybe Post
      mpost = do
        pTitle <- lookup "title" params
        pBody  <- lookup "body" params
        let pub = isJust $ lookup "publish" params
        if S8.null pTitle || S8.null pBody
          then fail "Invalid form"
          else return $ Post { postId          = pId
                             , postTitle       = S8.unpack pTitle
                             , postBody        = S8.unpack pBody 
                             , postIsPublished = pub
                             , postAuthor      = user }
  case mpost of
    Nothing -> redirectBack'
    Just p  -> return p
  where pId = fromMaybe undefined mpId
        redirectBack' =  do 
          redirectBack 
          return $ error "future version of simple won't need this type fix"

withUser :: (UserName -> DCController AppSettings ()) 
         -> DCController AppSettings ()
withUser act = withUserOrLogin $ \user -> act (S8.unpack user)

# LANGUAGE OverloadedStrings #
module Application where

import Memblog.Common

import LIO
import LIO.DCLabel
import LIO.Web.Simple
import LIO.Web.Simple.Auth
import LIO.Web.Simple.DCLabel
import Web.Frank

import Data.Aeson
import qualified Data.ByteString.Char8 as S8
import Data.Maybe

app :: (SimpleDCApplication -> DC ()) -> DC ()
app runner = do
  settings <- newAppSettings

  runner $ \currentPriv -> controllerApp settings $ do
    get "/" $ do
      posts <- getAllPosts
      ctx <- debugGetCtx
      render "index.html" $ object ["posts" .= posts, "ctx" .= ctx ]
    get "/new" $ do
      render "new.html" ()
    get "/login" $ withUser $ \user ->
      render "login.html" $ object ["user" .= user]
    get "/logout" $ do
      muser <- currentUser
      respond $ case muser of
                  Nothing -> redirectTo "/"
                  Just _  -> requestLogin
    get "/:pId" $ do
      pId   <- queryParam' "pId"
      post  <- getPostById pId
      muser <- currentUser
      let showEdit = Just (S8.pack $ postAuthor post) == muser
      render "show.html" $ object [ "post" .= post, "showEdit" .= showEdit]
    get "/:pId/edit" $ do
      pId     <- queryParam' "pId"
      curPost <- getPostById pId
      render "edit.html" curPost
    post "/" $ withUser $ \user -> do
      curPost <- formToPost user Nothing
      pId     <- insertPost currentPriv curPost
      respond . redirectTo . S8.pack $ "/" ++ pId
    post "/:pId" $ withUser $ \user -> do
      pId     <- queryParam' "pId"
      curPost <- formToPost user (Just pId)
      updatePost currentPriv curPost
      respond . redirectTo . S8.pack $ "/" ++ pId

formToPost :: UserName -> Maybe PostId -> DCController AppSettings Post
formToPost user mpId = do
  (params, _) <- parseForm
  let mpost :: Maybe Post
      mpost = do
        pTitle <- lookup "title" params
        pBody  <- lookup "body" params
        let pub = isJust $ lookup "publish" params
        if S8.null pTitle || S8.null pBody
          then fail "Invalid form"
          else return $ Post { postId          = pId
                             , postTitle       = S8.unpack pTitle
                             , postBody        = S8.unpack pBody 
                             , postIsPublished = pub
                             , postAuthor      = user }
  case mpost of
    Nothing -> redirectBack'
    Just p  -> return p
  where pId = fromMaybe undefined mpId
        redirectBack' =  do 
          redirectBack 
          return $ error "future version of simple won't need this type fix"

withUser :: (UserName -> DCController AppSettings ()) 
         -> DCController AppSettings ()
withUser act = withUserOrLogin $ \user -> act (S8.unpack user)
