Home → Repo ^aoqmo → Commits → f60b238d85444b66d822d73ff1482f937bd8b28b

By	Chris Done
At	2013-03-01
Title	Remove Amelie stuff.
Description

Edit file src/Main.hs 33188 → 33188

	4	4	-- \| Main entry point.
	5	5
	6	6	module Main (main) where
	7	7
	8	8	import Hpaste.Config
-	9		import Hpaste.Controller
	10	9	import Hpaste.Controller.Activity as Activity
	11	10	import Hpaste.Controller.Browse as Browse
	12	11	import Hpaste.Controller.Cache (newCache)
	13	12	import Hpaste.Controller.Diff as Diff
	14	13	import Hpaste.Controller.Home as Home
…	…	…	…
	20	19	import Hpaste.Controller.Style as Style
	21	20	import Hpaste.Model.Announcer (newAnnouncer)
	22	21	import Hpaste.Types
	23	22	import Hpaste.Types.Cache
	24	23
+		24	import Snap.App.Controller
	25	25	import Snap.Core
	26	26	import Snap.Http.Server hiding (Config)
	27	27	import Snap.Util.FileServe
	28	28
	29	29	import Control.Concurrent.Chan (Chan)
…	…	…	…

Remove file src/Amelie/Config.hs 33188

-	1	{-# OPTIONS -Wall -fno-warn-missing-signatures -fno-warn-name-shadowing #-}
-	2
-	3	-- \| Load the configuration file.
-	4
-	5	module Amelie.Config
-	6	(getConfig)
-	7	where
-	8
-	9	import Amelie.Types.Config
-	10
-	11	import Data.ConfigFile
-	12	import Database.PostgreSQL.Simple (ConnectInfo(..))
-	13	import qualified Data.Text as T
-	14	import Network.Mail.Mime
-	15
-	16	getConfig :: FilePath -> IO Config
-	17	getConfig conf = do
-	18	contents <- readFile conf
-	19	let config = do
-	20	c <- readstring emptyCP contents
-	21	[user,pass,host,port]
-	22	<- mapM (get c "ANNOUNCE")
-	23	["user","pass","host","port"]
-	24	[pghost,pgport,pguser,pgpass,pgdb]
-	25	<- mapM (get c "POSTGRESQL")
-	26	["host","port","user","pass","db"]
-	27	[domain,cache]
-	28	<- mapM (get c "WEB")
-	29	["domain","cache"]
-	30	[commits,url]
-	31	<- mapM (get c "DEV")
-	32	["commits","repo_url"]
-	33	[prelude]
-	34	<- mapM (get c "STEPEVAL")
-	35	["prelude"]
-	36	[ircDir]
-	37	<- mapM (get c "IRC")
-	38	["log_dir"]
-	39	[admin,siteaddy]
-	40	<- mapM (get c "ADDRESSES")
-	41	["admin","site_addy"]
-	42
-	43	return Config {
-	44	configAnnounce = Announcer user pass host (read port)
-	45	, configPostgres = ConnectInfo pghost (read pgport) pguser pgpass pgdb
-	46	, configDomain = domain
-	47	, configCommits = commits
-	48	, configRepoURL = url
-	49	, configStepevalPrelude = prelude
-	50	, configIrcDir = ircDir
-	51	, configAdmin = Address Nothing (T.pack admin)
-	52	, configSiteAddy = Address Nothing (T.pack siteaddy)
-	53	, configCacheDir = cache
-	54	}
-	55	case config of
-	56	Left cperr -> error $ show cperr
-	57	Right config -> return config

Remove file src/Amelie/Controller.hs 33188

-	1	{-# LANGUAGE BangPatterns #-}
-	2	{-# OPTIONS -Wall #-}
-	3	{-# LANGUAGE OverloadedStrings #-}
-	4
-	5	-- \| Controller routing/handling.
-	6
-	7	module Amelie.Controller
-	8	(runHandler
-	9	,output
-	10	,outputText
-	11	,goHome
-	12	,justOrGoHome
-	13	,getInteger
-	14	,getString
-	15	,getStringMaybe
-	16	,getPagination
-	17	,getMyURI)
-	18	where
-	19
-	20	import Amelie.Types
-	21	import Amelie.Types.Cache
-	22
-	23	import Control.Applicative
-	24	import Control.Concurrent.Chan (Chan)
-	25	import Control.Monad.Env
-	26	import Control.Monad.Reader (runReaderT)
-	27	import Data.ByteString (ByteString)
-	28	import Data.ByteString.UTF8 (toString)
-	29	import Data.Maybe
-	30	import Network.URI
-	31	import Data.Text.Lazy (Text,toStrict)
-	32	import Database.PostgreSQL.Base (withPoolConnection)
-	33	import Database.PostgreSQL.Simple (Pool)
-	34	import Safe (readMay)
-	35	import Snap.Core
-	36	import Text.Blaze (Html)
-	37	import Text.Blaze.Renderer.Text (renderHtml)
-	38
-	39	-- \| Run a controller handler.
-	40	runHandler :: Config -> Pool -> Cache -> Chan Text -> Controller () -> Snap ()
-	41	runHandler conf pool cache anns ctrl = do
-	42	withPoolConnection pool $ \conn -> do
-	43	let state = ControllerState conf conn cache anns
-	44	-- Default to HTML, can be overridden.
-	45	modifyResponse $ setContentType "text/html"
-	46	runReaderT (runController ctrl) state
-	47
-	48	-- \| Strictly renders HTML to Text before outputting it via Snap.
-	49	-- This ensures that any lazy exceptions are caught by the Snap
-	50	-- handler.
-	51	output :: Html -> Controller ()
-	52	output html = outputText $ renderHtml $ html
-	53
-	54	-- \| Strictly renders text before outputting it via Snap.
-	55	-- This ensures that any lazy exceptions are caught by the Snap
-	56	-- handler.
-	57	outputText :: Text -> Controller ()
-	58	outputText text = do
-	59	let !x = toStrict $ text
-	60	writeText x
-	61
-	62	-- \| Generic redirect to home page.
-	63	goHome :: Controller ()
-	64	goHome = redirect "/"
-	65
-	66	-- \| Extract a Just value or go home.
-	67	justOrGoHome :: Maybe a -> (a -> Controller ()) -> Controller ()
-	68	justOrGoHome x m = maybe goHome m x
-	69
-	70	-- \| Get integer parmater.
-	71	getInteger :: ByteString -> Integer -> Controller Integer
-	72	getInteger name def = do
-	73	pid <- (>>= readMay . toString) <$> getParam name
-	74	maybe (return def) return pid
-	75
-	76	-- \| Get string.
-	77	getString :: ByteString -> String -> Controller String
-	78	getString name def = do
-	79	pid <- (>>= return . toString) <$> getParam name
-	80	maybe (return def) return pid
-	81
-	82	-- \| Get string (maybe).
-	83	getStringMaybe :: ByteString -> Controller (Maybe String)
-	84	getStringMaybe name = do
-	85	pid <- (>>= return . toString) <$> getParam name
-	86	return pid
-	87
-	88	-- \| Get pagination data.
-	89	getPagination :: Controller Pagination
-	90	getPagination = do
-	91	p <- getInteger "page" 1
-	92	limit <- getInteger "limit" 35
-	93	i <- fmap rqURI getRequest
-	94	uri <- getMyURI
-	95	return Pagination { pnPage = max 1 p
-	96	, pnLimit = max 1 (min 100 limit)
-	97	, pnURI = uri
-	98	, pnResults = 0
-	99	, pnTotal = 0
-	100	}
-	101
-	102	getMyURI :: Controller URI
-	103	getMyURI = do
-	104	domain <- env (configDomain . controllerStateConfig)
-	105	fmap (fromJust .
-	106	parseURI .
-	107	(("http://" ++ domain) ++) .
-	108	toString .
-	109	rqURI)
-	110	getRequest

Remove file src/Amelie/Model.hs 33188

-	1	{-# OPTIONS -Wall #-}
-	2	{-# LANGUAGE OverloadedStrings #-}
-	3	{-# LANGUAGE FlexibleContexts #-}
-	4
-	5	-- \| Model running.
-	6
-	7	module Amelie.Model
-	8	(model
-	9	,query
-	10	,single
-	11	,singleNoParams
-	12	,queryNoParams
-	13	,exec
-	14	,module Amelie.Types
-	15	,DB.Only(..))
-	16	where
-	17
-	18	import Amelie.Types
-	19
-	20	import Control.Monad.Env (env)
-	21	import Control.Monad.IO (io)
-	22	import Control.Monad.Reader
-	23	import Data.String
-	24	import Database.PostgreSQL.Simple (Only(..))
-	25	import qualified Database.PostgreSQL.Simple as DB
-	26	import Database.PostgreSQL.Simple.QueryParams
-	27	import Database.PostgreSQL.Simple.QueryResults
-	28
-	29	-- \| Run a model action.
-	30	model :: Model a -> Controller a
-	31	model action = do
-	32	conn <- env controllerStateConn
-	33	anns <- env controllerStateAnns
-	34	conf <- env controllerStateConfig
-	35	let state = ModelState conn anns conf
-	36	io $ runReaderT (runModel action) state
-	37
-	38	-- \| Query with some parameters.
-	39	query :: (QueryParams ps,QueryResults r) => [String] -> ps -> Model [r]
-	40	query q ps = do
-	41	conn <- env modelStateConn
-	42	Model $ ReaderT (\_ -> DB.query conn (fromString (unlines q)) ps)
-	43
-	44	-- \| Query a single field from a single result.
-	45	single :: (QueryParams ps,QueryResults (Only r)) => [String] -> ps -> Model (Maybe r)
-	46	single q ps = do
-	47	rows <- query q ps
-	48	case rows of
-	49	[(Only r)] -> return (Just r)
-	50	_ -> return Nothing
-	51
-	52	-- \| Query a single field from a single result (no params).
-	53	singleNoParams :: (QueryResults (Only r)) => [String] -> Model (Maybe r)
-	54	singleNoParams q = do
-	55	rows <- queryNoParams q
-	56	case rows of
-	57	[(Only r)] -> return (Just r)
-	58	_ -> return Nothing
-	59
-	60	-- \| Query with no parameters.
-	61	queryNoParams :: (QueryResults r) => [String] -> Model [r]
-	62	queryNoParams q = do
-	63	conn <- env modelStateConn
-	64	Model $ ReaderT (\_ -> DB.query_ conn (fromString (unlines q)))
-	65
-	66	-- \| Execute some SQL returning the rows affected.
-	67	exec :: (QueryParams ps) => [String] -> ps -> Model Integer
-	68	exec q ps = do
-	69	conn <- env modelStateConn
-	70	Model $ ReaderT (\_ -> DB.execute conn (fromString (unlines q)) ps)

Remove file src/Amelie/Types.hs 33188

-	1	{-# OPTIONS -Wall #-}
-	2
-	3	-- \| All types.
-	4
-	5	module Amelie.Types
-	6	(module Amelie.Types.MVC
-	7	,module Amelie.Types.Paste
-	8	,module Amelie.Types.Channel
-	9	,module Amelie.Types.Language
-	10	,module Amelie.Types.Page
-	11	,module Amelie.Types.Newtypes
-	12	,module Amelie.Types.View
-	13	,module Amelie.Types.Config
-	14	,module Amelie.Types.Activity
-	15	,module Amelie.Types.Stepeval
-	16	,module Amelie.Types.Report)
-	17	where
-	18
-	19	import Amelie.Types.MVC
-	20	import Amelie.Types.Paste
-	21	import Amelie.Types.Channel
-	22	import Amelie.Types.Language
-	23	import Amelie.Types.Page
-	24	import Amelie.Types.Newtypes
-	25	import Amelie.Types.View
-	26	import Amelie.Types.Config
-	27	import Amelie.Types.Activity
-	28	import Amelie.Types.Stepeval
-	29	import Amelie.Types.Report

Remove file src/Amelie/View/Activity.hs 33188

-	1	{-# OPTIONS -Wall -fno-warn-name-shadowing -fno-warn-unused-do-bind #-}
-	2	{-# LANGUAGE OverloadedStrings #-}
-	3	{-# LANGUAGE RecordWildCards #-}
-	4
-	5	-- \| Activity page view.
-	6
-	7	module Amelie.View.Activity
-	8	(page)
-	9	where
-	10
-	11	import Amelie.Types
-	12	import Amelie.View.Html
-	13	import Amelie.View.Layout
-	14
-	15	import Control.Monad
-	16	import Data.Text (Text)
-	17	import Prelude hiding ((++))
-	18	import Text.Blaze.Html5 as H hiding (map)
-	19
-	20	-- \| Render the activity page.
-	21	page :: String -> [Commit] -> Html
-	22	page repo commits =
-	23	layoutPage $ Page {
-	24	pageTitle = "Development activity"
-	25	, pageBody = activity repo commits
-	26	, pageName = "activity"
-	27	}
-	28
-	29	-- \| View the paginated pastes.
-	30	activity :: String -> [Commit] -> Html
-	31	activity repo commits = do
-	32	darkSection "Development activity" $ do
-	33	p $ do "Repository: "
-	34	href repo repo
-	35	forM_ commits $ \Commit{..} -> do
-	36	lightSection commitTitle $ do
-	37	p $ toHtml $ show commitDate
-	38	p $ href commitLink ("Go to diff" :: Text)

Remove file src/Amelie/View/Annotate.hs 33188

-	1	{-# OPTIONS -Wall -fno-warn-name-shadowing #-}
-	2	{-# LANGUAGE OverloadedStrings #-}
-	3	{-# LANGUAGE RecordWildCards #-}
-	4
-	5	-- \| Annotate paste view.
-	6
-	7	module Amelie.View.Annotate
-	8	(page)
-	9	where
-	10
-	11	import Amelie.Types
-	12	import Amelie.View.Html
-	13	import Amelie.View.Layout
-	14
-	15	import Data.Monoid.Operator ((++))
-	16	import Prelude hiding ((++))
-	17	import Text.Blaze.Html5 as H hiding (map)
-	18	import Data.Text.Lazy
-	19
-	20	-- \| Render the create annotate paste page.
-	21	page :: Paste -> Html -> Html
-	22	page Paste{..} form =
-	23	layoutPage $ Page {
-	24	pageTitle = "Annotate: " ++ pasteTitle
-	25	, pageBody = lightSection ("Annotate: " ++ fromStrict pasteTitle) form
-	26	, pageName = "annotate"
-	27	}

Remove file src/Amelie/View/Browse.hs 33188

-	1	{-# OPTIONS -Wall -fno-warn-name-shadowing #-}
-	2	{-# LANGUAGE OverloadedStrings #-}
-	3	{-# LANGUAGE RecordWildCards #-}
-	4
-	5	-- \| Browse page view.
-	6
-	7	module Amelie.View.Browse
-	8	(page)
-	9	where
-	10
-	11	import Amelie.Types
-	12	import Amelie.View.Html
-	13	import Amelie.View.Layout
-	14	import Amelie.View.Paste (pasteLink)
-	15	import Amelie.Model.Paste (validNick)
-	16
-	17	import Control.Monad
-	18	import Data.Maybe
-	19	import Data.Time.Show (showDateTime)
-	20	import Prelude hiding ((++))
-	21	import Data.Monoid.Operator
-	22	import Text.Blaze.Html5 as H hiding (map)
-	23	import qualified Data.Text as T
-	24	import qualified Data.Text.Lazy as LT
-	25	import Text.Blaze.Extra
-	26	import Network.URI.Params
-	27
-	28	-- \| Render the browse page.
-	29	page :: Pagination -> [Channel] -> [Language] -> [Paste] -> Maybe String -> Html
-	30	page pn chans langs ps mauthor =
-	31	layoutPage $ Page {
-	32	pageTitle = "Browse pastes"
-	33	, pageBody = browse pn chans langs ps mauthor
-	34	, pageName = "browse"
-	35	}
-	36
-	37	-- \| View the paginated pastes.
-	38	browse :: Pagination -> [Channel] -> [Language] -> [Paste] -> Maybe String -> Html
-	39	browse pn channels languages ps mauthor = do
-	40	darkSection title $ do
-	41	paginate pn $ do
-	42	table ! aClass "latest-pastes" $ do
-	43	tr $ mapM_ (th . (toHtml :: String -> Html)) $
-	44	["Title"] ++ ["Author"\|isNothing mauthor] ++ ["When","Language","Channel"]
-	45	pastes ps
-	46
-	47	where pastes = mapM_ $ \paste@Paste{..} -> tr $ do
-	48	td $ pasteLink paste pasteTitle
-	49	unless (isJust mauthor) $
-	50	td $ do
-	51	let author = T.unpack pasteAuthor
-	52	if True -- validNick author
-	53	then a ! hrefURI (authorUri author) $ toHtml pasteAuthor
-	54	else toHtml pasteAuthor
-	55	td $ toHtml $ showDateTime $ pasteDate
-	56	td $ showLanguage languages pasteLanguage
-	57	td $ showChannel channels pasteChannel
-	58	authorUri author = updateUrlParam "author" author
-	59	$ updateUrlParam "page" "0"
-	60	$ pnURI pn
-	61	title = LT.pack $ case mauthor of
-	62	Just author -> "Pastes by " ++ author
-	63	Nothing -> "Latest pastes"

Remove file src/Amelie/View/Diff.hs 33188

-	1	{-# OPTIONS -Wall -fno-warn-name-shadowing -fno-warn-unused-do-bind #-}
-	2	{-# LANGUAGE OverloadedStrings #-}
-	3	{-# LANGUAGE RecordWildCards #-}
-	4
-	5	-- \| Diff page view.
-	6
-	7	module Amelie.View.Diff
-	8	(page)
-	9	where
-	10
-	11	import Amelie.Types
-	12	import Amelie.View.Html
-	13	import Amelie.View.Layout
-	14	import Amelie.View.Paste (pasteLink)
-	15
-	16	import Control.Monad
-	17	import Data.Algorithm.Diff
-	18	import Data.Monoid.Operator ((++))
-	19	import qualified Data.Text as T
-	20	import Data.Text.Lazy (pack)
-	21	import Prelude hiding ((++))
-	22	import Text.Blaze.Html5 as H hiding (map)
-	23
-	24	-- \| Render the diff page.
-	25	page :: Paste -> Paste -> Html
-	26	page this that =
-	27	layoutPage $ Page {
-	28	pageTitle = "Diff two pastes"
-	29	, pageBody = diffBody this that
-	30	, pageName = "diff"
-	31	}
-	32
-	33	-- \| View the diff between the two pastes.
-	34	diffBody :: Paste -> Paste -> Html
-	35	diffBody this that = do
-	36	darkSection ("Diff: " ++ pid1 ++ " / " ++ pid2) $ do
-	37	pasteMention this pid1
-	38	pasteMention that pid2
-	39	lightNoTitleSection $ do
-	40	viewDiff this that
-	41
-	42	where pasteMention paste pid = p $ do
-	43	pasteLink paste pid
-	44	": "
-	45	toHtml $ pasteTitle paste
-	46	pid1 = pack (show (pasteId this))
-	47	pid2 = pack (show (pasteId that))
-	48
-	49	-- \| View the diff between the two pastes.
-	50	viewDiff :: Paste -> Paste -> Html
-	51	viewDiff this that = do
-	52	H.table ! aClass "code" $
-	53	td $
-	54	pre $ do
-	55	forM_ groups $ \(indicator,lines) -> do
-	56	let (ind,prefix) =
-	57	case indicator of
-	58	B -> ("diff-both"," ")
-	59	F -> ("diff-first","- ")
-	60	S -> ("diff-second","+ ")
-	61	lins = map (prefix++) lines
-	62	H.div ! aClass ind $ toHtml $ T.unlines $ lins
-	63
-	64	where groups = getGroupedDiff lines1 lines2
-	65	lines1 = T.lines (pastePaste this)
-	66	lines2 = T.lines (pastePaste that)

Remove file src/Amelie/View/Edit.hs 33188

-	1	{-# OPTIONS -Wall -fno-warn-name-shadowing #-}
-	2	{-# LANGUAGE OverloadedStrings #-}
-	3	{-# LANGUAGE RecordWildCards #-}
-	4
-	5	-- \| Edit paste view.
-	6
-	7	module Amelie.View.Edit
-	8	(page)
-	9	where
-	10
-	11	import Amelie.Types
-	12	import Amelie.View.Html
-	13	import Amelie.View.Layout
-	14
-	15	import Data.Monoid.Operator ((++))
-	16	import Prelude hiding ((++))
-	17	import Text.Blaze.Html5 as H hiding (map)
-	18	import Data.Text.Lazy
-	19
-	20	-- \| Render the create edit paste page.
-	21	page :: Paste -> Html -> Html
-	22	page Paste{..} form =
-	23	layoutPage $ Page {
-	24	pageTitle = "Edit: " ++ pasteTitle
-	25	, pageBody = lightSection ("Edit: " ++ fromStrict pasteTitle) form
-	26	, pageName = "edit"
-	27	}

Remove file src/Amelie/View/Highlight.hs 33188

-	1	{-# OPTIONS -Wall -fno-warn-name-shadowing #-}
-	2	{-# LANGUAGE OverloadedStrings #-}
-	3	{-# LANGUAGE RecordWildCards #-}
-	4	{-# LANGUAGE NamedFieldPuns #-}
-	5
-	6	-- \| Code highlighting.
-	7
-	8	module Amelie.View.Highlight
-	9	(highlightPaste
-	10	,highlightHaskell)
-	11	where
-	12
-	13	import Amelie.Types
-	14	import Amelie.View.Html
-	15
-	16	import Control.Monad
-	17	import Data.List (find)
-	18	import Data.Monoid.Operator
-	19	import Data.Text (Text,unpack,pack)
-	20	import qualified Data.Text as T
-	21	import Language.Haskell.HsColour.CSS (hscolour)
-	22	import Prelude hiding ((++))
-	23	import Text.Blaze.Html5 as H hiding (map)
-	24	import qualified Text.Blaze.Html5.Attributes as A
-	25
-	26	-- \| Syntax highlight the paste.
-	27	highlightPaste :: [Language] -> Paste -> Html
-	28	highlightPaste langs Paste{..} =
-	29	H.table ! aClass "code" $ do
-	30	td ! aClass "line-nums" $ do
-	31	pre $
-	32	forM_ [1..length (T.lines pastePaste)] $ \i -> do
-	33	let name = "line" ++ pack (show i)
-	34	href ("#" ++ name) (toHtml i) ! A.id (toValue name) ! A.name (toValue name)
-	35	"\n"
-	36	td $
-	37	case lang of
-	38	Just (Language{languageName})
-	39	\| elem languageName ["haskell","agda","idris"] ->
-	40	preEscapedString $ hscolour False (unpack pastePaste)
-	41	Just (Language{..}) ->
-	42	pre $ code ! A.class_ (toValue $ "language-" ++ languageName) $
-	43	toHtml pastePaste
-	44	_ ->
-	45	pre $ toHtml pastePaste
-	46
-	47	where lang = find ((==pasteLanguage) . Just . languageId) langs
-	48
-	49	highlightHaskell :: Text -> Html
-	50	highlightHaskell paste =
-	51	H.table ! aClass "code" $
-	52	td $ preEscapedString $ hscolour False (unpack paste)

Remove file src/Amelie/View/Hlint.hs 33188

-	1	{-# OPTIONS -Wall -fno-warn-name-shadowing #-}
-	2	{-# LANGUAGE OverloadedStrings #-}
-	3	{-# LANGUAGE RecordWildCards #-}
-	4
-	5	-- \| Show hlint suggestions.
-	6
-	7	module Amelie.View.Hlint
-	8	(viewHints
-	9	,viewSuggestions)
-	10	where
-	11
-	12	import Amelie.Types
-	13	import Amelie.View.Html
-	14
-	15	import Data.List (intersperse)
-	16	import Language.Haskell.HLint
-	17	import Prelude hiding ((++))
-	18	import Text.Blaze.Html5 as H hiding (map)
-	19
-	20	-- \| Show hlint hints for a Haskell paste.
-	21	viewHints :: [Hint] -> Html
-	22	viewHints = mapM_ showHint where
-	23	showHint hint =
-	24	section $
-	25	pre ! aClass "hint" $ sequence_ $ intersperse br $ map toHtml lns
-	26	where section = case hintType hint of
-	27	Ignore -> \_ -> return ()
-	28	Warning -> warnNoTitleSection
-	29	Error -> errorNoTitleSection
-	30	lns = lines $ clean $ hintContent hint
-	31	clean = dropWhile (==':') . dropWhile (/=':')
-	32
-	33	viewSuggestions :: [Suggestion] -> Html
-	34	viewSuggestions = viewHints . map toHint where
-	35	toHint s = Hint (suggestionSeverity s)
-	36	(show s)

Remove file src/Amelie/View/Home.hs 33188

-	1	{-# OPTIONS -Wall -fno-warn-name-shadowing #-}
-	2	{-# LANGUAGE OverloadedStrings #-}
-	3	{-# LANGUAGE RecordWildCards #-}
-	4
-	5	-- \| Home page view.
-	6
-	7	module Amelie.View.Home
-	8	(page)
-	9	where
-	10
-	11	import Amelie.Types
-	12	import Amelie.View.Html
-	13	import Amelie.View.Layout
-	14	import Amelie.View.Paste (pasteLink)
-	15	import Amelie.Model.Paste (validNick)
-	16
-	17	import Data.Text (Text)
-	18	import Data.Time.Show (showDateTime)
-	19	import Prelude hiding ((++))
-	20	import Text.Blaze.Html5 as H hiding (map)
-	21	import qualified Data.Text as T
-	22	import Text.Blaze.Extra
-	23	import Network.URI.Params
-	24	import Network.URI
-	25
-	26	-- \| Render the home page.
-	27	page :: URI -> [Channel] -> [Language] -> [Paste] -> Html -> Html
-	28	page uri chans langs ps form =
-	29	layoutPage $ Page {
-	30	pageTitle = "Recent pastes"
-	31	, pageBody = content uri chans langs ps form
-	32	, pageName = "home"
-	33	}
-	34
-	35	-- \| Render the home page body.
-	36	content :: URI -> [Channel] -> [Language] -> [Paste] -> Html -> Html
-	37	content uri chans langs ps form = do
-	38	createNew form
-	39	latest uri chans langs ps
-	40
-	41	-- \| Create a new paste section.
-	42	createNew :: Html -> Html
-	43	createNew = lightSection "Create new paste"
-	44
-	45	-- \| View the latest pastes.
-	46	latest :: URI -> [Channel] -> [Language] -> [Paste] -> Html
-	47	latest uri channels languages ps = do
-	48	darkSection "Latest pastes" $ do
-	49	table ! aClass "latest-pastes" $ do
-	50	tr $ mapM_ (th . toHtml) $ words "Title Author When Language Channel"
-	51	pastes ps
-	52	p ! aClass "browse-link" $ browse
-	53
-	54	where pastes = mapM_ $ \paste@Paste{..} -> tr $ do
-	55	td $ pasteLink paste pasteTitle
-	56	td $ do
-	57	let author = T.unpack pasteAuthor
-	58	if True -- validNick author
-	59	then a ! hrefURI (authorUri author) $ toHtml pasteAuthor
-	60	else toHtml pasteAuthor
-	61	td $ toHtml $ showDateTime $ pasteDate
-	62	td $ showLanguage languages pasteLanguage
-	63	td $ showChannel channels pasteChannel
-	64	authorUri author = updateUrlParam "author" author
-	65	$ updateUrlParam "page" "0"
-	66	$ uri { uriPath = "/browse" }
-	67
-	68	-- \| Browse link.
-	69	browse :: Html
-	70	browse = href ("/browse" :: Text) ("Browse all pastes" :: Text)

Remove file src/Amelie/View/Html.hs 33188

-	1	{-# OPTIONS -Wall -fno-warn-name-shadowing #-}
-	2	{-# LANGUAGE OverloadedStrings #-}
-	3	{-# LANGUAGE RecordWildCards #-}
-	4
-	5	-- \| HTML-specific view functions.
-	6
-	7	module Amelie.View.Html
-	8	(aClass
-	9	,aClasses
-	10	,darkSection
-	11	,darkNoTitleSection
-	12	,lightSection
-	13	,lightNoTitleSection
-	14	,warnNoTitleSection
-	15	,errorNoTitleSection
-	16	,href
-	17	,clear
-	18	,showLanguage
-	19	,showChannel
-	20	,paginate)
-	21	where
-	22
-	23	import Amelie.Types
-	24
-	25	import Control.Arrow ((&&&))
-	26	import Control.Monad (when)
-	27	import Data.Maybe (fromMaybe)
-	28	import Data.Monoid.Operator ((++))
-	29	import Data.Text (pack)
-	30	import Data.Text.Lazy (Text)
-	31	import qualified Data.Text.Lazy as T
-	32	import Network.URI.Params
-	33	import Prelude hiding ((++))
-	34	import Text.Blaze.Html5 as H hiding (map,nav)
-	35	import qualified Text.Blaze.Html5.Attributes as A
-	36	import Text.Blaze.Extra
-	37
-	38	-- \| A class prefixed with amelie-.
-	39	aClass :: AttributeValue -> Attribute
-	40	aClass name = A.class_ ("amelie-" ++ name)
-	41
-	42	-- \| A class prefixed with amelie-.
-	43	aClasses :: [Text] -> Attribute
-	44	aClasses names = A.class_ $
-	45	toValue $ T.intercalate " " $ map ("amelie-" ++) names
-	46
-	47	-- \| A warning section.
-	48	warnNoTitleSection :: Html -> Html
-	49	warnNoTitleSection inner =
-	50	H.div ! aClasses ["section","section-warn"] $ do
-	51	inner
-	52
-	53	-- \| An error section.
-	54	errorNoTitleSection :: Html -> Html
-	55	errorNoTitleSection inner =
-	56	H.div ! aClasses ["section","section-error"] $ do
-	57	inner
-	58
-	59	-- \| A dark section.
-	60	darkSection :: Text -> Html -> Html
-	61	darkSection title inner =
-	62	H.div ! aClasses ["section","section-dark"] $ do
-	63	h2 $ toHtml title
-	64	inner
-	65
-	66	-- \| A dark section.
-	67	darkNoTitleSection :: Html -> Html
-	68	darkNoTitleSection inner =
-	69	H.div ! aClasses ["section","section-dark"] $ do
-	70	inner
-	71
-	72	-- \| A light section.
-	73	lightSection :: Text -> Html -> Html
-	74	lightSection title inner =
-	75	H.div ! aClasses ["section","section-light"] $ do
-	76	h2 $ toHtml title
-	77	inner
-	78
-	79	-- \| A light section with no title.
-	80	lightNoTitleSection :: Html -> Html
-	81	lightNoTitleSection inner =
-	82	H.div ! aClasses ["section","section-light"] $ do
-	83	inner
-	84
-	85	-- \| An anchor link.
-	86	href :: (ToValue location,ToHtml html) => location -> html -> Html
-	87	href loc content = H.a ! A.href (toValue loc) $ toHtml content
-	88
-	89	-- \| A clear:both element.
-	90	clear :: Html
-	91	clear = H.div ! aClass "clear" $ return ()
-	92
-	93	-- \| Show a language.
-	94	showLanguage :: [Language] -> Maybe LanguageId -> Html
-	95	showLanguage languages lid =
-	96	toHtml $ fromMaybe "-" (lid >>= (`lookup` langs))
-	97
-	98	where langs = map (languageId &&& languageTitle) languages
-	99
-	100	-- \| Show a channel.
-	101	showChannel :: [Channel] -> Maybe ChannelId -> Html
-	102	showChannel channels lid =
-	103	toHtml $ fromMaybe "-" (lid >>= (`lookup` langs))
-	104
-	105	where langs = map (channelId &&& channelName) channels
-	106
-	107	-- \| Render results with pagination.
-	108	paginate :: Pagination -> Html -> Html
-	109	paginate pn inner = do
-	110	nav pn True
-	111	inner
-	112	nav pn False
-	113
-	114	-- \| Show a pagination navigation, with results count, if requested.
-	115	nav :: Pagination -> Bool -> Html
-	116	nav pn@Pagination{..} showTotal = do
-	117	H.div ! aClass "pagination" $ do
-	118	H.div ! aClass "inner" $ do
-	119	when (pnPage-1 > 0) $ navDirection pn (-1) "Previous"
-	120	toHtml (" " :: Text)
-	121	when (pnResults == pnLimit) $ navDirection pn 1 "Next"
-	122	when showTotal $ do
-	123	br
-	124	toHtml $ results
-	125
-	126	where results = unwords [show start ++ "—" ++ show end
-	127	,"results of"
-	128	,show pnTotal]
-	129	start = 1 + (pnPage - 1) * pnResults
-	130	end = pnPage * pnResults
-	131
-	132	-- \| Link to change navigation page based on a direction.
-	133	navDirection :: Pagination -> Integer -> Text -> Html
-	134	navDirection Pagination{..} change caption = do
-	135	a ! hrefURI uri $ toHtml caption
-	136
-	137	where uri = updateUrlParam "page"
-	138	(show (pnPage + change))
-	139	pnURI
-	140

Remove file src/Amelie/View/Irclogs.hs 33188

-	1	{-# OPTIONS -Wall -fno-warn-name-shadowing -fno-warn-unused-do-bind #-}
-	2	{-# LANGUAGE OverloadedStrings #-}
-	3	{-# LANGUAGE RecordWildCards #-}
-	4
-	5	-- \| Irclogs page view.
-	6
-	7	module Amelie.View.Irclogs
-	8	(page)
-	9	where
-	10
-	11	import Amelie.Types
-	12	import Amelie.View.Html
-	13	import Amelie.View.Layout
-	14
-	15	import Control.Monad
-	16	import Data.Char
-	17	import Data.Maybe
-	18	import Data.Monoid.Operator ((++))
-	19	import Data.String
-	20	import Data.Text (Text)
-	21	import qualified Data.Text as T
-	22	import Prelude hiding ((++))
-	23	import Text.Blaze.Extra
-	24	import Text.Blaze.Html5 as H hiding (map)
-	25	import qualified Text.Blaze.Html5.Attributes as A
-	26
-	27	-- \| Render the irclogs page.
-	28	page :: String -> String -> String -> Either String [Text] -> Maybe Integer -> Html
-	29	page channel date time entries pid =
-	30	layoutPage $ Page {
-	31	pageTitle = "Development irclogs"
-	32	, pageBody = irclogs pid channel entries
-	33	, pageName = "irclogs"
-	34	}
-	35
-	36	-- \| View the paginated pastes.
-	37	irclogs :: Maybe Integer -> String -> Either String [Text] -> Html
-	38	irclogs pid channel entries = do
-	39	darkSection "IRC logs" $ do
-	40	p $ do "Channel: #"; toHtml channel
-	41	lightSection (fromString ("#" ++ channel)) $ do
-	42	case entries of
-	43	Left error -> do "Unable to get logs for this channel and date: "
-	44	toHtml error
-	45	Right entries ->
-	46	ul !. "amelie-irc-entries" $
-	47	forM_ entries $ \entry -> do
-	48	let date = toValue $ parseDate entry
-	49	url = "http://hpaste.org/" ++ maybe "0" (T.pack . show) pid
-	50	currentline \| T.isSuffixOf url entry = "current"
-	51	\| otherwise = ""
-	52	li !. (toValue (currentline :: Text)) $ do
-	53	a ! A.name date ! A.id date $ return ()
-	54	toHtml entry
-	55
-	56	where parseDate = T.replace ":" "-" . T.takeWhile (not.isSpace)

Remove file src/Amelie/View/Layout.hs 33188

-	1	{-# OPTIONS -Wall #-}
-	2	{-# LANGUAGE OverloadedStrings #-}
-	3	{-# LANGUAGE RecordWildCards #-}
-	4
-	5	-- \| Page layout.
-	6
-	7	module Amelie.View.Layout
-	8	(layoutPage)
-	9	where
-	10
-	11	import Amelie.Types
-	12	import Amelie.View.Html
-	13
-	14	import Data.Monoid.Operator ((++))
-	15	import Prelude hiding ((++))
-	16	import Text.Blaze.Html5 as H hiding (map,nav)
-	17	import qualified Text.Blaze.Html5.Attributes as A
-	18
-	19	-- \| Render the page in a layout.
-	20	layoutPage :: Page -> Html
-	21	layoutPage Page{..} = do
-	22	docTypeHtml $ do
-	23	H.head $ do
-	24	meta ! A.httpEquiv "Content-Type" ! A.content "text/html; charset=UTF-8"
-	25	link ! A.rel "stylesheet" ! A.type_ "text/css" ! A.href "/css/amelie.css"
-	26	js "jquery.js"
-	27	js "amelie.js"
-	28	js "highlight.pack.js"
-	29	title $ toHtml $ pageTitle ++ " :: hpaste — Haskell Pastebin"
-	30	script $
-	31	"hljs.tabReplace = ' ';hljs.initHighlightingOnLoad();"
-	32	body ! A.id (toValue pageName) $ do
-	33	wrap $ do
-	34	nav
-	35	logo
-	36	pageBody
-	37	foot
-	38	preEscapedText "<script type=\"text/javascript\"> var _gaq = _gaq \
-	39	\\|\| []; _gaq.push(['_setAccount', 'UA-7443395-10']);\
-	40	\ _gaq.push(['_trackPageview']); (function() {var ga\
-	41	\ = document.createElement('script'); ga.type = 'tex\
-	42	\t/javascript'; ga.async = true; ga.src = ('https:' \
-	43	\== document.location.protocol ? 'https://ssl' : \
-	44	\'http://www') + '.google-analytics.com/ga.js'; var\
-	45	\ s = document.getElementsByTagName('script')[0]; \
-	46	\s.parentNode.insertBefore(ga, s);})(); </script>"
-	47
-	48	where js s = script ! A.type_ "text/javascript"
-	49	! A.src ("/js/" ++ s) $
-	50	return ()
-	51
-	52	-- \| Show the hpaste logo.
-	53	logo :: Html
-	54	logo = do
-	55	a ! aClass "logo" ! A.href "/" ! A.title "Back to home" $ do
-	56	"hpaste"
-	57
-	58	-- \| Layout wrapper.
-	59	wrap :: Html -> Html
-	60	wrap x = H.div ! aClass "wrap" $ x
-	61
-	62	-- \| Navigation.
-	63	nav :: Html
-	64	nav = do
-	65	H.div ! aClass "nav" $ do
-	66	a ! A.href "mailto:chrisdone@gmail.com" $ "Contact/support"
-	67	" \| "
-	68	a ! A.href "/activity" $ "Changelog"
-	69
-	70	-- \| Page footer.
-	71	foot :: Html
-	72	foot = H.div ! aClass "footer" $ p $
-	73	lnk "http://github.com/chrisdone/hpaste" "Web site source code on Github"
-	74	//
-	75	lnk "http://book.realworldhaskell.org/" "Real World Haskell"
-	76	//
-	77	lnk "http://haskell.org/" "Haskell.org"
-	78	//
-	79	lnk "http://planet.haskell.org/" "Planet Haskell"
-	80
-	81	where lnk url t = href (url :: String) (t :: String)
-	82	left // right = do _ <- left; (" / " :: Html); right

Remove file src/Amelie/View/New.hs 33188

-	1	{-# OPTIONS -Wall -fno-warn-name-shadowing #-}
-	2	{-# LANGUAGE OverloadedStrings #-}
-	3	{-# LANGUAGE RecordWildCards #-}
-	4
-	5	-- \| Create new paste view.
-	6
-	7	module Amelie.View.New
-	8	(page)
-	9	where
-	10
-	11	import Amelie.Types
-	12	import Amelie.View.Html
-	13	import Amelie.View.Layout
-	14
-	15	import Prelude hiding ((++))
-	16	import Text.Blaze.Html5 as H hiding (map)
-	17
-	18	-- \| Render the create new paste page.
-	19	page :: Html -> Html
-	20	page form =
-	21	layoutPage $ Page {
-	22	pageTitle = "Create new paste"
-	23	, pageBody = lightSection "Create new paste" form
-	24	, pageName = "new"
-	25	}

Remove file src/Amelie/View/Paste.hs 33188

-	1	{-# OPTIONS -Wall -fno-warn-name-shadowing -fno-warn-unused-do-bind #-}
-	2	{-# LANGUAGE OverloadedStrings #-}
-	3	{-# LANGUAGE RecordWildCards #-}
-	4
-	5	-- \| Paste views.
-	6
-	7	module Amelie.View.Paste
-	8	(pasteFormlet
-	9	,page
-	10	,pasteLink
-	11	,pasteRawLink)
-	12	where
-	13
-	14	import Amelie.Model.Irclogs (showIrcDateTime)
-	15	import Amelie.Types
-	16	import Amelie.View.Highlight (highlightPaste)
-	17	import Amelie.View.Hlint (viewHints)
-	18	import Amelie.View.Html
-	19	import Amelie.View.Layout
-	20
-	21	import Control.Applicative
-	22	import Control.Arrow ((&&&))
-	23	import Control.Monad
-	24	import Data.ByteString.UTF8 (toString)
-	25	import Data.List (find,nub)
-	26	import qualified Data.Map as M
-	27	import Data.Maybe
-	28	import Data.Monoid.Operator ((++))
-	29	import Data.Text (Text,pack)
-	30	import qualified Data.Text as T
-	31	import Data.Text.Lazy (fromStrict)
-	32	import Data.Time.Show (showDateTime)
-	33	import Data.Traversable hiding (forM)
-	34	import Numeric
-	35	import Prelude hiding ((++))
-	36	import Safe (readMay)
-	37	import Text.Blaze.Html5 as H hiding (map)
-	38	import qualified Text.Blaze.Html5.Attributes as A
-	39	import Text.Blaze.Html5.Extra
-	40	import Text.Blaze.Extra
-	41	import Text.Formlet
-	42
-	43	-- \| Render the page page.
-	44	page :: PastePage -> Html
-	45	page PastePage{ppPaste=p@Paste{..},..} =
-	46	layoutPage $ Page {
-	47	pageTitle = pasteTitle
-	48	, pageBody = do viewPaste (if ppRevision then [] else ppRevisions)
-	49	[]
-	50	ppChans
-	51	ppLangs
-	52	(p,case ppRevisionsHints of (hints:_) -> hints; _ -> ppHints)
-	53	viewAnnotations (p : ppAnnotations)
-	54	ppChans
-	55	ppLangs
-	56	(zip ppAnnotations ppAnnotationHints)
-	57	, pageName = "paste"
-	58	}
-	59
-	60	-- \| A formlet for paste submission / annotateing.
-	61	pasteFormlet :: PasteFormlet -> (Formlet PasteSubmit,Html)
-	62	pasteFormlet pf@PasteFormlet{..} =
-	63	let form = postForm ! A.action (toValue action) $ do
-	64	when pfSubmitted $
-	65	when (not (null pfErrors)) $
-	66	H.div ! aClass "errors" $
-	67	mapM_ (p . toHtml) pfErrors
-	68	formletHtml (pasteSubmit pf) pfParams
-	69	submitInput "submit" "Submit"
-	70	in (pasteSubmit pf,form)
-	71
-	72	where action = case pfAnnotatePaste of
-	73	Just Paste{..} -> "/annotate/" ++ show (fromMaybe pasteId pasteParent)
-	74	where pasteParent = case pasteType of
-	75	AnnotationOf pid -> Just pid
-	76	_ -> Nothing
-	77	Nothing ->
-	78	case pfEditPaste of
-	79	Just Paste{..} -> "/edit/" ++ show pasteId
-	80	Nothing -> "/new"
-	81
-	82	-- \| The paste submitting formlet itself.
-	83	pasteSubmit :: PasteFormlet -> Formlet PasteSubmit
-	84	pasteSubmit pf@PasteFormlet{..} =
-	85	PasteSubmit
-	86	<$> pure (getPasteId pf)
-	87	<*> pure (case pfAnnotatePaste of
-	88	Just pid -> AnnotationOf (pasteId pid)
-	89	_ -> case pfEditPaste of
-	90	Just pid -> RevisionOf (pasteId pid)
-	91	_ -> NormalPaste)
-	92	<*> req (textInput "title" "Title" (annotateTitle <\|> editTitle))
-	93	<*> defaulting "Anonymous Coward" (textInput "author" "Author" Nothing)
-	94	<*> parse (traverse lookupLang)
-	95	(opt (dropInput languages "language" "Language" (snd defChan)))
-	96	<*> parse (traverse lookupChan)
-	97	(opt (dropInput channels "channel" "Channel" (fst defChan)))
-	98	<*> req (areaInput "paste" "Paste" pfContent)
-	99	<*> opt (wrap (H.div ! aClass "spam") (textInput "email" "Email" Nothing))
-	100
-	101	where defaulting def = fmap swap where
-	102	swap "" = def
-	103	swap x = x
-	104	channels = options channelName channelName pfChannels
-	105	languages = options languageName languageTitle pfLanguages
-	106
-	107	lookupLang slug = findOption ((==slug).languageName) pfLanguages languageId
-	108	lookupChan slug = findOption ((==slug).channelName) pfChannels channelId
-	109
-	110	defChan = maybe (fromMaybe "" (annotateChan <\|> editChan)
-	111	,fromMaybe "haskell" (annotateLanguage <\|> editLanguage))
-	112	(channelName &&& trim.channelName)
-	113	(pfDefChan >>= findChan)
-	114	findChan name = find ((==name).trim.channelName) pfChannels
-	115	trim = T.dropWhile (=='#')
-	116
-	117	annotateContent = pastePaste <$> pfAnnotatePaste
-	118	annotateTitle = ((++ " (annotation)") . pasteTitle) <$> pfAnnotatePaste
-	119	annotateLanguage = join (fmap pasteLanguage pfAnnotatePaste) >>= findLangById
-	120	annotateChan = join (fmap pasteChannel pfAnnotatePaste) >>= findChanById
-	121
-	122	editContent = pastePaste <$> pfEditPaste
-	123	editTitle = Nothing
-	124	editLanguage = join (fmap pasteLanguage pfEditPaste) >>= findLangById
-	125	editChan = join (fmap pasteChannel pfEditPaste) >>= findChanById
-	126
-	127	findChanById id = channelName <$> find ((==id).channelId) pfChannels
-	128	findLangById id = languageName <$> find ((==id).languageId) pfLanguages
-	129
-	130	-- \| Get the paste id.
-	131	getPasteId :: PasteFormlet -> Maybe PasteId
-	132	getPasteId PasteFormlet{..} =
-	133	M.lookup "id" pfParams >>=
-	134	readMay . concat . map toString >>=
-	135	return . (fromIntegral :: Integer -> PasteId)
-	136
-	137	-- \| View the paste's annotations.
-	138	viewAnnotations :: [Paste] -> [Channel] -> [Language] -> [(Paste,[Hint])] -> Html
-	139	viewAnnotations pastes chans langs annotations = do
-	140	mapM_ (viewPaste [] pastes chans langs) annotations
-	141
-	142	-- \| View a paste's details and content.
-	143	viewPaste :: [Paste] -> [Paste] -> [Channel] -> [Language] -> (Paste,[Hint]) -> Html
-	144	viewPaste revisions annotations chans langs (paste@Paste{..},hints) = do
-	145	pasteDetails revisions annotations chans langs paste
-	146	pasteContent revisions langs paste
-	147	viewHints hints
-	148
-	149	-- \| List the details of the page in a dark section.
-	150	pasteDetails :: [Paste] -> [Paste] -> [Channel] -> [Language] -> Paste -> Html
-	151	pasteDetails revisions annotations chans langs paste =
-	152	darkNoTitleSection $ do
-	153	pasteNav langs annotations paste
-	154	h2 $ toHtml $ fromStrict (pasteTitle paste)
-	155	ul ! aClass "paste-specs" $ do
-	156	detail "Paste" $ do
-	157	pasteLink paste $ "#" ++ show (pasteId paste)
-	158	" "
-	159	linkToParent paste
-	160	detail "Author(s)" $ do
-	161	let authors \| null revisions = map pasteAuthor [paste]
-	162	\| otherwise = map pasteAuthor revisions
-	163	htmlCommasAnd $ flip map (nub authors) $ \author ->
-	164	linkAuthor author
-	165	detail "Language" $ showLanguage langs (pasteLanguage paste)
-	166	detail "Channel" $ do showChannel chans (pasteChannel paste)
-	167	detail "Created" $ showDateTime (pasteDate paste)
-	168	detail "Raw" $ pasteRawLink paste $ ("View raw link" :: Text)
-	169	unless (length revisions < 2) $ detail "Revisions" $ do
-	170	br
-	171	ul !. "revisions" $ listRevisions paste revisions
-	172	clear
-	173
-	174	where detail title content = do
-	175	li $ do strong (title ++ ":"); toHtml content
-	176
-	177	-- \| Link to an author.
-	178	linkAuthor :: Text -> Html
-	179	linkAuthor author = href ("/browse?author=" ++ author) $ toHtml author
-	180
-	181	-- \| Link to annotation/revision parents.
-	182	linkToParent :: Paste -> Html
-	183	linkToParent paste = do
-	184	case pasteType paste of
-	185	NormalPaste -> return ()
-	186	AnnotationOf pid -> do "(an annotation of "; pidLink pid; ")"
-	187	RevisionOf pid -> do "(a revision of "; pidLink pid; ")"
-	188
-	189	-- \| List the revisions of a paste.
-	190	listRevisions :: Paste -> [Paste] -> Html
-	191	listRevisions p [] = return ()
-	192	listRevisions p [x] = revisionDetails p x
-	193	listRevisions p (x:y:xs) = do
-	194	revisionDetails y x
-	195	listRevisions p (y:xs)
-	196
-	197	-- \| List the details of a revision.
-	198	revisionDetails :: Paste -> Paste -> Html
-	199	revisionDetails paste revision = li $ do
-	200	toHtml $ showDateTime (pasteDate revision)
-	201	" "
-	202	revisionLink revision $ do "#"; toHtml (show (pasteId revision))
-	203	unless (pasteId paste == pasteId revision) $ do
-	204	" "
-	205	href ("/diff/" ++ show (pasteId paste) ++ "/" ++ show (pasteId revision)) $
-	206	("(diff)" :: Html)
-	207	": "
-	208	toHtml (pasteTitle revision)
-	209	" ("
-	210	linkAuthor (pasteAuthor revision)
-	211	")"
-	212
-	213	-- \| Individual paste navigation.
-	214	pasteNav :: [Language] -> [Paste] -> Paste -> Html
-	215	pasteNav langs pastes paste =
-	216	H.div ! aClass "paste-nav" $ do
-	217	diffLink
-	218	href ("/edit/" ++ pack (show pid) ++ "") ("Edit" :: Text)
-	219	" - "
-	220	href ("/annotate/" ++ pack (show pid) ++ "") ("Annotate" :: Text)
-	221	" - "
-	222	href ("/report/" ++ pack (show pid) ++ "") ("Report/Delete" :: Text)
-	223
-	224	where pid = pasteId paste
-	225	pairs = zip (drop 1 pastes) pastes
-	226	parent = fmap snd $ find ((==pid).pasteId.fst) $ pairs
-	227	diffLink = do
-	228	case listToMaybe pastes of
-	229	Nothing -> return ()
-	230	Just Paste{pasteId=parentId} -> do
-	231	href ("/diff/" ++ show parentId ++ "/" ++ show pid)
-	232	("Diff original" :: Text)
-	233	case parent of
-	234	Nothing -> return ()
-	235	Just Paste{pasteId=prevId} -> do
-	236	when (pasteType paste /= AnnotationOf prevId) $ do
-	237	" / "
-	238	href ("/diff/" ++ show prevId ++ "/" ++ show pid)
-	239	("prev" :: Text)
-	240	case listToMaybe pastes of
-	241	Nothing -> return (); Just{} -> " - "
-	242	lang = pasteLanguage paste >>= (`lookup` ls)
-	243	ls = map (languageId &&& languageName) langs
-	244
-	245	-- \| Show the paste content with highlighting.
-	246	pasteContent :: [Paste] -> [Language] -> Paste -> Html
-	247	pasteContent revisions langs paste =
-	248	case revisions of
-	249	(rev:_) -> lightNoTitleSection $ highlightPaste langs rev
-	250	_ -> lightNoTitleSection $ highlightPaste langs paste
-	251
-	252	-- \| The href link to a paste.
-	253	pasteLink :: ToHtml html => Paste -> html -> Html
-	254	pasteLink Paste{..} inner = href ("/" ++ show pasteId) inner
-	255
-	256	-- \| The href link to a paste pid.
-	257	pidLink :: PasteId -> Html
-	258	pidLink pid = href ("/" ++ show pid) $ toHtml $ "#" ++ show pid
-	259
-	260	-- \| The href link to a paste.
-	261	revisionLink :: ToHtml html => Paste -> html -> Html
-	262	revisionLink Paste{..} inner = href ("/revision/" ++ show pasteId) inner
-	263
-	264	-- \| The href link to a paste, raw content.
-	265	pasteRawLink :: ToHtml html => Paste -> html -> Html
-	266	pasteRawLink Paste{..} inner = href ("/raw/" ++ show pasteId) inner

Remove file src/Amelie/View/Report.hs 33188

-	1	{-# OPTIONS -Wall -fno-warn-name-shadowing -fno-warn-unused-do-bind #-}
-	2	{-# LANGUAGE OverloadedStrings #-}
-	3	{-# LANGUAGE RecordWildCards #-}
-	4
-	5	-- \| Report view.
-	6
-	7	module Amelie.View.Report
-	8	(page,reportFormlet)
-	9	where
-	10
-	11	import Amelie.Types
-	12	import Amelie.View.Highlight
-	13	import Amelie.View.Html
-	14	import Amelie.View.Layout
-	15
-	16	import Data.Monoid.Operator ((++))
-	17	import Data.Text (Text)
-	18	import Prelude hiding ((++))
-	19	import Text.Blaze.Html5 as H hiding (map)
-	20	import qualified Text.Blaze.Html5.Attributes as A
-	21	import Text.Formlet
-	22
-	23	-- \| Render the page page.
-	24	page :: Html -> Paste -> Html
-	25	page form paste =
-	26	layoutPage $ Page {
-	27	pageTitle = "Report a paste"
-	28	, pageBody = do reporting form; viewPaste paste
-	29	, pageName = "paste"
-	30	}
-	31
-	32	reporting :: Html -> Html
-	33	reporting form = do
-	34	lightSection "Report a paste" $ do
-	35	p $ do "Please state any comments regarding the paste:"
-	36	H.form ! A.method "post" $ do
-	37	form
-	38
-	39	-- \| View a paste's details and content.
-	40	viewPaste :: Paste -> Html
-	41	viewPaste Paste{..} = do
-	42	pasteDetails pasteTitle
-	43	pasteContent pastePaste
-	44
-	45	-- \| List the details of the page in a dark section.
-	46	pasteDetails :: Text -> Html
-	47	pasteDetails title =
-	48	darkNoTitleSection $ do
-	49	pasteNav
-	50	h2 $ toHtml title
-	51	ul ! aClass "paste-specs" $ do
-	52	detail "Language" $ "Haskell"
-	53	detail "Raw" $ href ("/stepeval/raw" :: Text)
-	54	("View raw link" :: Text)
-	55	clear
-	56
-	57	where detail title content = do
-	58	li $ do strong (title ++ ":"); content
-	59
-	60	-- \| Individual paste navigation.
-	61	pasteNav :: Html
-	62	pasteNav =
-	63	H.div ! aClass "paste-nav" $ do
-	64	href ("https://github.com/benmachine/stepeval" :: Text)
-	65	("Go to stepeval project" :: Text)
-	66
-	67	-- \| Show the paste content with highlighting.
-	68	pasteContent :: Text -> Html
-	69	pasteContent paste =
-	70	lightNoTitleSection $
-	71	highlightHaskell paste
-	72
-	73	-- \| A formlet for report submission / annotating.
-	74	reportFormlet :: ReportFormlet -> (Formlet Text,Html)
-	75	reportFormlet ReportFormlet{..} =
-	76	let frm = form $ do
-	77	formletHtml reportSubmit rfParams
-	78	submitInput "submit" "Submit"
-	79	in (reportSubmit,frm)
-	80
-	81	reportSubmit :: Formlet Text
-	82	reportSubmit = req (textInput "report" "Comments" Nothing)

Remove file src/Amelie/View/Reported.hs 33188

-	1	{-# OPTIONS -Wall -fno-warn-name-shadowing #-}
-	2	{-# LANGUAGE OverloadedStrings #-}
-	3	{-# LANGUAGE RecordWildCards #-}
-	4
-	5	-- \| Reported page view.
-	6
-	7	module Amelie.View.Reported
-	8	(page)
-	9	where
-	10
-	11	import Amelie.Types
-	12	import Amelie.View.Html
-	13	import Amelie.View.Layout
-	14
-	15	import Data.Monoid.Operator ((++))
-	16	import Data.Time.Show (showDateTime)
-	17	import Prelude hiding ((++))
-	18	import Text.Blaze.Html5 as H hiding (map)
-	19
-	20	-- \| Render the reported page.
-	21	page :: Pagination -> [Report] -> Html
-	22	page pn rs =
-	23	layoutPage $ Page {
-	24	pageTitle = "Reported pastes"
-	25	, pageBody = reported pn rs
-	26	, pageName = "reported"
-	27	}
-	28
-	29	-- \| View the paginated reports.
-	30	reported :: Pagination -> [Report] -> Html
-	31	reported pn rs = do
-	32	darkSection "Reported pastes" $ do
-	33	paginate pn $ do
-	34	table ! aClass "latest-pastes" $ do
-	35	tr $ mapM_ (th . toHtml) $ words "Date Paste Comments"
-	36	reports rs
-	37
-	38	where reports = mapM_ $ \Report{..} -> tr $ do
-	39	td $ toHtml $ showDateTime reportDate
-	40	td $ toHtml $ href ("/" ++ show reportPasteId) $ show reportPasteId
-	41	td $ toHtml reportComments

Remove file src/Amelie/View/Script.hs 33188

-	1	{-# OPTIONS -Wall -fno-warn-orphans -fno-warn-name-shadowing -fno-warn-unused-do-bind #-}
-	2	{-# LANGUAGE OverloadedStrings #-}
-	3	{-# LANGUAGE FlexibleInstances #-}
-	4	{-# LANGUAGE TypeSynonymInstances #-}
-	5
-	6	-- \| Page script.
-	7
-	8	module Amelie.View.Script
-	9	(script)
-	10	where
-	11
-	12	import Data.Text.Lazy (Text,pack)
-	13	import HJScript
-	14	import HJScript.Objects.JQuery hiding (prepend,append)
-	15	import HJScript.Objects.JQuery.Extra
-	16	import Prelude hiding ((++),max)
-	17
-	18	-- \| All scripts on the site. Not much to do.
-	19	script :: Text
-	20	script = pack $ show $ snd $ evalHJScript $ do
-	21	ready $ do
-	22	-- resizePage
-	23	toggleHints
-	24	togglePaste
-	25
-	26	-- \| Resize the width of the page to match content width.
-	27	resizePage :: HJScript ()
-	28	resizePage = do
-	29	max <- varWith (int 0)
-	30	each (do max .=. (mathMax 500
-	31	(mathMax (getWidth this' + 50) (val max)))
-	32	return true)
-	33	(j ".amelie-code")
-	34	each (do setWidth (mathMax (val max) 500)
-	35	(j ".amelie-wrap")
-	36	return true)
-	37	(j ".amelie-code")
-	38	each (do setWidth (mathMax (getWidth this') 500)
-	39	(j ".amelie-wrap")
-	40	return true)
-	41	(j ".amelie-latest-pastes")
-	42
-	43	-- \| Collapse/expand hints when toggled.
-	44	toggleHints :: HJScript ()
-	45	toggleHints = do
-	46	each (do this <- varWith this'
-	47	collapse this
-	48	css' "cursor" "pointer" (parent this)
-	49	toggle (expand this)
-	50	(collapse this)
-	51	(parent this)
-	52	return true)
-	53	(j ".amelie-hint")
-	54
-	55	where collapse o = do
-	56	css "height" "1em" o
-	57	css "overflow" "hidden" o
-	58	return false
-	59	expand o = do
-	60	css "height" "auto" o
-	61	return false
-	62
-	63	-- \| Toggle paste details.
-	64	togglePaste :: HJScript ()
-	65	togglePaste = do
-	66	each (do btn <- varWith (j "<a href=\"\">Expand</a>")
-	67	this <- varWith this'
-	68	prepend (string " - ") this
-	69	prepend (val btn) this
-	70	details <- varWith (siblings ".amelie-paste-specs" this)
-	71	display btn "none" details
-	72	toggle (display btn "block" details)
-	73	(display btn "none" details)
-	74	btn
-	75	return true)
-	76	(j ".amelie-paste-nav")
-	77
-	78	where display btn prop o = do
-	79	css "display" prop o
-	80	setText (string caption) btn
-	81	return false
-	82	where caption = if prop == "block" then "Collapse" else "Expand"

Remove file src/Amelie/View/Stepeval.hs 33188

-	1	{-# OPTIONS -Wall -fno-warn-name-shadowing -fno-warn-unused-do-bind #-}
-	2	{-# LANGUAGE OverloadedStrings #-}
-	3	{-# LANGUAGE RecordWildCards #-}
-	4
-	5	-- \| Stepeval explanation view.
-	6
-	7	module Amelie.View.Stepeval
-	8	(page)
-	9	where
-	10
-	11	import Amelie.Types
-	12	import Amelie.View.Highlight
-	13	import Amelie.View.Hlint
-	14	import Amelie.View.Html
-	15	import Amelie.View.Layout
-	16
-	17	import Data.Monoid.Operator ((++))
-	18	import Data.Text (Text)
-	19	import Language.Haskell.HLint
-	20	import Prelude hiding ((++))
-	21	import Text.Blaze.Html5 as H hiding (map)
-	22
-	23	-- \| Render the page page.
-	24	page :: StepevalPage -> Html
-	25	page StepevalPage{..} =
-	26	layoutPage $ Page {
-	27	pageTitle = "Stepeval support"
-	28	, pageBody = do explanation
-	29	viewPaste sePaste seHints
-	30	, pageName = "paste"
-	31	}
-	32
-	33	explanation :: Html
-	34	explanation = do
-	35	lightSection "Stepeval" $ do
-	36	p $ do "A program/library for evaluating "
-	37	"a Haskell expression step-by-step. This web site uses it "
-	38	"for stepping through provided expressions."
-	39	p $ href ("https://github.com/benmachine/stepeval" :: Text)
-	40	("Repository for Stepeval" :: Text)
-	41	p $ do "Stepeval comes with a simple Prelude of pure functions "
-	42	"(see below) that can be used when stepping through "
-	43	"expressions. This may be expanded upon in the future."
-	44	p $ do "This web site will automatically include declarations "
-	45	"from the paste as the expression to be evaluted."
-	46
-	47	-- \| View a paste's details and content.
-	48	viewPaste :: Text -> [Suggestion] -> Html
-	49	viewPaste paste hints = do
-	50	pasteDetails "Stepeval Prelude"
-	51	pasteContent paste
-	52	viewSuggestions hints
-	53
-	54	-- \| List the details of the page in a dark section.
-	55	pasteDetails :: Text -> Html
-	56	pasteDetails title =
-	57	darkNoTitleSection $ do
-	58	pasteNav
-	59	h2 $ toHtml title
-	60	ul ! aClass "paste-specs" $ do
-	61	detail "Language" $ "Haskell"
-	62	detail "Raw" $ href ("/stepeval/raw" :: Text)
-	63	("View raw link" :: Text)
-	64	clear
-	65
-	66	where detail title content = do
-	67	li $ do strong (title ++ ":"); content
-	68
-	69	-- \| Individual paste navigation.
-	70	pasteNav :: Html
-	71	pasteNav =
-	72	H.div ! aClass "paste-nav" $ do
-	73	href ("https://github.com/benmachine/stepeval" :: Text)
-	74	("Go to stepeval project" :: Text)
-	75
-	76	-- \| Show the paste content with highlighting.
-	77	pasteContent :: Text -> Html
-	78	pasteContent paste =
-	79	lightNoTitleSection $
-	80	highlightHaskell paste

Remove file src/Amelie/View/Steps.hs 33188

-	1	{-# OPTIONS -Wall -fno-warn-name-shadowing #-}
-	2	{-# LANGUAGE OverloadedStrings #-}
-	3	{-# LANGUAGE RecordWildCards #-}
-	4
-	5	-- \| Paste steps view.
-	6
-	7	module Amelie.View.Steps
-	8	(page
-	9	,exprFormlet)
-	10	where
-	11
-	12	import Amelie.Types
-	13	import Amelie.View.Highlight
-	14	import Amelie.View.Hlint (viewHints)
-	15	import Amelie.View.Html
-	16	import Amelie.View.Layout
-	17	import Amelie.View.Paste (pasteLink)
-	18
-	19	import Control.Monad
-	20	import Data.Monoid.Operator ((++))
-	21	import Data.Text (Text)
-	22	import qualified Data.Text as T
-	23	import Data.Text.Lazy (fromStrict)
-	24	import Prelude hiding ((++),div)
-	25	import Text.Blaze.Html5 as H hiding (map)
-	26	import qualified Text.Blaze.Html5.Attributes as A
-	27	import Text.Formlet
-	28
-	29	-- \| Render the steps page.
-	30	page :: StepsPage -> Html
-	31	page StepsPage{spPaste=p@Paste{..},..} =
-	32	layoutPage $ Page {
-	33	pageTitle = pasteTitle
-	34	, pageBody = viewPaste spForm p spHints spSteps
-	35	, pageName = "steps"
-	36	}
-	37
-	38	-- \| View a paste's details and content.
-	39	viewPaste :: Html -> Paste -> [Hint] -> [Text] -> Html
-	40	viewPaste form paste@Paste{..} hints steps = do
-	41	case pasteParent of
-	42	Nothing -> return ()
-	43	Just{} -> let an = "a" ++ show (fromIntegral pasteId :: Integer)
-	44	in a ! A.name (toValue an) $ return ()
-	45	pasteDetails paste
-	46	pasteContent paste
-	47	stepsForm form
-	48	viewSteps steps
-	49	viewHints hints
-	50
-	51	stepsForm :: Html -> Html
-	52	stepsForm form =
-	53	lightNoTitleSection $
-	54	div ! aClass "steps-expr" $
-	55	form
-	56
-	57	-- \| A formlet for expr submission / annotating.
-	58	exprFormlet :: ExprFormlet -> (Formlet Text,Html)
-	59	exprFormlet ExprFormlet{..} =
-	60	let frm = form $ do
-	61	formletHtml exprSubmit efParams
-	62	submitInput "submit" "Submit"
-	63	in (exprSubmit,frm)
-	64
-	65	exprSubmit :: Formlet Text
-	66	exprSubmit = req (textInput "expr" "Expression" Nothing)
-	67
-	68	viewSteps :: [Text] -> Html
-	69	viewSteps steps =
-	70	lightSection "Steps (displaying 50 max.)" $
-	71	div ! aClass "steps" $ do
-	72	highlightHaskell $ T.intercalate "\n\n" steps
-	73
-	74	-- \| List the details of the page in a dark section.
-	75	pasteDetails :: Paste -> Html
-	76	pasteDetails paste@Paste{..} =
-	77	darkNoTitleSection $ do
-	78	pasteNav
-	79	h2 $ toHtml $ fromStrict pasteTitle
-	80	ul ! aClass "paste-specs" $ do
-	81	detail "Paste" $ pasteLink paste $ "#" ++ show pasteId
-	82	detail "Author" $ pasteAuthor
-	83	clear
-	84
-	85	where detail title content = do
-	86	li $ do strong (title ++ ":"); toHtml content
-	87
-	88	-- \| Individual paste navigation.
-	89	pasteNav :: Html
-	90	pasteNav =
-	91	H.div ! aClass "paste-nav" $ do
-	92	href ("/stepeval" :: Text)
-	93	("About evaluation step support" :: Text)
-	94
-	95	-- \| Show the paste content with highlighting.
-	96	pasteContent :: Paste -> Html
-	97	pasteContent paste =
-	98	lightNoTitleSection $ highlightHaskell (pastePaste paste)

Remove file src/Amelie/View/Style.hs 33188

-	1	{-# OPTIONS -Wall #-}
-	2	{-# LANGUAGE OverloadedStrings #-}
-	3
-	4	-- \| Page style.
-	5
-	6	module Amelie.View.Style
-	7	(style)
-	8	where
-	9
-	10	import Data.Monoid.Operator ((++))
-	11	import Data.Text.Lazy (Text)
-	12	import Prelude hiding ((++))
-	13	import Language.CSS
-	14
-	15	-- \| Side-wide style sheet.
-	16	style :: Text
-	17	style = renderCSS $ runCSS $ do
-	18	layout
-	19	sections
-	20	paste
-	21	utils
-	22	highlighter
-	23	hints
-	24	form
-	25	home
-	26	browse
-	27	footer
-	28	activity
-	29	ircEntries
-	30
-	31	-- \| IRC log entries.
-	32	ircEntries :: CSS Rule
-	33	ircEntries = do
-	34	classRule "irc-entries" $ do
-	35	marginLeft "0"
-	36	paddingLeft "0"
-	37	listStyle "none"
-	38	rule ".current" $ do
-	39	fontWeight "bold"
-	40	marginTop "1em"
-	41	marginBottom "1em"
-	42
-	43	-- \| Footer.
-	44	footer :: CSS Rule
-	45	footer = do
-	46	classRule "footer" $ do
-	47	textAlign "center"
-	48	rule "a" $ do
-	49	textDecoration "none"
-	50	rule "a:hover" $ do
-	51	textDecoration "underline"
-	52
-	53	-- \| General layout styles.
-	54	layout :: CSS Rule
-	55	layout = do
-	56	rule "body" $ do
-	57	fontFamily "'DejaVu Sans', sans-serif"
-	58	fontSize "13px"
-	59	textAlign "center"
-	60
-	61	classRule "logo" $ do
-	62	margin "1em 0 1em 0"
-	63	border "0"
-	64	background "url(/css/hpaste.png) no-repeat"
-	65	width "190px"
-	66	height "50px"
-	67	display "block"
-	68	textIndent "-999px"
-	69
-	70	classRule "wrap" $ do
-	71	margin "auto"
-	72	textAlign "left"
-	73
-	74	classRule "nav" $ do
-	75	float "right"
-	76	marginTop "1em"
-	77
-	78	-- \| Paste form.
-	79	form :: CSS Rule
-	80	form = do
-	81	inputs
-	82	classRule "spam" $ do
-	83	display "none"
-	84	classRule "errors" $ do
-	85	color "#743838"
-	86	fontWeight "bold"
-	87
-	88	-- \| Input style.
-	89	inputs :: CSS Rule
-	90	inputs =
-	91	rule "form p label" $ do
-	92	rule "textarea" $ do
-	93	width "100%"
-	94	height "20em"
-	95	clear "both"
-	96	margin "1em 0 0 0"
-	97
-	98	rule "textarea, input.text" $ do
-	99	border "2px solid #ddd"
-	100	borderRadius "4px"
-	101	rule "textarea:focus, input.text:focus" $ do
-	102	background "#eee"
-	103
-	104	rule "span" $ do
-	105	float "left"
-	106	width "7em"
-	107	display "block"
-	108
-	109	-- \| Section styles.
-	110	sections :: CSS Rule
-	111	sections = do
-	112	classRule "section" $ do
-	113	borderRadius "5px"
-	114	padding "10px"
-	115	border "3px solid #000"
-	116	margin "0 0 0.5em 0"
-	117
-	118	rule "h2" $ do
-	119	margin "0"
-	120	fontSize "1.2em"
-	121	padding "0"
-	122
-	123	classRule "section-dark" $ do
-	124	background "#453D5B"
-	125	borderColor "#A9A0D2"
-	126	color "#FFF"
-	127
-	128	rule "h2" $ do
-	129	color "#FFF"
-	130
-	131	rule "a" $ do
-	132	color "#8ae0c2"
-	133	textDecoration "none"
-	134
-	135	rule "a:hover" $ do
-	136	textDecoration "underline"
-	137
-	138	classRule "section-light" $ do
-	139	background "#FFF"
-	140	borderColor "#EEE"
-	141	color "#000"
-	142
-	143	rule "h2" $ do
-	144	color "#2D2542"
-	145
-	146	classRule "section-error" $ do
-	147	background "#FFDFDF"
-	148	color "#5b4444"
-	149	border "1px solid #EFB3B3"
-	150
-	151	rule "pre" $ do
-	152	margin "0"
-	153	rule "h2" $ do
-	154	color "#2D2542"
-	155
-	156	classRule "section-warn" $ do
-	157	background "#FFF9C7"
-	158	color "#915c31"
-	159	border "1px solid #FFF178"
-	160	rule "pre" $ do
-	161	margin "0"
-	162	rule "h2" $ do
-	163	color "#2D2542"
-	164
-	165	-- \| Paste view styles.
-	166	paste :: CSS Rule
-	167	paste = do
-	168	classRule "paste-specs" $ do
-	169	margin "0.5em 0 0 0"
-	170	padding "0"
-	171	listStyle "none"
-	172	lineHeight "1.5em"
-	173
-	174	rule "strong" $ do
-	175	fontWeight "normal"
-	176	width "8em"
-	177	display "block"
-	178	float "left"
-	179	rule ".revisions" $ do
-	180	listStyleType "none"
-	181	paddingLeft "0"
-	182	classRule "paste-nav" $ do
-	183	float "right"
-	184
-	185	-- \| Utility styles to help with HTML weirdness.
-	186	utils :: CSS Rule
-	187	utils = do
-	188	classRule "clear" $ do
-	189	clear "both"
-	190
-	191	-- \| A short-hand for prefixing rules with ‘.amelie-’.
-	192	classRule :: Text -> CSS (Either Property Rule) -> CSS Rule
-	193	classRule = rule . (".amelie-" ++)
-	194
-	195	-- \| Styles for the highlighter.
-	196	highlighter :: CSS Rule
-	197	highlighter = do
-	198	diff
-	199
-	200	classRule "steps" $ do
-	201	marginTop "1em"
-	202	classRule "steps-expr" $ do
-	203	rule ".text" $ do
-	204	width "300px"
-	205
-	206	classRule "code" $ do
-	207	tokens
-	208
-	209	rule "pre" $ do
-	210	margin "0"
-	211
-	212	rule "td" $ do
-	213	verticalAlign "top"
-	214	lineNumbers
-	215
-	216	-- \| Style for diff groups.
-	217	diff :: CSS Rule
-	218	diff = do
-	219	classRule "diff-both" $
-	220	return ()
-	221	classRule "diff-first" $ do
-	222	backgroundColor "#FDD"
-	223	color "#695B5B"
-	224	classRule "diff-second" $ do
-	225	backgroundColor "#DFD"
-	226
-	227	-- \| Tokens colours and styles.
-	228	tokens :: CSS (Either Property Rule)
-	229	tokens = do
-	230	rule "pre" $ do
-	231	marginTop "0"
-	232	tokenColor "comment" "#555"
-	233	tokenColor "keyword" "#397460"
-	234	tokenColor "str" "#366354"
-	235	tokenColor "conid" "#4F4371"
-	236	tokenColor "varop" "#333"
-	237	tokenColor "varid" "#333"
-	238	tokenColor "num" "#4F4371"
-	239	rule "pre" $ do
-	240	rule ".diff" $ do
-	241	color "#555"
-	242	rule "code" $ do
-	243	jcolor "title" "#333"
-	244	jcolor "string" "#366354"
-	245	jcolor "built_in" "#397460"
-	246	jcolor "preprocessor" "#4F4371"
-	247	jcolor "comment" "#555"
-	248	jcolor "command" "#397460"
-	249	jcolor "special" "#333"
-	250	jcolor "formula" "#4F4371"
-	251	jcolor "keyword" "#397460"
-	252	jcolor "number" "#4F4371"
-	253	rule ".header" $ do
-	254	color "#555"
-	255	rule ".deletion" $ do
-	256	backgroundColor "#FDD"
-	257	color "#695B5B"
-	258	rule ".addition" $ do
-	259	backgroundColor "#DFD"
-	260	color "#000"
-	261	where token name props = rule (".hs-" ++ name) $ props
-	262	tokenColor name col = token name $ color col
-	263	jcolor name col = rule ("." ++ name) $ color col
-	264
-	265	-- \| The line number part.
-	266	lineNumbers :: CSS Rule
-	267	lineNumbers = do
-	268	rule ".amelie-line-nums pre" $ do
-	269	margin "0 1em 0 0"
-	270	textAlign "right"
-	271	rule "a" $ do
-	272	textDecoration "none"
-	273	color "#555"
-	274	rule "a:target" $ do
-	275	textDecoration "underline"
-	276	color "#000"
-	277
-	278	-- \| Home page styles.
-	279	home :: CSS Rule
-	280	home = do
-	281	rule "#new" wrap
-	282	classRule "browse-link" $ do
-	283	margin "1em 0 0 0"
-	284	classRule "latest-pastes" $ do
-	285	marginTop "0.5em"
-	286
-	287	where wrap = rule ".amelie-wrap" $ do
-	288	width "50em"
-	289
-	290	-- \| Browse page styles.
-	291	browse :: CSS Rule
-	292	browse = do
-	293	classRule "pagination" $ do
-	294	textAlign "center"
-	295	margin "1em"
-	296
-	297	rule ".amelie-inner" $ do
-	298	margin "auto"
-	299	width "15em"
-	300
-	301	-- \| Developer activity page styles.
-	302	activity :: CSS Rule
-	303	activity = do
-	304	rule "#activity" $ do
-	305	rule ".amelie-wrap" $ do
-	306	width "50em"
-	307
-	308	-- \| Hlint hints
-	309	hints :: CSS Rule
-	310	hints = do
-	311	classRule "hint-highlight" $ do
-	312	background "#333"
-	313	color "#999"
-	314	border "1px solid #444"

Remove file src/Amelie/View/Thanks.hs 33188

-	1	{-# OPTIONS -Wall -fno-warn-name-shadowing -fno-warn-unused-do-bind #-}
-	2	{-# LANGUAGE OverloadedStrings #-}
-	3	{-# LANGUAGE RecordWildCards #-}
-	4
-	5	-- \| Thanks view.
-	6
-	7	module Amelie.View.Thanks
-	8	(page)
-	9	where
-	10
-	11	import Amelie.Types
-	12	import Amelie.View.Html
-	13	import Amelie.View.Layout
-	14
-	15	import Data.String
-	16	import Data.Text (Text)
-	17	import Prelude hiding ((++))
-	18	import Text.Blaze.Html5 as H hiding (map)
-	19
-	20	-- \| Render the thanks5 page.
-	21	page :: String -> String -> Html
-	22	page title msg =
-	23	layoutPage $ Page {
-	24	pageTitle = fromString title
-	25	, pageBody = thanks title msg
-	26	, pageName = "thanks"
-	27	}
-	28
-	29	thanks :: String -> String -> Html
-	30	thanks title msg = do
-	31	darkSection (fromString title) $ do
-	32	p $ toHtml msg
-	33	p $ href ("/" :: Text)
-	34	("Go back home" :: Text)

Remove file src/Amelie/Types/Activity.hs 33188

-	1	module Amelie.Types.Activity where
-	2
-	3	import Data.Text.Lazy (Text)
-	4	import Data.Time (UTCTime)
-	5
-	6	data Commit = Commit {
-	7	commitTitle :: Text
-	8	,commitContent :: Text
-	9	,commitDate :: UTCTime
-	10	,commitLink :: Text
-	11	} deriving Show

Remove file src/Amelie/Types/Cache.hs 33188

-	1	{-# OPTIONS -Wall #-}
-	2
-	3	-- \| HTML caching types.
-	4
-	5	module Amelie.Types.Cache
-	6	(Key(..)
-	7	,Cache(..))
-	8	where
-	9
-	10	import Control.Concurrent.MVar (MVar)
-	11	import Data.Map (Map)
-	12	import Data.Text.Lazy (Text)
-	13
-	14	data Key =
-	15	Home
-	16	\| Paste Integer
-	17	\| Revision Integer
-	18	\| Activity
-	19	deriving (Eq,Ord)
-	20
-	21	data Cache =
-	22	Cache {
-	23	cacheMap :: MVar (Map Key Text)
-	24	}

Remove file src/Amelie/Types/Channel.hs 33188

-	1	{-# OPTIONS -Wall #-}
-	2
-	3	-- \| The channel type.
-	4
-	5	module Amelie.Types.Channel
-	6	(Channel(..))
-	7	where
-	8
-	9	import Amelie.Types.Newtypes
-	10
-	11	import Data.Text (Text)
-	12	import Database.PostgreSQL.Simple.QueryResults (QueryResults(..))
-	13
-	14	data Channel = Channel {
-	15	channelId :: ChannelId
-	16	,channelName :: Text
-	17	} deriving Show
-	18
-	19	instance QueryResults Channel where
-	20	convertResults field values = Channel {
-	21	channelId = cid
-	22	, channelName = name
-	23	}
-	24	where (cid,name) = convertResults field values

Remove file src/Amelie/Types/Config.hs 33188

-	1	-- \| Site-wide configuration.
-	2
-	3	module Amelie.Types.Config
-	4	(Config(..)
-	5	,Announcer(..))
-	6	where
-	7
-	8	import Database.PostgreSQL.Simple (ConnectInfo)
-	9	import Network.Mail.Mime (Address)
-	10
-	11	-- \| Site-wide configuration.
-	12	data Config = Config {
-	13	configAnnounce :: Announcer
-	14	, configPostgres :: ConnectInfo
-	15	, configDomain :: String
-	16	, configCommits :: String
-	17	, configRepoURL :: String
-	18	, configStepevalPrelude :: FilePath
-	19	, configIrcDir :: FilePath
-	20	, configAdmin :: Address
-	21	, configSiteAddy :: Address
-	22	, configCacheDir :: FilePath
-	23	}
-	24
-	25	-- \| Announcer configuration.
-	26	data Announcer = Announcer {
-	27	announceUser :: String
-	28	, announcePass :: String
-	29	, announceHost :: String
-	30	, announcePort :: Int
-	31	} deriving (Show)

Remove file src/Amelie/Types/Language.hs 33188

-	1	{-# OPTIONS -Wall #-}
-	2
-	3	-- \| The language type.
-	4
-	5	module Amelie.Types.Language
-	6	(Language(..))
-	7	where
-	8
-	9	import Amelie.Types.Newtypes
-	10
-	11	import Data.Text (Text)
-	12	import Database.PostgreSQL.Simple.QueryResults (QueryResults(..))
-	13
-	14	data Language = Language {
-	15	languageId :: LanguageId
-	16	,languageName :: Text
-	17	,languageTitle :: Text
-	18	} deriving Show
-	19
-	20	instance QueryResults Language where
-	21	convertResults field values = Language {
-	22	languageName = name
-	23	, languageId = lid
-	24	, languageTitle = title
-	25	}
-	26	where (lid,name,title) = convertResults field values

Remove file src/Amelie/Types/MVC.hs 33188

-	1	{-# OPTIONS -Wall #-}
-	2	{-# LANGUAGE RecordWildCards #-}
-	3	{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-	4
-	5	-- \| Model-view-controller types.
-	6
-	7	module Amelie.Types.MVC
-	8	(Controller(..)
-	9	,Model(..)
-	10	,ControllerState(..)
-	11	,ModelState(..))
-	12	where
-	13
-	14	import Amelie.Types.Cache
-	15	import Amelie.Types.Config
-	16
-	17	import Control.Applicative (Applicative,Alternative)
-	18	import Control.Concurrent.Chan (Chan)
-	19	import Control.Monad (MonadPlus)
-	20	import Control.Monad.Catch (MonadCatchIO)
-	21	import Control.Monad.Reader (ReaderT,MonadReader)
-	22	import Control.Monad.Trans (MonadIO)
-	23	import Data.Text.Lazy (Text)
-	24	import Database.PostgreSQL.Simple (Connection)
-	25	import Snap.Core (Snap,MonadSnap)
-	26
-	27	-- \| The state accessible to the controller (DB/session stuff).
-	28	data ControllerState = ControllerState {
-	29	controllerStateConfig :: Config
-	30	, controllerStateConn :: Connection
-	31	, controllerStateCache :: Cache
-	32	, controllerStateAnns :: Chan Text
-	33	}
-	34
-	35	-- \| The controller monad.
-	36	newtype Controller a = Controller {
-	37	runController :: ReaderT ControllerState Snap a
-	38	} deriving (Monad
-	39	,Functor
-	40	,Applicative
-	41	,Alternative
-	42	,MonadReader ControllerState
-	43	,MonadSnap
-	44	,MonadIO
-	45	,MonadPlus
-	46	,MonadCatchIO)
-	47
-	48	-- \| The state accessible to the model (just DB connection).
-	49	data ModelState = ModelState {
-	50	modelStateConn :: Connection
-	51	, modelStateAnns :: Chan Text
-	52	, modelStateConfig :: Config
-	53	}
-	54
-	55	-- \| The model monad (limited access to IO, only DB access).
-	56	newtype Model a = Model {
-	57	runModel :: ReaderT ModelState IO a
-	58	} deriving (Monad,Functor,Applicative,MonadReader ModelState,MonadIO)

Remove file src/Amelie/Types/Newtypes.hs 33188

-	1	{-# OPTIONS -Wall #-}
-	2	{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-	3
-	4	-- \| Newtypes; foreign keys and such.
-	5
-	6	module Amelie.Types.Newtypes
-	7	(PasteId(..)
-	8	,ChannelId(..)
-	9	,LanguageId(..)
-	10	,ReportId(..))
-	11	where
-	12
-	13	import Database.PostgreSQL.Simple.Result (Result)
-	14	import Database.PostgreSQL.Simple.Param (Param)
-	15
-	16	newtype PasteId = PasteId Integer
-	17	deriving (Integral,Real,Num,Ord,Eq,Enum,Result,Param)
-	18
-	19	instance Show PasteId where show (PasteId pid) = show pid
-	20
-	21	newtype ReportId = ReportId Integer
-	22	deriving (Integral,Real,Num,Ord,Eq,Enum,Result,Param)
-	23
-	24	instance Show ReportId where show (ReportId pid) = show pid
-	25
-	26	newtype ChannelId = ChannelId Integer
-	27	deriving (Integral,Real,Num,Ord,Eq,Enum,Result,Param)
-	28
-	29	instance Show ChannelId where show (ChannelId pid) = show pid
-	30
-	31	newtype LanguageId = LanguageId Integer
-	32	deriving (Integral,Real,Num,Ord,Eq,Enum,Result,Param)
-	33
-	34	instance Show LanguageId where show (LanguageId pid) = show pid

Remove file src/Amelie/Types/Page.hs 33188

-	1	{-# OPTIONS -Wall #-}
-	2	{-# LANGUAGE OverloadedStrings #-}
-	3
-	4	-- \| The page type.
-	5
-	6	module Amelie.Types.Page
-	7	(Page(..))
-	8	where
-	9
-	10	import Data.Text (Text)
-	11	import Text.Blaze (Html)
-	12
-	13	-- \| A page to be rendered in a layout.
-	14	data Page = Page {
-	15	pageTitle :: Text
-	16	, pageBody :: Html
-	17	, pageName :: Text
-	18	}

Remove file src/Amelie/Types/Paste.hs 33188

-	1	{-# OPTIONS -Wall -fno-warn-orphans #-}
-	2	{-# LANGUAGE RecordWildCards #-}
-	3	{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-	4	{-# LANGUAGE OverloadedStrings #-}
-	5
-	6	-- \| The paste type.
-	7
-	8	module Amelie.Types.Paste
-	9	(Paste(..)
-	10	,PasteType(..)
-	11	,PasteSubmit(..)
-	12	,PasteFormlet(..)
-	13	,ExprFormlet(..)
-	14	,PastePage(..)
-	15	,StepsPage(..)
-	16	,Hint(..)
-	17	,ReportFormlet(..)
-	18	,ReportSubmit(..))
-	19	where
-	20
-	21	import Amelie.Types.Newtypes
-	22	import Amelie.Types.Language
-	23	import Amelie.Types.Channel
-	24
-	25	import Blaze.ByteString.Builder (toByteString)
-	26	import Blaze.ByteString.Builder.Char.Utf8 as Utf8 (fromString)
-	27	import Data.Text (Text,pack)
-	28	import Data.Time (UTCTime,zonedTimeToUTC)
-	29	import Database.PostgreSQL.Simple.Param (Param(..),Action(..))
-	30	import Database.PostgreSQL.Simple.QueryResults (QueryResults(..))
-	31	import Database.PostgreSQL.Simple.Result (Result(..))
-	32	import Language.Haskell.HLint (Severity)
-	33	import Snap.Core (Params)
-	34	import Text.Blaze (ToHtml(..),toHtml)
-	35	import Text.Blaze.Html5 (Html)
-	36
-	37	-- \| A paste.
-	38	data Paste = Paste {
-	39	pasteId :: PasteId
-	40	,pasteTitle :: Text
-	41	,pasteDate :: UTCTime
-	42	,pasteAuthor :: Text
-	43	,pasteLanguage :: Maybe LanguageId
-	44	,pasteChannel :: Maybe ChannelId
-	45	,pastePaste :: Text
-	46	,pasteViews :: Integer
-	47	,pasteType :: PasteType
-	48	} deriving Show
-	49
-	50	-- \| The type of a paste.
-	51	data PasteType
-	52	= NormalPaste
-	53	\| AnnotationOf PasteId
-	54	\| RevisionOf PasteId
-	55	deriving (Eq,Show)
-	56
-	57	-- \| A paste submission or annotate.
-	58	data PasteSubmit = PasteSubmit {
-	59	pasteSubmitId :: Maybe PasteId
-	60	,pasteSubmitType :: PasteType
-	61	,pasteSubmitTitle :: Text
-	62	,pasteSubmitAuthor :: Text
-	63	,pasteSubmitLanguage :: Maybe LanguageId
-	64	,pasteSubmitChannel :: Maybe ChannelId
-	65	,pasteSubmitPaste :: Text
-	66	,pasteSubmitSpamTrap :: Maybe Text
-	67	} deriving Show
-	68
-	69	instance ToHtml Paste where
-	70	toHtml paste@Paste{..} = toHtml $ pack $ show paste
-	71
-	72	instance QueryResults Paste where
-	73	convertResults field values = Paste {
-	74	pasteTitle = title
-	75	, pasteAuthor = author
-	76	, pasteLanguage = language
-	77	, pasteChannel = channel
-	78	, pastePaste = content
-	79	, pasteDate = zonedTimeToUTC date
-	80	, pasteId = pid
-	81	, pasteViews = views
-	82	, pasteType = case annotation_of of
-	83	Just pid -> AnnotationOf pid
-	84	_ -> case revision_of of
-	85	Just pid -> RevisionOf pid
-	86	_ -> NormalPaste
-	87	}
-	88	where (pid,title,content,author,date,views,language,channel,annotation_of,revision_of) =
-	89	convertResults field values
-	90
-	91	data PasteFormlet = PasteFormlet {
-	92	pfSubmitted :: Bool
-	93	, pfErrors :: [Text]
-	94	, pfParams :: Params
-	95	, pfLanguages :: [Language]
-	96	, pfChannels :: [Channel]
-	97	, pfDefChan :: Maybe Text
-	98	, pfAnnotatePaste :: Maybe Paste
-	99	, pfEditPaste :: Maybe Paste
-	100	, pfContent :: Maybe Text
-	101	}
-	102
-	103	data ExprFormlet = ExprFormlet {
-	104	efSubmitted :: Bool
-	105	, efParams :: Params
-	106	}
-	107
-	108	data PastePage = PastePage {
-	109	ppPaste :: Paste
-	110	, ppChans :: [Channel]
-	111	, ppLangs :: [Language]
-	112	, ppHints :: [Hint]
-	113	, ppAnnotations :: [Paste]
-	114	, ppRevisions :: [Paste]
-	115	, ppAnnotationHints :: [[Hint]]
-	116	, ppRevisionsHints :: [[Hint]]
-	117	, ppRevision :: Bool
-	118	}
-	119
-	120	data StepsPage = StepsPage {
-	121	spPaste :: Paste
-	122	, spChans :: [Channel]
-	123	, spLangs :: [Language]
-	124	, spHints :: [Hint]
-	125	, spSteps :: [Text]
-	126	, spAnnotations :: [Paste]
-	127	, spAnnotationHints :: [[Hint]]
-	128	, spForm :: Html
-	129	}
-	130
-	131	instance Param Severity where
-	132	render = Escape . toByteString . Utf8.fromString . show
-	133	{-# INLINE render #-}
-	134
-	135	instance Result Severity where
-	136	convert f = read . convert f
-	137	{-# INLINE convert #-}
-	138
-	139	-- \| A hlint (or like) suggestion.
-	140	data Hint = Hint {
-	141	hintType :: Severity
-	142	, hintContent :: String
-	143	}
-	144
-	145	instance QueryResults Hint where
-	146	convertResults field values = Hint {
-	147	hintType = severity
-	148	, hintContent = content
-	149	}
-	150	where (severity,content) = convertResults field values
-	151
-	152	data ReportFormlet = ReportFormlet {
-	153	rfSubmitted :: Bool
-	154	, rfParams :: Params
-	155	}
-	156
-	157	data ReportSubmit = ReportSubmit {
-	158	rsPaste :: PasteId
-	159	,rsComments :: String
-	160	}

Remove file src/Amelie/Types/Report.hs 33188

-	1	module Amelie.Types.Report where
-	2
-	3	import Amelie.Types.Newtypes (PasteId)
-	4
-	5	import Data.Text (Text)
-	6	import Data.Time (UTCTime,zonedTimeToUTC)
-	7	import Database.PostgreSQL.Simple.QueryResults (QueryResults(..))
-	8
-	9	data Report = Report {
-	10	reportDate :: UTCTime
-	11	,reportPasteId :: PasteId
-	12	,reportComments :: Text
-	13	} deriving Show
-	14
-	15	instance QueryResults Report where
-	16	convertResults field values = Report {
-	17	reportDate = zonedTimeToUTC date
-	18	, reportPasteId = paste
-	19	, reportComments = comments
-	20	}
-	21	where (date,paste,comments) = convertResults field values

Remove file src/Amelie/Types/Stepeval.hs 33188

-	1	{-# OPTIONS -Wall -fno-warn-orphans #-}
-	2	{-# LANGUAGE RecordWildCards #-}
-	3	{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-	4	{-# LANGUAGE OverloadedStrings #-}
-	5
-	6	-- \| The stepeval types.
-	7
-	8	module Amelie.Types.Stepeval
-	9	(StepevalPage(..))
-	10	where
-	11
-	12	import Data.Text (Text)
-	13	import Language.Haskell.HLint
-	14
-	15	data StepevalPage = StepevalPage {
-	16	sePaste :: Text
-	17	, seHints :: [Suggestion]
-	18	}

Remove file src/Amelie/Types/View.hs 33188

-	1	module Amelie.Types.View
-	2	(Pagination(..))
-	3	where
-	4
-	5	import Data.Map (Map)
-	6	import Data.ByteString (ByteString)
-	7	import Network.URI (URI)
-	8
-	9	-- \| Pagination data.
-	10	data Pagination = Pagination {
-	11	pnPage :: Integer
-	12	, pnLimit :: Integer
-	13	, pnURI :: URI
-	14	, pnResults :: Integer
-	15	, pnTotal :: Integer
-	16	} deriving Show

Remove file src/Amelie/Model/Activity.hs 33188

-	1	{-# OPTIONS -Wall #-}
-	2	{-# LANGUAGE OverloadedStrings #-}
-	3
-	4	-- \| Activity model.
-	5
-	6	module Amelie.Model.Activity
-	7	(getCommits)
-	8	where
-	9
-	10	import Amelie.Types
-	11
-	12	import Control.Monad.IO (io)
-	13	import Data.Maybe (mapMaybe)
-	14	import Data.Text.Lazy (pack)
-	15	import Data.Time
-	16	import Network.Curl.Download
-	17	import System.Locale
-	18	import Text.Feed.Query
-	19
-	20	-- \| Get commits of this project from a commit feed.
-	21	getCommits :: String -> Model [Commit]
-	22	getCommits uri = io $ do
-	23	result <- openAsFeed uri
-	24	case result of
-	25	Left _ -> return []
-	26	Right feed -> return $
-	27	let items = getFeedItems feed
-	28	in mapMaybe makeCommit items
-	29
-	30	where makeCommit item = do
-	31	title <- getItemTitle item
-	32	datestr <- getItemDate item
-	33	date <- parseDateString datestr
-	34	link <- getItemLink item
-	35	return $ Commit {
-	36	commitTitle = pack $ title
-	37	, commitContent = "" -- Getting content from atom does not work.
-	38	, commitDate = date
-	39	, commitLink = pack link
-	40	}
-	41	-- E.g. 2011-06-11T11:15:11-07:00
-	42	parseDateString = parseTime defaultTimeLocale "%Y-%M-%dT%T%Z"

Remove file src/Amelie/Model/Announcer.hs 33188

-	1	{-# LANGUAGE ScopedTypeVariables #-}
-	2	{-# OPTIONS -Wall -fno-warn-name-shadowing #-}
-	3	{-# LANGUAGE OverloadedStrings #-}
-	4	{-# LANGUAGE RecordWildCards #-}
-	5
-	6	-- \| IRC announcer.
-	7
-	8	module Amelie.Model.Announcer
-	9	(newAnnouncer
-	10	,announce)
-	11	where
-	12
-	13	import Amelie.Types
-	14
-	15	import Control.Concurrent
-	16	import qualified Control.Exception as E
-	17	import Control.Monad
-	18	import Control.Monad.Env (env)
-	19	import Control.Monad.IO (io)
-	20	import qualified Data.ByteString.Lazy as B
-	21	import Data.Monoid.Operator ((++))
-	22	import Data.Text.Lazy (Text,pack)
-	23	import Data.Text.Lazy.Encoding
-	24	import qualified Data.Text.Lazy.IO as T
-	25	import Network
-	26	import Prelude hiding ((++))
-	27	import System.IO
-	28
-	29	-- \| Start a thread and return a channel to it.
-	30	newAnnouncer :: Announcer -> IO (Chan Text)
-	31	newAnnouncer config = do
-	32	putStrLn "Connecting..."
-	33	ans <- newChan
-	34	_ <- forkIO $ announcer config ans (\_ -> return ())
-	35	return ans
-	36
-	37	-- \| Run the announcer bot.
-	38	announcer :: Announcer -> Chan Text -> (Handle -> IO ()) -> IO ()
-	39	announcer c@Announcer{..} ans cont = do
-	40	h <- connectTo announceHost (PortNumber $ fromIntegral announcePort)
-	41	hSetBuffering h NoBuffering
-	42	let send h line = E.catch (do B.hPutStr h (encodeUtf8 (line ++ "\n"))
-	43	T.putStrLn line)
-	44	(\(_ :: IOError) -> do announcer c ans $ \h -> send h line)
-	45	send h $ "PASS " ++ pack announcePass
-	46	send h $ "USER " ++ pack announceUser ++ " * * *"
-	47	send h $ "NICK " ++ pack announceUser
-	48	cont h
-	49	lines <- getChanContents ans
-	50	forM_ lines $ \line -> send h line
-	51
-	52	-- \| Announce something to the IRC.
-	53	announce :: Text -> Text -> Model ()
-	54	announce channel line = do
-	55	chan <- env modelStateAnns
-	56	io $ writeChan chan $ "PRIVMSG " ++ channel ++ " :" ++ line

Remove file src/Amelie/Model/Channel.hs 33188

-	1	{-# OPTIONS -Wall #-}
-	2	{-# LANGUAGE OverloadedStrings #-}
-	3	{-# LANGUAGE RecordWildCards #-}
-	4
-	5	-- \| Channel model.
-	6
-	7	module Amelie.Model.Channel
-	8	(getChannels)
-	9	where
-	10
-	11	import Amelie.Types
-	12	import Amelie.Model
-	13
-	14	-- \| Get the channels.
-	15	getChannels :: Model [Channel]
-	16	getChannels =
-	17	queryNoParams ["SELECT *"
-	18	,"FROM channel"]

Remove file src/Amelie/Model/Irclogs.hs 33188

-	1	{-# LANGUAGE ViewPatterns #-}
-	2	{-# LANGUAGE OverloadedStrings #-}
-	3	{-# OPTIONS -fno-warn-name-shadowing #-}
-	4
-	5	module Amelie.Model.Irclogs where
-	6
-	7	import Amelie.Types
-	8
-	9	import Control.Applicative
-	10	import Control.Arrow
-	11	import Control.Monad.IO
-	12	import Control.Monad.Reader
-	13	import Data.ByteString (ByteString)
-	14	import qualified Data.ByteString as S
-	15	import Data.Char
-	16	import Data.Either
-	17	import Data.List (find)
-	18	import Data.List.Utils
-	19	import Data.Maybe
-	20	import Data.Monoid.Operator ((++))
-	21	import Data.Text (Text)
-	22	import qualified Data.Text as T
-	23	import Data.Text.Encoding
-	24	import Data.Text.Encoding.Error (lenientDecode)
-	25	import Data.Time
-	26	import Network.Curl.Download
-	27	import Prelude hiding ((++))
-	28	import System.Directory
-	29	import System.FilePath
-	30	import System.Locale
-	31
-	32	-- \| Get IRC logs for the given channel narrowed down to the given date/time.
-	33	getNarrowedLogs :: String -- ^ Channel name.
-	34	-> String -- ^ Date.
-	35	-> String -- ^ Time.
-	36	-> Controller (Either String [Text])
-	37	getNarrowedLogs channel year time = do
-	38	case parseIrcDate year of
-	39	Nothing -> return $ Left $ "Unable to parse year: " ++ year
-	40	Just date -> do
-	41	days <- mapM (getLogs channel . showIrcDate) [addDays (-1) date,date,addDays 1 date]
-	42	let events = concat (rights days)
-	43	return (Right (fromMaybe events
-	44	(narrowBy (T.isPrefixOf datetime) events <\|>
-	45	narrowBy (T.isPrefixOf dateminute) events <\|>
-	46	narrowBy (T.isPrefixOf datehour) events <\|>
-	47	narrowBy (T.isPrefixOf datestr) events <\|>
-	48	narrowBy (T.isPrefixOf dateday) events)))
-	49
-	50	where narrowBy pred events =
-	51	case find pred (filter crap events) of
-	52	Nothing -> Nothing
-	53	Just _res -> Just $ narrow count pred (filter crap events)
-	54	count = 50
-	55	datetime = T.pack $ year ++ "-" ++ replace "-" ":" time
-	56	dateminute = T.pack $ year ++ "-" ++ replace "-" ":" (reverse . drop 2 . reverse $ time)
-	57	datehour = T.pack $ year ++ "-" ++ replace "-" ":" (reverse . drop 5 . reverse $ time)
-	58	datestr = T.pack $ year ++ "-"
-	59	dateday = T.pack $ reverse . drop 2 . reverse $ year
-	60	crap = not . T.isPrefixOf " --- " . T.dropWhile (not . isSpace)
-	61
-	62	-- \| Narrow to surrounding predicate.
-	63	narrow :: Int -> (a -> Bool) -> [a] -> [a]
-	64	narrow n f = uncurry (++) . (reverse . take n . reverse *** take n) . break f
-	65
-	66	-- \| Get IRC logs for the given channel and date.
-	67	getLogs :: String -- ^ Channel name.
-	68	-> String -- ^ Date.
-	69	-> Controller (Either String [Text])
-	70	getLogs channel year = do
-	71	dir <- asks $ configIrcDir . controllerStateConfig
-	72	io $ do
-	73	now <- fmap (showIrcDate . utctDay) getCurrentTime
-	74	result <- openURICached (year == now) (file dir) uri
-	75	case result of
-	76	Left err -> return $ Left $ uri ++ ": " ++ err
-	77	Right bytes -> return $ Right (map addYear (T.lines (decodeUtf8With lenientDecode bytes)))
-	78
-	79	where uri = "http://tunes.org/~nef/logs/" ++ channel ++ "/" ++ yearStr
-	80	file dir = dir </> channel ++ "-" ++ yearStr
-	81	yearStr = replace "-" "." (drop 2 year)
-	82	addYear line = T.pack year ++ "-" ++ line
-	83
-	84	-- \| Open the URI and cache the result.
-	85	openURICached :: Bool -> FilePath -> String -> IO (Either String ByteString)
-	86	openURICached noCache path url = do
-	87	exists <- doesFileExist path
-	88	if exists && not noCache
-	89	then fmap Right $ S.readFile path
-	90	else do result <- openURI url
-	91	case result of
-	92	Right bytes -> S.writeFile path bytes
-	93	_ -> return ()
-	94	return result
-	95
-	96	-- \| Parse an IRC date string into a date.
-	97	parseIrcDate :: String -> Maybe Day
-	98	parseIrcDate = parseTime defaultTimeLocale "%Y-%m-%d"
-	99
-	100	-- \| Show a date to an IRC date format.
-	101	showIrcDate :: Day -> String
-	102	showIrcDate = formatTime defaultTimeLocale "%Y-%m-%d"
-	103
-	104	-- \| Show a date to an IRC date format.
-	105	showIrcDateTime :: UTCTime -> String
-	106	showIrcDateTime =
-	107	formatTime defaultTimeLocale "%Y-%m-%d/%H-%M-%S" . addUTCTime ((4060)+((-9)60*60))

Remove file src/Amelie/Model/Language.hs 33188

-	1	{-# OPTIONS -Wall #-}
-	2	{-# LANGUAGE OverloadedStrings #-}
-	3	{-# LANGUAGE RecordWildCards #-}
-	4
-	5	-- \| Language model.
-	6
-	7	module Amelie.Model.Language
-	8	(getLanguages)
-	9	where
-	10
-	11	import Amelie.Types
-	12	import Amelie.Model
-	13
-	14	-- \| Get the languages.
-	15	getLanguages :: Model [Language]
-	16	getLanguages =
-	17	queryNoParams ["SELECT id,name,title"
-	18	,"FROM language"
-	19	,"WHERE visible"
-	20	,"ORDER BY ordinal,title ASC"]

Remove file src/Amelie/Model/Paste.hs 33188

-	1	{-# LANGUAGE BangPatterns #-}
-	2	{-# LANGUAGE OverloadedStrings #-}
-	3	{-# LANGUAGE RecordWildCards #-}
-	4	{-# LANGUAGE ScopedTypeVariables #-}
-	5	{-# LANGUAGE ViewPatterns #-}
-	6	{-# OPTIONS -Wall -fno-warn-name-shadowing #-}
-	7
-	8	-- \| Paste model.
-	9
-	10	module Amelie.Model.Paste
-	11	(getLatestPastes
-	12	,getPasteById
-	13	,createOrUpdate
-	14	,createPaste
-	15	,getAnnotations
-	16	,getRevisions
-	17	,getSomePastes
-	18	,countPublicPastes
-	19	,generateHints
-	20	,getHints
-	21	,validNick)
-	22	where
-	23
-	24	import Amelie.Types
-	25	import Amelie.Model
-	26	import Amelie.Model.Announcer
-	27
-	28	import Control.Applicative ((<$>),(<\|>))
-	29	import Control.Exception as E
-	30	import Control.Monad
-	31	import Control.Monad.Env
-	32	import Control.Monad.IO
-	33	import Data.Char
-	34	import Data.List (find,intercalate)
-	35	import Data.Maybe (fromMaybe,listToMaybe)
-	36	import Data.Monoid.Operator ((++))
-	37	import Data.Text (Text,unpack,pack)
-	38	import Data.Text.IO as T (writeFile)
-	39	import Data.Text.Lazy (fromStrict)
-	40	import Language.Haskell.HLint
-	41	import Prelude hiding ((++))
-	42	import System.Directory
-	43	import System.FilePath
-	44
-	45	-- \| Count public pastes.
-	46	countPublicPastes :: Maybe String -> Model Integer
-	47	countPublicPastes mauthor = do
-	48	rows <- single ["SELECT COUNT(*)"
-	49	,"FROM public_toplevel_paste"
-	50	,"WHERE (? IS NULL) OR (author = ?)"]
-	51	(mauthor,mauthor)
-	52	return $ fromMaybe 0 rows
-	53
-	54	-- \| Get the latest pastes.
-	55	getLatestPastes :: Model [Paste]
-	56	getLatestPastes =
-	57	queryNoParams ["SELECT *"
-	58	,"FROM public_toplevel_paste"
-	59	,"ORDER BY id DESC"
-	60	,"LIMIT 20"]
-	61
-	62	-- \| Get some paginated pastes.
-	63	getSomePastes :: Maybe String -> Pagination -> Model [Paste]
-	64	getSomePastes mauthor Pagination{..} =
-	65	query ["SELECT *"
-	66	,"FROM public_toplevel_paste"
-	67	,"WHERE (? IS NULL) OR (author = ?)"
-	68	,"ORDER BY id DESC"
-	69	,"OFFSET " ++ show (max 0 (pnPage - 1) * pnLimit)
-	70	,"LIMIT " ++ show pnLimit]
-	71	(mauthor,mauthor)
-	72
-	73	-- \| Get a paste by its id.
-	74	getPasteById :: PasteId -> Model (Maybe Paste)
-	75	getPasteById pid =
-	76	listToMaybe <$> query ["SELECT *"
-	77	,"FROM public_paste"
-	78	,"WHERE id = ?"]
-	79	(Only pid)
-	80
-	81	-- \| Get annotations of a paste.
-	82	getAnnotations :: PasteId -> Model [Paste]
-	83	getAnnotations pid =
-	84	query ["SELECT *"
-	85	,"FROM public_paste"
-	86	,"WHERE annotation_of = ?"
-	87	,"ORDER BY id ASC"]
-	88	(Only pid)
-	89
-	90	-- \| Get revisions of a paste.
-	91	getRevisions :: PasteId -> Model [Paste]
-	92	getRevisions pid = do
-	93	query ["SELECT *"
-	94	,"FROM public_paste"
-	95	,"WHERE revision_of = ? or id = ?"
-	96	,"ORDER BY id DESC"]
-	97	(pid,pid)
-	98
-	99	-- \| Create a paste, or update an existing one.
-	100	createOrUpdate :: [Language] -> [Channel] -> PasteSubmit -> Model (Maybe PasteId)
-	101	createOrUpdate langs chans paste@PasteSubmit{..} = do
-	102	case pasteSubmitId of
-	103	Nothing -> createPaste langs chans paste
-	104	Just pid -> do updatePaste pid paste
-	105	return $ Just pid
-	106
-	107	-- \| Create a new paste (possibly annotating an existing one).
-	108	createPaste :: [Language] -> [Channel] -> PasteSubmit -> Model (Maybe PasteId)
-	109	createPaste langs chans ps@PasteSubmit{..} = do
-	110	res <- single ["INSERT INTO paste"
-	111	,"(title,author,content,channel,language,annotation_of,revision_of)"
-	112	,"VALUES"
-	113	,"(?,?,?,?,?,?,?)"
-	114	,"returning id"]
-	115	(pasteSubmitTitle,pasteSubmitAuthor,pasteSubmitPaste
-	116	,pasteSubmitChannel,pasteSubmitLanguage,ann_pid,rev_pid)
-	117	when (lang == Just "haskell") $ just res $ createHints ps
-	118	just (pasteSubmitChannel >>= lookupChan) $ \chan ->
-	119	just res $ \pid -> do
-	120	announcePaste pasteSubmitType (channelName chan) ps pid
-	121	return (pasteSubmitId <\|> res)
-	122
-	123	where lookupChan cid = find ((==cid).channelId) chans
-	124	lookupLang lid = find ((==lid).languageId) langs
-	125	lang = pasteSubmitLanguage >>= (fmap languageName . lookupLang)
-	126	just j m = maybe (return ()) m j
-	127	ann_pid = case pasteSubmitType of AnnotationOf pid -> Just pid; _ -> Nothing
-	128	rev_pid = case pasteSubmitType of RevisionOf pid -> Just pid; _ -> Nothing
-	129
-	130	-- \| Create the hints for a paste.
-	131	createHints :: PasteSubmit -> PasteId -> Model ()
-	132	createHints ps pid = do
-	133	hints <- generateHintsForPaste ps pid
-	134	forM_ hints $ \hint ->
-	135	exec ["INSERT INTO hint"
-	136	,"(paste,type,content)"
-	137	,"VALUES"
-	138	,"(?,?,?)"]
-	139	(pid
-	140	,suggestionSeverity hint
-	141	,show hint)
-	142
-	143	-- \| Announce the paste.
-	144	announcePaste :: PasteType -> Text -> PasteSubmit -> PasteId -> Model ()
-	145	announcePaste ptype channel PasteSubmit{..} pid = do
-	146	conf <- env modelStateConfig
-	147	verb <- getVerb
-	148	announce (fromStrict channel) $ fromStrict $ do
-	149	nick ++ " " ++ verb ++ " “" ++ pasteSubmitTitle ++ "” at " ++ link conf
-	150	where nick \| validNick (unpack pasteSubmitAuthor) = pasteSubmitAuthor
-	151	\| otherwise = "“" ++ pasteSubmitAuthor ++ "”"
-	152	link Config{..} = "http://" ++ pack configDomain ++ "/" ++ pid'
-	153	pid' = case ptype of
-	154	NormalPaste -> showPid pid
-	155	AnnotationOf apid -> showPid apid ++ "#a" ++ showPid pid
-	156	RevisionOf apid -> showPid apid
-	157	getVerb = case ptype of
-	158	NormalPaste -> return $ "pasted"
-	159	AnnotationOf pid -> do
-	160	paste <- getPasteById pid
-	161	return $ case paste of
-	162	Just Paste{..} -> "annotated “" ++ pasteTitle ++ "” with"
-	163	Nothing -> "annotated a paste with"
-	164	RevisionOf pid -> do
-	165	paste <- getPasteById pid
-	166	return $ case paste of
-	167	Just Paste{..} -> "revised “" ++ pasteTitle ++ "”:"
-	168	Nothing -> "revised a paste:"
-	169	showPid p = pack $ show $ (fromIntegral p :: Integer)
-	170
-	171	-- \| Is a nickname valid? Digit/letter or one of these: -_/\\;()[]{}?`'
-	172	validNick :: String -> Bool
-	173	validNick s = first && all ok s && length s > 0 where
-	174	ok c = isDigit c \|\| isLetter c \|\| elem c "-_/\\;()[]{}?`'"
-	175	first = all (\c -> isDigit c \|\| isLetter c) $ take 1 s
-	176
-	177	-- \| Get hints for a Haskell paste from hlint.
-	178	generateHintsForPaste :: PasteSubmit -> PasteId -> Model [Suggestion]
-	179	generateHintsForPaste PasteSubmit{..} (fromIntegral -> pid :: Integer) = io $
-	180	E.catch (generateHints (show pid) pasteSubmitPaste)
-	181	(\(SomeException e) -> return [])
-	182
-	183	-- \| Get hints for a Haskell paste from hlint.
-	184	generateHints :: FilePath -> Text -> IO [Suggestion]
-	185	generateHints pid contents = io $ do
-	186	tmpdir <- getTemporaryDirectory
-	187	let tmp = tmpdir </> pid ++ ".hs"
-	188	exists <- doesFileExist tmp
-	189	unless exists $ T.writeFile tmp $ contents
-	190	!hints <- hlint [tmp,"--quiet","--ignore=Parse error"]
-	191	return hints
-	192
-	193	getHints :: PasteId -> Model [Hint]
-	194	getHints pid =
-	195	query ["SELECT type,content"
-	196	,"FROM hint"
-	197	,"WHERE paste = ?"]
-	198	(Only pid)
-	199
-	200	-- \| Update an existing paste.
-	201	updatePaste :: PasteId -> PasteSubmit -> Model ()
-	202	updatePaste pid PasteSubmit{..} = do
-	203	_ <- exec (["UPDATE paste"
-	204	,"SET"]
-	205	++
-	206	[intercalate ", " (map set (words fields))]
-	207	++
-	208	["WHERE id = ?"])
-	209	(pasteSubmitTitle
-	210	,pasteSubmitAuthor
-	211	,pasteSubmitPaste
-	212	,pasteSubmitLanguage
-	213	,pasteSubmitChannel
-	214	,pid)
-	215	return ()
-	216
-	217	where fields = "title author content language channel"
-	218	set key = unwords [key,"=","?"]

Remove file src/Amelie/Model/Report.hs 33188

-	1	{-# OPTIONS -Wall -fno-warn-name-shadowing #-}
-	2	{-# LANGUAGE OverloadedStrings #-}
-	3	{-# LANGUAGE RecordWildCards #-}
-	4	{-# LANGUAGE ScopedTypeVariables #-}
-	5	{-# LANGUAGE ViewPatterns #-}
-	6
-	7	-- \| Report model.
-	8
-	9	module Amelie.Model.Report
-	10	(getSomeReports,createReport,countReports)
-	11	where
-	12
-	13	import Amelie.Types
-	14	import Amelie.Model
-	15	import Amelie.Controller.Cache
-	16	import Amelie.Types.Cache as Key
-	17
-	18	import Control.Monad
-	19	import Control.Monad.Trans
-	20	import Control.Monad.Env
-	21	import Control.Monad.IO
-	22	import Data.Maybe
-	23	import Data.Monoid.Operator ((++))
-	24	import qualified Data.Text.Lazy as LT
-	25	import qualified Data.Text as T
-	26	import Prelude hiding ((++))
-	27	import Network.Mail.Mime
-	28
-	29	-- \| Get some paginated reports.
-	30	getSomeReports :: Pagination -> Model [Report]
-	31	getSomeReports Pagination{..} =
-	32	queryNoParams ["SELECT created,paste,comments"
-	33	,"FROM report"
-	34	,"ORDER BY id DESC"
-	35	,"OFFSET " ++ show (max 0 (pnPage - 1) * pnLimit)
-	36	,"LIMIT " ++ show pnLimit]
-	37
-	38	-- \| Count reports.
-	39	countReports :: Model Integer
-	40	countReports = do
-	41	rows <- singleNoParams ["SELECT COUNT(*)"
-	42	,"FROM report"]
-	43	return $ fromMaybe 0 rows
-	44
-	45	-- \| Create a new report.
-	46	createReport :: ReportSubmit -> Model (Maybe ReportId)
-	47	createReport rs@ReportSubmit{..} = do
-	48	res <- single ["INSERT INTO report"
-	49	,"(paste,comments)"
-	50	,"VALUES"
-	51	,"(?,?)"
-	52	,"returning id"]
-	53	(rsPaste,rsComments)
-	54	_ <- exec ["UPDATE paste"
-	55	,"SET public = false"
-	56	,"WHERE id = ?"]
-	57	(Only rsPaste)
-	58	let reset pid = do
-	59	resetCacheModel (Key.Paste (fromIntegral pid))
-	60	resetCacheModel (Key.Revision (fromIntegral pid))
-	61	reset rsPaste
-	62	sendReport rs
-	63	return res
-	64
-	65	sendReport ReportSubmit{..} = do
-	66	conf <- env modelStateConfig
-	67	_ <- io $ simpleMail (configAdmin conf)
-	68	(configSiteAddy conf)
-	69	(T.pack ("Paste reported: #" ++ show rsPaste))
-	70	(LT.pack body)
-	71	(LT.pack body)
-	72	[]
-	73	return ()
-	74
-	75	where body =
-	76	"Paste " ++ show rsPaste ++ "\n\n" ++
-	77	rsComments

Remove file src/Amelie/Controller/Activity.hs 33188

-	1	{-# OPTIONS -Wall #-}
-	2	{-# LANGUAGE OverloadedStrings #-}
-	3
-	4	-- \| Activity page controller.
-	5
-	6	module Amelie.Controller.Activity
-	7	(handle)
-	8	where
-	9
-	10	import Amelie.Controller (outputText)
-	11	import Amelie.Controller.Cache (cache)
-	12	import Amelie.Model
-	13	import Amelie.Model.Activity (getCommits)
-	14	import Amelie.Types.Cache as Key
-	15	import Amelie.View.Activity (page)
-	16
-	17	import Control.Monad.Env (env)
-	18
-	19	-- \| Display commit history.
-	20	handle :: Controller ()
-	21	handle = do
-	22	html <- cache Key.Activity $ do
-	23	uri <- env $ configCommits . controllerStateConfig
-	24	repourl <- env $ configRepoURL . controllerStateConfig
-	25	commits <- model $ getCommits uri
-	26	return $ Just $ page repourl commits
-	27	maybe (return ()) outputText html

Remove file src/Amelie/Controller/Browse.hs 33188

-	1	{-# OPTIONS -Wall #-}
-	2	{-# LANGUAGE OverloadedStrings #-}
-	3
-	4	-- \| Browse page controller.
-	5
-	6	module Amelie.Controller.Browse
-	7	(handle)
-	8	where
-	9
-	10	import Amelie.Controller (output,getPagination,getStringMaybe)
-	11	import Amelie.Model
-	12	import Amelie.Model.Channel (getChannels)
-	13	import Amelie.Model.Language (getLanguages)
-	14	import Amelie.Model.Paste (getSomePastes,countPublicPastes)
-	15	import Amelie.View.Browse (page)
-	16
-	17	-- \| Browse all pastes.
-	18	handle :: Controller ()
-	19	handle = do
-	20	pn <- getPagination
-	21	author <- getStringMaybe "author"
-	22	total <- model $ countPublicPastes author
-	23	pastes <- model $ getSomePastes author pn
-	24	let pn' = pn { pnResults = fromIntegral (length pastes)
-	25	, pnTotal = total }
-	26	chans <- model getChannels
-	27	langs <- model getLanguages
-	28	output $ page pn' chans langs pastes author

Remove file src/Amelie/Controller/Cache.hs 33188

-	1	{-# OPTIONS -Wall -fno-warn-name-shadowing #-}
-	2
-	3	-- \| HTML caching.
-	4
-	5	module Amelie.Controller.Cache
-	6	(newCache
-	7	,cache
-	8	,cacheIf
-	9	,resetCache
-	10	,resetCacheModel)
-	11	where
-	12
-	13	import Amelie.Types (Controller,ControllerState(..))
-	14	import Amelie.Types.Cache
-	15	import Amelie.Types.Config
-	16	import Amelie.Types.MVC
-	17
-	18	import Control.Concurrent
-	19	import Control.Monad.IO (io)
-	20	import Control.Monad
-	21	import Control.Monad.Reader (asks)
-	22	import qualified Data.Map as M
-	23	import Data.Text.Lazy (Text)
-	24	import qualified Data.Text.Lazy.IO as T
-	25	import System.Directory
-	26	import Text.Blaze.Html5 (Html)
-	27	import Text.Blaze.Renderer.Text (renderHtml)
-	28
-	29	-- \| Create a new cache.
-	30	newCache :: IO Cache
-	31	newCache = do
-	32	var <- newMVar M.empty
-	33	return $ Cache var
-	34
-	35	-- \| Cache conditionally.
-	36	cacheIf :: Bool -> Key -> Controller (Maybe Html) -> Controller (Maybe Text)
-	37	cacheIf pred key generate =
-	38	if pred
-	39	then cache key generate
-	40	else fmap (fmap renderHtml) generate
-	41
-	42	-- \| Generate and save into the cache, or retrieve existing from the
-	43	-- \| cache.
-	44	cache :: Key -> Controller (Maybe Html) -> Controller (Maybe Text)
-	45	cache key generate = do
-	46	Cache var <- asks controllerStateCache
-	47	tmpdir <- asks (configCacheDir . controllerStateConfig)
-	48	let cachePath = tmpdir ++ "/" ++ keyToString key
-	49	exists <- io $ doesFileExist cachePath
-	50	if exists
-	51	then do text <- io $ T.readFile cachePath
-	52	return (Just text)
-	53	else do text <- fmap (fmap renderHtml) generate
-	54	case text of
-	55	Just text' -> do io $ T.writeFile cachePath text'
-	56	return text
-	57	Nothing -> return text
-	58
-	59	-- \| Reset an item in the cache.
-	60	resetCache :: Key -> Controller ()
-	61	resetCache key = do
-	62	tmpdir <- asks (configCacheDir . controllerStateConfig)
-	63	io $ do
-	64	let cachePath = tmpdir ++ "/" ++ keyToString key
-	65	exists <- io $ doesFileExist cachePath
-	66	when exists $ removeFile cachePath
-	67
-	68	-- \| Reset an item in the cache.
-	69	resetCacheModel :: Key -> Model ()
-	70	resetCacheModel key = do
-	71	tmpdir <- asks (configCacheDir . modelStateConfig)
-	72	io $ do
-	73	let cachePath = tmpdir ++ "/" ++ keyToString key
-	74	exists <- io $ doesFileExist cachePath
-	75	when exists $ removeFile cachePath
-	76
-	77	keyToString :: Key -> String
-	78	keyToString Home = "home.html"
-	79	keyToString Activity = "activity.html"
-	80	keyToString (Paste i) = "paste-" ++ show i ++ ".html"
-	81	keyToString (Revision i) = "revision-" ++ show i ++ ".html"

Remove file src/Amelie/Controller/Diff.hs 33188

-	1	{-# OPTIONS -Wall #-}
-	2	{-# LANGUAGE OverloadedStrings #-}
-	3	{-# LANGUAGE ScopedTypeVariables #-}
-	4
-	5	-- \| Diff page controller.
-	6
-	7	module Amelie.Controller.Diff
-	8	(handle)
-	9	where
-	10
-	11	import Amelie.Controller
-	12	import Amelie.Controller.Paste (withPasteKey)
-	13	import Amelie.Model
-	14	import Amelie.View.Diff (page)
-	15
-	16	-- \| Diff one paste with another.
-	17	handle :: Controller ()
-	18	handle = do
-	19	withPasteKey "this" $ \this ->
-	20	withPasteKey "that" $ \that ->
-	21	output $ page this that

Remove file src/Amelie/Controller/Home.hs 33188

-	1	{-# OPTIONS -Wall #-}
-	2	{-# LANGUAGE OverloadedStrings #-}
-	3
-	4	-- \| Home page controller.
-	5
-	6	module Amelie.Controller.Home
-	7	(handle)
-	8	where
-	9
-	10	import Amelie.Controller (outputText,getMyURI)
-	11	import Amelie.Controller.Cache (cache)
-	12	import Amelie.Controller.Paste (pasteForm)
-	13	import Amelie.Model
-	14	import Amelie.Model.Channel (getChannels)
-	15	import Amelie.Model.Language (getLanguages)
-	16	import Amelie.Model.Paste (getLatestPastes)
-	17	import Amelie.Types.Cache as Key
-	18	import Amelie.View.Home (page)
-	19
-	20	-- \| Handle the home page, display a simple list and paste form.
-	21	handle :: Controller ()
-	22	handle = do
-	23	html <- cache Key.Home $ do
-	24	pastes <- model $ getLatestPastes
-	25	chans <- model $ getChannels
-	26	langs <- model $ getLanguages
-	27	form <- pasteForm chans langs Nothing Nothing Nothing
-	28	uri <- getMyURI
-	29	return $ Just $ page uri chans langs pastes form
-	30	maybe (return ()) outputText html

Remove file src/Amelie/Controller/Irclogs.hs 33188

-	1	{-# OPTIONS -Wall #-}
-	2	{-# LANGUAGE OverloadedStrings #-}
-	3
-	4	-- \| Irclogs page controller.
-	5
-	6	module Amelie.Controller.Irclogs
-	7	(handle)
-	8	where
-	9
-	10	import Amelie.Controller
-	11	import Amelie.Model.Irclogs
-	12	import Amelie.Types
-	13	import Amelie.View.Irclogs (page)
-	14
-	15	import Data.String.ToString
-	16	import Data.String
-	17	import Snap.Types
-	18	import Safe
-	19
-	20	handle :: Controller ()
-	21	handle = do
-	22	channel <- get "channel"
-	23	date <- get "date"
-	24	time <- get "timestamp"
-	25	pasteid <- getMaybe "paste"
-	26	logs <- getNarrowedLogs channel date time
-	27	output $ page channel date time logs pasteid
-	28
-	29	where get key = do
-	30	value <- fmap (fmap toString) $ getParam (fromString key)
-	31	case value of
-	32	Nothing -> error $ "Missing parameter: " ++ key
-	33	Just value -> return value
-	34	getMaybe key = fmap ((>>= readMay) . fmap toString) $ getParam (fromString key)

Remove file src/Amelie/Controller/New.hs 33188

-	1	{-# OPTIONS -Wall -fno-warn-name-shadowing #-}
-	2	{-# LANGUAGE OverloadedStrings #-}
-	3
-	4	-- \| Create new paste controller.
-	5
-	6	module Amelie.Controller.New
-	7	(handle,NewStyle(..))
-	8	where
-	9
-	10	import Amelie.Controller
-	11	import Amelie.Controller.Paste (pasteForm,getPasteId)
-	12	import Amelie.Model
-	13	import Amelie.Model.Channel (getChannels)
-	14	import Amelie.Model.Language (getLanguages)
-	15	import Amelie.Model.Paste (getPasteById)
-	16	import Amelie.View.Annotate as Annotate (page)
-	17	import Amelie.View.Edit as Edit (page)
-	18	import Amelie.View.New as New (page)
-	19
-	20	import Control.Applicative
-	21	import Data.Text.Encoding (decodeUtf8)
-	22	import Snap.Core
-	23
-	24	data NewStyle = NewPaste \| AnnotatePaste \| EditPaste
-	25	deriving Eq
-	26
-	27	-- \| Make a new paste.
-	28	handle :: NewStyle -> Controller ()
-	29	handle style = do
-	30	chans <- model $ getChannels
-	31	langs <- model $ getLanguages
-	32	defChan <- fmap decodeUtf8 <$> getParam "channel"
-	33	pid <- if style == NewPaste then return Nothing else getPasteId
-	34	case pid of
-	35	Just pid -> do
-	36	paste <- model $ getPasteById (fromIntegral pid)
-	37	let apaste \| style == AnnotatePaste = paste
-	38	\| otherwise = Nothing
-	39	let epaste \| style == EditPaste = paste
-	40	\| otherwise = Nothing
-	41	form <- pasteForm chans langs defChan apaste epaste
-	42	justOrGoHome paste $ \paste -> do
-	43	case style of
-	44	AnnotatePaste -> output $ Annotate.page paste form
-	45	EditPaste -> output $ Edit.page paste form
-	46	_ -> goHome
-	47	Nothing -> do
-	48	form <- pasteForm chans langs defChan Nothing Nothing
-	49	output $ New.page form

Remove file src/Amelie/Controller/Paste.hs 33188

-	1	{-# OPTIONS -Wall -fno-warn-name-shadowing #-}
-	2	{-# LANGUAGE OverloadedStrings #-}
-	3	{-# LANGUAGE ScopedTypeVariables #-}
-	4
-	5	-- \| Paste controller.
-	6
-	7	module Amelie.Controller.Paste
-	8	(handle
-	9	,pasteForm
-	10	,getPasteId
-	11	,getPasteIdKey
-	12	,withPasteKey)
-	13	where
-	14
-	15	import Amelie.Types
-	16
-	17	import Amelie.Controller
-	18	import Amelie.Controller.Cache (cache,cacheIf,resetCache)
-	19	import Amelie.Model
-	20	import Amelie.Model.Channel (getChannels)
-	21	import Amelie.Model.Language (getLanguages)
-	22	import Amelie.Model.Paste
-	23	import Amelie.Types.Cache as Key
-	24	import Amelie.View.Paste (pasteFormlet,page)
-	25
-	26	import Control.Applicative
-	27	import Control.Monad ((>=>))
-	28	import Data.ByteString (ByteString)
-	29	import Data.ByteString.UTF8 (toString)
-	30	import Data.Maybe
-	31	import Data.Monoid.Operator ((++))
-	32	import Data.String (fromString)
-	33	import Data.Text (Text)
-	34	import Prelude hiding ((++))
-	35	import Safe
-	36	import Snap.Core
-	37	import Text.Blaze.Html5 as H hiding (output)
-	38	import Text.Formlet
-	39
-	40	-- \| Handle the paste page.
-	41	handle :: Bool -> Controller ()
-	42	handle revision = do
-	43	pid <- getPasteId
-	44	justOrGoHome pid $ \(pid :: Integer) -> do
-	45	html <- cache (if revision then Key.Revision pid else Key.Paste pid) $ do
-	46	paste <- model $ getPasteById (fromIntegral pid)
-	47	case paste of
-	48	Nothing -> return Nothing
-	49	Just paste -> do
-	50	hints <- model $ getHints (pasteId paste)
-	51	annotations <- model $ getAnnotations (fromIntegral pid)
-	52	revisions <- model $ getRevisions (fromIntegral pid)
-	53	ahints <- model $ mapM (getHints.pasteId) annotations
-	54	rhints <- model $ mapM (getHints.pasteId) revisions
-	55	chans <- model $ getChannels
-	56	langs <- model $ getLanguages
-	57	return $ Just $ page PastePage {
-	58	ppChans = chans
-	59	, ppLangs = langs
-	60	, ppAnnotations = annotations
-	61	, ppRevisions = revisions
-	62	, ppHints = hints
-	63	, ppPaste = paste
-	64	, ppAnnotationHints = ahints
-	65	, ppRevisionsHints = rhints
-	66	, ppRevision = revision
-	67	}
-	68	justOrGoHome html outputText
-	69
-	70	-- \| Control paste annotating / submission.
-	71	pasteForm :: [Channel] -> [Language] -> Maybe Text -> Maybe Paste -> Maybe Paste -> Controller Html
-	72	pasteForm channels languages defChan annotatePaste editPaste = do
-	73	params <- getParams
-	74	submitted <- isJust <$> getParam "submit"
-	75	revisions <- maybe (return []) (model . getRevisions) (fmap pasteId (annotatePaste <\|> editPaste))
-	76	let formlet = PasteFormlet {
-	77	pfSubmitted = submitted
-	78	, pfErrors = []
-	79	, pfParams = params
-	80	, pfChannels = channels
-	81	, pfLanguages = languages
-	82	, pfDefChan = defChan
-	83	, pfAnnotatePaste = annotatePaste
-	84	, pfEditPaste = editPaste
-	85	, pfContent = fmap pastePaste (listToMaybe revisions)
-	86	}
-	87	(getValue,_) = pasteFormlet formlet
-	88	value = formletValue getValue params
-	89	errors = either id (const []) value
-	90	(_,html) = pasteFormlet formlet { pfErrors = errors }
-	91	val = either (const Nothing) Just $ value
-	92	case val of
-	93	Nothing -> return ()
-	94	Just PasteSubmit{pasteSubmitSpamTrap=Just{}} -> goHome
-	95	Just paste -> do
-	96	resetCache Key.Home
-	97	maybe (return ()) (resetCache . Key.Paste . fromIntegral) $ pasteSubmitId paste
-	98	pid <- model $ createPaste languages channels paste
-	99	maybe (return ()) redirectToPaste pid
-	100	return html
-	101
-	102	-- \| Redirect to the paste's page.
-	103	redirectToPaste :: PasteId -> Controller ()
-	104	redirectToPaste (PasteId pid) =
-	105	redirect $ "/" ++ fromString (show pid)
-	106
-	107	-- \| Get the paste id.
-	108	getPasteId :: Controller (Maybe Integer)
-	109	getPasteId = (fmap toString >=> readMay) <$> getParam "id"
-	110
-	111	-- \| Get the paste id by a key.
-	112	getPasteIdKey :: ByteString -> Controller (Maybe Integer)
-	113	getPasteIdKey key = (fmap toString >=> readMay) <$> getParam key
-	114
-	115	-- \| With the
-	116	withPasteKey :: ByteString -> (Paste -> Controller a) -> Controller ()
-	117	withPasteKey key with = do
-	118	pid <- getPasteIdKey key
-	119	justOrGoHome pid $ \(pid :: Integer) -> do
-	120	paste <- model $ getPasteById (fromIntegral pid)
-	121	justOrGoHome paste $ \paste -> do
-	122	_ <- with paste
-	123	return ()

Remove file src/Amelie/Controller/Raw.hs 33188

-	1	{-# OPTIONS -Wall -fno-warn-name-shadowing #-}
-	2	{-# LANGUAGE OverloadedStrings #-}
-	3	{-# LANGUAGE ScopedTypeVariables #-}
-	4
-	5	-- \| Raw controller.
-	6
-	7	module Amelie.Controller.Raw
-	8	(handle)
-	9	where
-	10
-	11	import Amelie.Types
-	12
-	13	import Amelie.Controller
-	14	import Amelie.Model
-	15	import Amelie.Model.Paste (getPasteById)
-	16
-	17	import Control.Applicative
-	18	import Data.ByteString.UTF8 (toString)
-	19	import Data.Maybe
-	20	import Data.Text.Lazy (fromStrict)
-	21	import Prelude hiding ((++))
-	22	import Safe
-	23	import Snap.Core
-	24
-	25	-- \| Handle the paste page.
-	26	handle :: Controller ()
-	27	handle = do
-	28	pid <- (>>= readMay) . fmap (toString) <$> getParam "id"
-	29	case pid of
-	30	Nothing -> goHome
-	31	Just (pid :: Integer) -> do
-	32	modifyResponse $ setContentType "text/plain; charset=UTF-8"
-	33	paste <- model $ getPasteById (fromIntegral pid)
-	34	maybe goHome (outputText . fromStrict . pastePaste) paste

Remove file src/Amelie/Controller/Report.hs 33188

-	1	{-# OPTIONS -Wall -fno-warn-name-shadowing #-}
-	2	{-# LANGUAGE OverloadedStrings #-}
-	3	{-# LANGUAGE ScopedTypeVariables #-}
-	4	{-# LANGUAGE RecordWildCards #-}
-	5
-	6	-- \| Report controller.
-	7
-	8	module Amelie.Controller.Report
-	9	(handle)
-	10	where
-	11
-	12	import Amelie.Controller
-	13	import Amelie.Model
-	14	import Amelie.Model.Paste (getPasteById)
-	15	import Amelie.Model.Report
-	16	import Amelie.View.Report
-	17	import qualified Amelie.View.Thanks as Thanks
-	18	import Amelie.Types.Cache as Key
-	19	import Amelie.Controller.Cache (resetCache)
-	20
-	21	import Control.Applicative
-	22	import Data.ByteString.UTF8 (toString)
-	23	import Data.Maybe
-	24	import Data.Monoid.Operator ((++))
-	25	import Data.Text (unpack)
-	26	import Prelude hiding ((++))
-	27	import Safe
-	28	import Snap.Core
-	29	import Text.Blaze.Html5 as H hiding (output,map,body)
-	30	import Text.Formlet
-	31
-	32	-- \| Handle the report/delete page.
-	33	handle :: Controller ()
-	34	handle = do
-	35	pid <- (>>= readMay) . fmap (toString) <$> getParam "id"
-	36	case pid of
-	37	Nothing -> goHome
-	38	Just (pid :: Integer) -> do
-	39	paste <- model $ getPasteById (fromIntegral pid)
-	40	(frm,val) <- exprForm
-	41	case val of
-	42	Just comment -> do
-	43	_ <- model $ createReport ReportSubmit { rsPaste = fromIntegral pid
-	44	, rsComments = comment }
-	45	resetCache Key.Home
-	46	output $ Thanks.page "Reported" $
-	47	"Thanks, your comments have " ++
-	48	"been reported to the administrator."
-	49	Nothing -> maybe goHome (output . page frm) paste
-	50
-	51	-- \| Report form.
-	52	exprForm :: Controller (Html,Maybe String)
-	53	exprForm = do
-	54	params <- getParams
-	55	submitted <- isJust <$> getParam "submit"
-	56	let formlet = ReportFormlet {
-	57	rfSubmitted = submitted
-	58	, rfParams = params
-	59	}
-	60	(getValue,_) = reportFormlet formlet
-	61	value = formletValue getValue params
-	62	(_,html) = reportFormlet formlet
-	63	val = either (const Nothing) Just $ value
-	64	return (html,fmap unpack val)

Remove file src/Amelie/Controller/Reported.hs 33188

-	1	{-# OPTIONS -Wall #-}
-	2	{-# LANGUAGE OverloadedStrings #-}
-	3
-	4	-- \| Reported page controller.
-	5
-	6	module Amelie.Controller.Reported
-	7	(handle)
-	8	where
-	9
-	10	import Amelie.Controller (output,getPagination)
-	11	import Amelie.Model
-	12	import Amelie.Model.Report (getSomeReports,countReports)
-	13	import Amelie.View.Reported (page)
-	14
-	15	-- \| List the reported pastes.
-	16	handle :: Controller ()
-	17	handle = do
-	18	pn <- getPagination
-	19	total <- model countReports
-	20	reports <- model $ getSomeReports pn
-	21	let pn' = pn { pnResults = fromIntegral (length reports)
-	22	, pnTotal = total }
-	23	output $ page pn' reports

Remove file src/Amelie/Controller/Script.hs 33188

-	1	{-# OPTIONS -Wall #-}
-	2	{-# LANGUAGE OverloadedStrings #-}
-	3
-	4	-- \| JavaScript controller.
-	5
-	6	module Amelie.Controller.Script
-	7	(handle)
-	8	where
-	9
-	10	import Amelie.Controller (outputText)
-	11	import Amelie.Model
-	12	import Amelie.View.Script (script)
-	13
-	14	import Snap.Core (modifyResponse,setContentType)
-	15
-	16	handle :: Controller ()
-	17	handle = do
-	18	modifyResponse $ setContentType "text/javascript"
-	19	outputText $ script

Remove file src/Amelie/Controller/Style.hs 33188

-	1	{-# OPTIONS -Wall #-}
-	2	{-# LANGUAGE OverloadedStrings #-}
-	3
-	4	-- \| Stylesheet controller.
-	5
-	6	module Amelie.Controller.Style
-	7	(handle)
-	8	where
-	9
-	10	import Amelie.Controller (outputText)
-	11	import Amelie.Model
-	12	import Amelie.View.Style (style)
-	13
-	14	import Snap.Core (modifyResponse,setContentType)
-	15
-	16	handle :: Controller ()
-	17	handle = do
-	18	modifyResponse $ setContentType "text/css"
-	19	outputText $ style

Add file src/Snap/App/Controller.hs 33188

+	1	{-# LANGUAGE BangPatterns #-}
+	2	{-# OPTIONS -Wall #-}
+	3	{-# LANGUAGE OverloadedStrings #-}
+	4
+	5	-- \| Controller routing/handling.
+	6
+	7	module Snap.App.Controller
+	8	(runHandler
+	9	,output
+	10	,outputText
+	11	,goHome
+	12	,justOrGoHome
+	13	,getInteger
+	14	,getString
+	15	,getStringMaybe
+	16	,getPagination
+	17	,getMyURI)
+	18	where
+	19
+	20	import Hpaste.Types
+	21	import Hpaste.Types.Cache
+	22
+	23	import Control.Applicative
+	24	import Control.Concurrent.Chan (Chan)
+	25	import Control.Monad.Env
+	26	import Control.Monad.Reader (runReaderT)
+	27	import Data.ByteString (ByteString)
+	28	import Data.ByteString.UTF8 (toString)
+	29	import Data.Maybe
+	30	import Network.URI
+	31	import Data.Text.Lazy (Text,toStrict)
+	32	import Database.PostgreSQL.Base (withPoolConnection)
+	33	import Database.PostgreSQL.Simple (Pool)
+	34	import Safe (readMay)
+	35	import Snap.Core
+	36	import Text.Blaze (Html)
+	37	import Text.Blaze.Renderer.Text (renderHtml)
+	38
+	39	-- \| Run a controller handler.
+	40	runHandler :: Config -> Pool -> Cache -> Chan Text -> Controller () -> Snap ()
+	41	runHandler conf pool cache anns ctrl = do
+	42	withPoolConnection pool $ \conn -> do
+	43	let state = ControllerState conf conn cache anns
+	44	-- Default to HTML, can be overridden.
+	45	modifyResponse $ setContentType "text/html"
+	46	runReaderT (runController ctrl) state
+	47
+	48	-- \| Strictly renders HTML to Text before outputting it via Snap.
+	49	-- This ensures that any lazy exceptions are caught by the Snap
+	50	-- handler.
+	51	output :: Html -> Controller ()
+	52	output html = outputText $ renderHtml $ html
+	53
+	54	-- \| Strictly renders text before outputting it via Snap.
+	55	-- This ensures that any lazy exceptions are caught by the Snap
+	56	-- handler.
+	57	outputText :: Text -> Controller ()
+	58	outputText text = do
+	59	let !x = toStrict $ text
+	60	writeText x
+	61
+	62	-- \| Generic redirect to home page.
+	63	goHome :: Controller ()
+	64	goHome = redirect "/"
+	65
+	66	-- \| Extract a Just value or go home.
+	67	justOrGoHome :: Maybe a -> (a -> Controller ()) -> Controller ()
+	68	justOrGoHome x m = maybe goHome m x
+	69
+	70	-- \| Get integer parmater.
+	71	getInteger :: ByteString -> Integer -> Controller Integer
+	72	getInteger name def = do
+	73	pid <- (>>= readMay . toString) <$> getParam name
+	74	maybe (return def) return pid
+	75
+	76	-- \| Get string.
+	77	getString :: ByteString -> String -> Controller String
+	78	getString name def = do
+	79	pid <- (>>= return . toString) <$> getParam name
+	80	maybe (return def) return pid
+	81
+	82	-- \| Get string (maybe).
+	83	getStringMaybe :: ByteString -> Controller (Maybe String)
+	84	getStringMaybe name = do
+	85	pid <- (>>= return . toString) <$> getParam name
+	86	return pid
+	87
+	88	-- \| Get pagination data.
+	89	getPagination :: Controller Pagination
+	90	getPagination = do
+	91	p <- getInteger "page" 1
+	92	limit <- getInteger "limit" 35
+	93	i <- fmap rqURI getRequest
+	94	uri <- getMyURI
+	95	return Pagination { pnPage = max 1 p
+	96	, pnLimit = max 1 (min 100 limit)
+	97	, pnURI = uri
+	98	, pnResults = 0
+	99	, pnTotal = 0
+	100	}
+	101
+	102	getMyURI :: Controller URI
+	103	getMyURI = do
+	104	domain <- env (configDomain . controllerStateConfig)
+	105	fmap (fromJust .
+	106	parseURI .
+	107	(("http://" ++ domain) ++) .
+	108	toString .
+	109	rqURI)
+	110	getRequest

[See JSON]