{-# LANGUAGE QuasiQuotes, OverloadedStrings, TemplateHaskell #-}
{-# LANGUAGE CPP #-}
module Handler.Profile
    ( getProfileR
    , postProfileR
    , postDeleteAccountR
    , postSkillsR
    , postDeleteIdentR
    , postRequestRealR
    , postRequestRealPicR
    , postRequestUnblockR
    , postRequestSkillR
    , postSetUsernameR
    , postClearUsernameR
    , postScreenNamesR
    , postDeleteScreenNameR
    ) where

import Import
import Handler.Root (yearField)
import Handler.Root (gravatar)
import Yesod.Form.Jquery
import Data.Maybe (isJust)
import Control.Monad (filterM, forM_, unless)
import Yesod.Auth (requireAuthId)
import Control.Arrow ((&&&))
import Data.Time
import Data.Text (pack)
import qualified Data.Text as T
import Data.Char (isDigit)
import Yesod.Static

screenNameFormlet :: UserId -> Form ScreenName
screenNameFormlet uid = renderTable $ ScreenName
    <$> pure uid
    <*> areq (selectFieldList servopts) "Service" Nothing
    <*> areq textField "Screen name" Nothing
  where
    servopts = map (T.pack . show &&& id)
             $ filter (/= GooglePlus) [minBound..maxBound]

userForm :: Int -> User -> Form User
userForm maxY u = renderTable $ User
    <$> areq textField "Full name"
            { fsId = Just "full-name"
            } (Just $ userFullName u)
    <*> aopt urlField "Website"
            { fsId = Just "website"
            } (Just $ userWebsite u)
    <*> pure (userEmail u)
    <*> pure (userVerifiedEmail u)
    <*> pure (userVerkey u)
    <*> aopt (yearField 1985 maxY) "Using Haskell since"
            { fsTooltip = Just "Don't worry if you took breaks from Haskell, just put the year you wrote your first Haskell code"
            } (Just $ userHaskellSince u)
    <*> aopt textareaField "Description"
            { fsId = Just "desc"
            } (Just $ userDesc u)
    <*> areq boolField "Visible?"
            { fsTooltip = Just "Do you want your profile to be displayed on the homepage?"
            } (Just $ userVisible u)
    <*> pure (userReal u)
    <*> pure (userRealPic u)
    <*> pure (userAdmin u)
    <*> aopt (selectFieldList empOpts) "Employment status"
            { fsTooltip = Just "Just remember, this information will be public, meaning your current employer will be able to see it!"
            } (Just $ userEmployment u)
    <*> pure (userBlocked u)
    <*> areq boolField "Public email address?"
            { fsTooltip = Just "Selecting this will allow anyone to see your email address, without passing a captcha. May lead to spam."
            } (Just $ userEmailPublic u)
    <*> aopt textField "Location"
            { fsTooltip = Just "This should be a human-readable string"
            , fsId = Just "location"
            } (Just $ userLocation u)
    <*> aopt doubleField "Longitude"
            { fsId = Just "longitude"
            } (Just $ userLongitude u)
    <*> aopt doubleField "Latitude"
            { fsId = Just "latitude"
            } (Just $ userLatitude u)
    <*> pure (userGooglePlus u)
  where
    empOpts = map (pack . prettyEmployment &&& id) [minBound..maxBound]

getProfileR :: Handler Html
getProfileR = do
    Entity uid u <- requireAuth
    now <- liftIO getCurrentTime
    let (maxY, _, _) = toGregorian $ utctDay now
    ((res, form), enctype) <- runFormPostNoToken $ userForm (fromInteger maxY) u
    musername <- fmap (fmap entityVal) $ runDB $ getBy $ UniqueUsernameUser uid
    case res of
        FormSuccess u' -> do
            runDB $ replace uid u'
            setMessage "Updated your profile"
            redirect ProfileR
        _ -> return ()
    y <- getYesod
    skills <- runDB $ selectList [] [Asc SkillName] >>= mapM (\(Entity sid s) -> do
        x <- getBy $ UniqueUserSkill uid sid
        return $ ((sid, s), isJust x)
        )
    packages <- runDB $ selectList [PackageUser ==. uid] [Asc PackageName]
    idents <- runDB $ selectList [IdentUser ==. uid] [Asc IdentIdent]
    screenNames <- runDB $ selectList
      [ScreenNameUser ==. uid, ScreenNameService !=. GooglePlus]
                    [Asc ScreenNameService, Asc ScreenNameName]
    ((_, screenNameForm), _) <- runFormGet $ screenNameFormlet uid
    defaultLayout $ do
        addScriptEither $ urlJqueryJs y
        addScript $ StaticR jquery_cookie_js
        addScriptEither $ urlJqueryUiJs y
        addStylesheetEither $ urlJqueryUiCss y
        setTitle "Edit Your Profile"
        addMapAPI
        $(widgetFile "profile")
  where
    notOne [_] = False
    notOne _ = True
    isWeb t = "http://" `T.isPrefixOf` t || "https://" `T.isPrefixOf` t

postProfileR :: Handler Html
postProfileR = getProfileR

postDeleteAccountR :: Handler ()
postDeleteAccountR = do
    uid <- requireAuthId
    runDB $ do
        updateWhere [TopicCreator ==. Just uid] [TopicCreator =. Nothing]
        updateWhere [TopicMessageCreator ==. Just uid]
                    [TopicMessageCreator =. Nothing]
        deleteWhere [IdentUser ==. uid]
        deleteWhere [UserSkillUser ==. uid]
        deleteWhere [PackageUser ==. uid]
        updateWhere [MessageFrom ==. Just uid] [MessageFrom =. Nothing]
        updateWhere [MessageRegarding ==. Just uid] [MessageRegarding =. Nothing]
        deleteWhere [ScreenNameUser ==. uid]
        deleteWhere [UsernameUser ==. uid]
        deleteWhere [JobPostedBy ==. uid]
        deleteWhere [TeamUserUser ==. uid]
        deleteWhere [PollAnswerUser ==. uid]
        delete uid
    setMessage "Your account has been deleted."
    redirect RootR

postSkillsR :: Handler ()
postSkillsR = do
    uid <- requireAuthId
    allSkills <- fmap (map entityKey) $ runDB $ selectList [] []
    let toBool = maybe False (const True)
    skills <- flip filterM allSkills $ \sid ->
        fmap toBool $ runInputPost (iopt textField $ toPathPiece sid)
    runDB $ do
        deleteWhere [UserSkillUser ==. uid]
        forM_ skills $ \sid -> insert (UserSkill uid sid)
    setMessage "Your skills have been updated"
    redirect ProfileR

postDeleteIdentR :: IdentId -> Handler ()
postDeleteIdentR iid = do
    uid <- requireAuthId
    i <- runDB $ get404 iid
    unless (uid == identUser i) notFound
    idents <- runDB $ count [IdentUser ==. uid]
    if idents > 1
        then do
            runDB $ delete iid
            setMessage "Identifier deleted"
        else setMessage "You cannot delete your last identifier"
    redirect ProfileR

badge_png_plain :: Route Static
badge_png_plain = StaticRoute ["badge.png"] []

postRequestRealR :: Handler ()
postRequestRealR = do
    Entity uid u <- requireAuth
    if userReal u
        then setMessage "You already have verified user status"
        else if userVerifiedEmail u && hasGoodName (T.unpack $ userFullName u)
            then do
                now <- liftIO getCurrentTime
                _ <- runDB $ insert $ Message
                    { messageClosed = False
                    , messageWhen = now
                    , messageFrom = Just uid
                    , messageRegarding = Just uid
                    , messageText = Textarea "Requesting verified user status"
                    }
                setMessage "Your request has been logged. Good luck!"
            else setMessage "Before requesting verified user status, please enter your name and verify your email address."
    redirect ProfileR

hasGoodName :: String -> Bool
hasGoodName "" = False
hasGoodName ('h':'t':'t':'p':_) = False
hasGoodName _ = True

postRequestRealPicR :: Handler ()
postRequestRealPicR = do
    Entity uid u <- requireAuth
    if userRealPic u
        then setMessage "You already have real picture status"
        else if userVerifiedEmail u && hasGoodName (T.unpack $ userFullName u)
            then do
                now <- liftIO getCurrentTime
                _ <- runDB $ insert $ Message
                    { messageClosed = False
                    , messageWhen = now
                    , messageFrom = Just uid
                    , messageRegarding = Just uid
                    , messageText = Textarea "Requesting real picture status"
                    }
                setMessage "Your request has been logged. Good luck!"
            else setMessage "Before requesting real picture status, please enter your name and verify your email address."
    redirect ProfileR

postRequestUnblockR :: Handler ()
postRequestUnblockR = do
    Entity uid u <- requireAuth
    if userBlocked u
        then do
            now <- liftIO getCurrentTime
            _ <- runDB $ insert $ Message
                { messageClosed = False
                , messageWhen = now
                , messageFrom = Just uid
                , messageRegarding = Just uid
                , messageText = Textarea "Requesting unblock"
                }
            setMessage "Your request has been logged. Good luck!"
        else setMessage "Your account isn't blocked."
    redirect ProfileR

postRequestSkillR :: Handler ()
postRequestSkillR = do
    uid <- requireAuthId
    res <- runInputPost $ iopt textField "skill"
    case res of
        Just skill -> do
            now <- liftIO getCurrentTime
            _ <- runDB $ insert $ Message
                { messageClosed = False
                , messageWhen = now
                , messageFrom = Just uid
                , messageRegarding = Nothing
                , messageText = Textarea $ T.unlines
                    [ "Requesting new skill"
                    , ""
                    , skill
                    ]
                }
            setMessage "Your skill request has been logged."
        Nothing -> setMessage "Invalid skill entered."
    redirect ProfileR

postClearUsernameR :: Handler ()
postClearUsernameR = do
    uid <- requireAuthId
    runDB $ deleteBy $ UniqueUsernameUser uid
    setMessage "Your username has been cleared."
    redirect ProfileR

postSetUsernameR :: Handler ()
postSetUsernameR = do
    uid <- requireAuthId
    res <- runInputPost $ iopt textField "username"
    let musername =
            case res of
                Just x ->
                    if T.all validChar x && not (T.all isDigit x)
                        then Just x
                        else Nothing
                _ -> Nothing
    case musername of
        Nothing -> setMessage "Invalid username"
        Just un -> do
            x <- runDB $ insertBy $ Username uid un
            case x of
                Left _ -> setMessage "Username already in use"
                Right _ -> setMessage "Your username is set!"
    redirect ProfileR
  where
    validChar '-' = True
    validChar '_' = True
    validChar c
        | 'A' <= c && c <= 'Z' = True
        | 'a' <= c && c <= 'z' = True
        | '0' <= c && c <= '9' = True
    validChar _ = False

postScreenNamesR :: Handler ()
postScreenNamesR = do
    uid <- requireAuthId
    ((res, _), _) <- runFormPostNoToken $ screenNameFormlet uid
    case res of
        FormSuccess sn -> do
            _ <- runDB $ insert sn
            setMessage "Screen name added"
        _ -> setMessage "Invalid screen name"
    redirect ProfileR

postDeleteScreenNameR :: ScreenNameId -> Handler ()
postDeleteScreenNameR snid = do
    uid <- requireAuthId
    sn <- runDB $ get404 snid
    unless (screenNameUser sn == uid) notFound
    runDB $ delete snid
    setMessage "Screen name deleted"
    redirect ProfileR
