{-# LANGUAGE TypeFamilies, QuasiQuotes, GeneralizedNewtypeDeriving, TemplateHaskell, MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
import Yesod
import Yesod.Helpers.Crud
import Database.Persist
import Database.Persist.Sqlite
import Database.Persist.TH
import Data.Time (Day)
import Network.Wai.Middleware.Debug (debug)
import Network.Wai.Handler.Warp (run)
import Model

mkToForm (undefined :: Entry)


-- Necesary for CRUD
instance Item Entry where
   itemTitle = entryTitle

data Blog = Blog { pool :: ConnectionPool }

type EntryCrud = Crud Blog Entry
entryCrud :: Blog -> Crud Blog Entry
entryCrud = defaultCrud

mkYesod "Blog" [parseRoutes|
/               RootR  GET
/entry/#EntryId EntryR GET
-- Subsite
/admin          AdminR EntryCrud entryCrud
|]

instance Yesod Blog where
   approot _ = "http://localhost:3000"

instance YesodPersist Blog where
   type YesodDB Blog = SqlPersist
   runDB db = liftIOHandler $ fmap pool getYesod >>= runSqlPool db

getRootR = do
       entries <- runDB $ selectList [] [EntryDayDesc] 0 0
       defaultLayout $ do
           setTitle $ string "Yesod Blog Tutorial Homepage"
           [hamlet|
<h1> Archive
<ul>
   $forall entry <- entries
    <li>
    <a href="@{EntryR (fst entry)}">#{entryTitle (snd entry)}
    <p>
    <a href="@{AdminR CrudListR}">Admin
|]

getEntryR entryid = do
   entry <- runDB $ get404 entryid
   defaultLayout $ do
       setTitle $ string $ entryTitle entry
       [hamlet|
<h1> #{entryTitle entry}
<h2> #{show (entryDay entry)}
#{entryContent entry}
|]

withBlog :: (Application -> IO a) -> IO a
withBlog f = withSqlitePool "blog.db3" 8 $ \pool -> do
   flip runSqlPool pool $ do
       (runMigration migrateAll)
       insert $ Entry "First Entry" (read "2011-04-04")
              $ preEscapedString "<h3>First Entry</h3>"
   let h = Blog pool
   toWaiApp h >>= f

main = withBlog $ run 3000 . debug