{-# LANGUAGE TypeFamilies, QuasiQuotes, GeneralizedNewtypeDeriving #-}
import Yesod
import Yesod.Helpers.Auth
import Yesod.Helpers.Crud
import Database.Persist.Sqlite
import Data.Time (Day)

type Html' = Html ()
share2 mkPersist mkIsForm [$persist|
Entry
    title String
    posted Day Desc
    content Html'
    deriving
|]
instance Item Entry where
    itemTitle = entryTitle

getAuth = const $ Auth
    { authIsOpenIdEnabled = False
    , authRpxnowApiKey = Nothing
    , authEmailSettings = Nothing
    -- | client id, secret and requested permissions
    , authFacebook = Just (clientId, secret, ["email"])
    }
  where
    clientId = "134280699924829"
    secret = "a7685e10c8977f5435e599aaf1d232eb"

data Blog = Blog Connection
type EntryCrud = Crud Blog Entry
mkYesod "Blog" [$parseRoutes|
/ RootR GET
/entry/#EntryId EntryR GET
/admin AdminR EntryCrud defaultCrud
/auth AuthR Auth getAuth
|]
instance Yesod Blog where
    approot _ = "http://localhost:3000"
    defaultLayout p = do
        mcreds <- maybeCreds
        admin <- maybeAuthorized $ AdminR CrudListR
        hamletToContent [$hamlet|
!!!
%html
    %head
        %title $pageTitle.p$
        ^pageHead.p^
    %body
        %p
            %a!href=@RootR@ Homepage
            $maybe admin a
                \ | $
                %a!href=@a@ Admin
            \ | $
            $maybe mcreds c
                Welcome $
                $maybe credsDisplayName.c dn
                    $string.dn$
                $nothing
                    $string.credsIdent.c$
                \ $
                %a!href=@AuthR.Logout@ Logout
            $nothing
                %a!href=@AuthR.StartFacebookR@ Facebook Connect
        ^pageBody.p^
        %p
            Powered by Yesod Web Framework
|]
    isAuthorized AdminR{} = do
        mc <- maybeCreds
        let x = (mc >>= credsEmail) == Just "michael@snoyman.com"
        return $ if x then Nothing else Just "Permission denied"
    isAuthorized _ = return Nothing
instance YesodAuth Blog where
    defaultDest _ = RootR
    defaultLoginRoute _ = RootR
instance YesodPersist Blog where
    type YesodDB Blog = SqliteReader
    runDB db = do
        Blog conn <- getYesod
        runSqlite db conn

getRootR = do
    entries <- runDB $ select [] [EntryPostedDesc]
    applyLayoutW $ do
        setTitle $ string "Blog tutorial homepage"
        addBody [$hamlet|
%h1 All Entries
%ul
    $forall entries entry
        %li
            %a!href=@EntryR.fst.entry@ $string.entryTitle.snd.entry$
|]

getEntryR :: EntryId -> Handler Blog RepHtml
getEntryR eid = do
    entry <- runDB (get eid) >>= maybe notFound return
    applyLayoutW $ do
        setTitle $ string $ entryTitle entry
        addBody [$hamlet|
%h1 $string.entryTitle.entry$
%h2 $string.show.entryPosted.entry$
#content $entryContent.entry$
|]
main = withSqlite "blog.db3" $ \conn -> do
    flip runSqlite conn $ initialize (undefined :: Entry)
    toWaiApp (Blog conn) >>= basicHandler 3000