packages feed

snap-0.6.0: project_template/default/src/Main.hs

{-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-}

module Main where

import           Control.Exception (SomeException, try)

import qualified Data.Text as T

import           Snap.Http.Server
import           Snap.Snaplet
import           Snap.Core

import           System.IO

import           Site

#ifdef DEVELOPMENT
import           Snap.Loader.Devel
#else
import           Snap.Loader.Prod
#endif


{-|

This is the entry point for this web server application.  It supports
easily switching between interpreting source and running statically
compiled code.

In either mode, the generated program should be run from the root of
the project tree.  When it is run, it locates its templates, static
content, and source files in development mode, relative to the current
working directory.

When compiled with the development flag, only changes to the
libraries, your cabal file, or this file should require a recompile to
be picked up.  Everything else is interpreted at runtime.  There are a
few consequences of this.

First, this is much slower.  Running the interpreter takes a
significant chunk of time (a couple tenths of a second on the author's
machine, at this time), regardless of the simplicity of the loaded
code.  In order to recompile and re-load server state as infrequently
as possible, the source directories are watched for updates, as are
any extra directories specified below.

Second, the generated server binary is MUCH larger, since it links in
the GHC API (via the hint library).

Third, and the reason you would ever want to actually compile with
development mode, is that it enables a faster development cycle. You
can simply edit a file, save your changes, and hit reload to see your
changes reflected immediately.

When this is compiled without the development flag, all the actions
are statically compiled in.  This results in faster execution, a
smaller binary size, and having to recompile the server for any code
change.

-}
main :: IO ()
main = do
    -- depending on the version of loadSnapTH in scope, this either
    -- enables dynamic reloading, or compiles it without.  The last
    -- argument to loadSnapTH is a list of additional directories to
    -- watch for changes to trigger reloads in development mode.  It
    -- doesn't need to include source directories, those are picked up
    -- automatically by the splice.
    (conf, site, cleanup) <- $(loadSnapTH [| getConf |]
                                          'getActions
                                          ["resources/templates"])

    _ <- try $ httpServe conf $ site :: IO (Either SomeException ())
    cleanup


-- | This action loads the config used by this application.  The
-- loaded config is returned as the first element of the tuple
-- produced by the loadSnapTH Splice.  The type is not solidly fixed,
-- though it must be an IO action that produces the same type as
-- 'getActions' takes.  It also must be an instance of Typeable.  If
-- the type of this is changed, a full recompile will be needed to
-- pick up the change, even in development mode.
--
-- This action is only run once, regardless of whether development or
-- production mode is in use.
getConf :: IO (Config Snap ())
getConf = commandLineConfig defaultConfig


-- | This function generates the the site handler and cleanup action
-- from the configuration.  In production mode, this action is only
-- run once.  In development mode, this action is run whenever the
-- application is reloaded.
--
-- Development mode also makes sure that the cleanup actions are run
-- appropriately before shutdown.  The cleanup action returned from
-- loadSnapTH should still be used after the server has stopped
-- handling requests, as the cleanup actions are only automatically
-- run when a reload is triggered.
--
-- This sample doesn't actually use the config passed in, but more
-- sophisticated code might.
getActions :: Config Snap () -> IO (Snap (), IO ())
getActions _ = do
    (msgs, site, cleanup) <- runSnaplet app
    hPutStrLn stderr $ T.unpack msgs
    return (site, cleanup)