Phsu-0.1.0.0: src/Main.hs

{-# LANGUAGE DeriveDataTypeable, FlexibleContexts
  , GeneralizedNewtypeDeriving, MultiParamTypeClasses
  , OverloadedStrings, ScopedTypeVariables, TemplateHaskell
  , TypeFamilies, FlexibleInstances #-}

module Main (main) where
import BoilerplateDB (withAcid, runApp, App)
import Control.Monad        (msum)
import Control.Monad.Reader (ReaderT(..))
import Control.Monad.Trans  (MonadIO(..))
import Data.Acid (AcidState(..), EventState(..), EventResult(..), Query(..), QueryEvent(..), Update(..), UpdateEvent(..), IsAcidic(..), makeAcidic, openLocalState)
import Diffs (diffSettings, serveDiff)
import Happstack.Server (Response, ServerPartT(..), dir, nullConf, ok, simpleHTTP)
import Happstack.Server.Internal.Types (port)
import PassGen (servePassGen)
import Prelude hiding       (head, id)
import Search (serveSearch, editSearch)
import Template (template)
import Text.Blaze.Html5 (Html, (!), a, toHtml, toValue)
import Text.Blaze.Internal (AttributeValue)
import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as A

tv :: String -> AttributeValue
tv x = toValue x

th :: String -> Html
th x = toHtml x

homepage :: App Response
homepage = ok $ do
	template "homepage" $ do
		H.ul $ do
			H.li $ do
				H.a ! A.href (tv "/search?q=Something") $ "Search Something"
			H.li $ do
				H.a ! A.href (tv "/edit-search") $ "Search Settings"
			H.li $ do
				H.a ! A.href (tv "/password") $ "Generate Password"
			H.li $ do
				H.a ! A.href (tv "/diff-settings") $ "Diff Settings"
			H.li $ do
				H.a ! A.href (tv "/diff") $ "Diffs"

response :: App Response
response = msum
	[
		dir "search"		$ serveSearch,
		dir "edit-search"	$ editSearch,
		dir "password"		$ servePassGen,
		dir "diff-settings"	$ diffSettings,
		dir "diff"			$ serveDiff,
		homepage
	]

main :: IO ()
main =
    withAcid Nothing $ \acid ->
        simpleHTTP (nullConf{port = 9119}) $ runApp acid response