Main.hs

{-# LANGUAGE TemplateHaskell            #-}
{-# LANGUAGE OverloadedStrings          #-}


module Main where
    
import           Control.Exception (SomeException, try)
import           Control.Arrow (second)
import qualified Data.Text as T
import           System.IO

import           Snap
import           Snap.Core
import           Snap.Http.Server
import           Snap.Snaplet.Config
import           Snap.Snaplet.Session.Backends.CookieSession
import           Snap.Snaplet.AcidState (acidInit)
import           Snap.Snaplet.Heist
import           Snap.Snaplet.Fay
import           Snap.StaticPages


import           SnapApp.Application
import           SnapApp.Models (initApplicationState)
import           SnapApp.Routes
import           SnapApp.Utils
import           SnapApp.Splices

import           Snap.Loader.Dynamic
-- import           Snap.Loader.Static  

------------------------------------------------------------------------------
-- Init Code
------------------------------------------------------------------------------

app :: SnapletInit App App
app = makeSnaplet "app" "Haskell Snippet Sharing." Nothing $ do
    a <- nestSnaplet "acid" acid $ acidInit initApplicationState
    h <- nestSnaplet "heist" heist $ heistInit "templates"
    s <- nestSnaplet "sess" sess $ initCookieSessionManager "site_key.txt" "sess" Nothing -- | (Just 3600)
    f <- nestSnaplet "fay"  fay initFay
    t <- nestSnaplet "book" book $ staticPagesInit h "bookdata"
    addSplices $
        [ ("currentuser", currentUserSplice)
        , ("username", currentUserNameSplice)
        ]
    addRoutes $ routeList
    return $ App a h s f t

getActions :: Config Snap AppConfig -> IO (Snap (), IO ())
getActions conf = do
    (msgs, site, cleanup) <- runSnaplet
        (appEnvironment =<< getOther conf) app
    hPutStrLn stderr $ T.unpack msgs
    return (site, cleanup)
        
getConf :: IO (Config Snap AppConfig)
getConf = commandLineAppConfig defaultConfig

-- | Use the built in server
main :: IO ()
main = do
    (conf, site, cleanup) <- $(loadSnapTH [| getConf |] 'getActions
                                          ["snaplets/heist/templates"])
    _ <- try $ httpServe conf site :: IO (Either SomeException ())
    cleanup