,feed          >= 0.3

                    ,download-curl >= 0.1

                    ,Diff          >= 0.1

                    ,css           >= 0.1

                    ,named-formlet >= 0.1

[ANNOUNCE]

user = hpaste

pass = <YOURPASS>

host = 127.0.0.1

port = 6667

import Amelie.Controller.Home     as Home

import Amelie.Controller.New      as New

import Amelie.Controller.Paste    as Paste

import Amelie.Controller.Raw      as Raw

import Amelie.Controller.Script   as Script

import Amelie.Controller.Style    as Style

import Amelie.Model.Announcer     (newAnnouncer)

import Amelie.Types

import Amelie.Types.Cache

serve conf p cache ans = route routes where

  routes = [("/css/amelie.css", run Style.handle)

           ,("/js/amelie.js", run Script.handle)

           ,("/css/",serveDirectory "wwwroot/css")

           ,("/js/",serveDirectory "wwwroot/js")

           ,("",run Home.handle)

           ,("/:id",run Paste.handle)

           ,("/raw/:id",run Raw.handle)

           ,("/new",run New.handle)

           ,("/edit/:id",run New.handle)

           ,("/new/:channel",run New.handle)

           ,("/browse/page/:page/offset/:offset",run Browse.handle)

           ,("/browse/page/:page",run Browse.handle)

           ,("/browse",run Browse.handle)

           ,("/activity",run Activity.handle)

           ,("/diff/:this/:that",run Diff.handle)

           ]

  run = runHandler conf p cache ans

          <- mapM (get c "WEB")

                  ["domain"]

        [commits,url]

          <- mapM (get c "DEV")

                  ["commits","repo_url"]

        return Config {

           configAnnounce = Announcer user pass host (read port)

         , configPostgres = ConnectInfo pghost (read pgport) pguser pgpass pgdb

         , configDomain = domain

         , configCommits = commits

         , configRepoURL = url

         }

  case config of

    Left cperr -> error $ show cperr

    Right config -> return config

  ,output

  ,outputText

  ,goHome

  ,justOrGoHome

  ,getInteger

  ,getPagination)

  where

import Amelie.Types

import Amelie.Types.Cache

-- | Get integer parmater.

getInteger :: ByteString -> Integer -> Controller Integer

getInteger name def = do

  pid <- (>>= readMay . toString) <$> getParam name

  maybe (return def) return pid

-- | Get pagination data.

getPagination :: Controller Pagination

getPagination = do

       ,module Amelie.Types.Language

       ,module Amelie.Types.Page

       ,module Amelie.Types.Newtypes

       ,module Amelie.Types.View

       ,module Amelie.Types.Config

       where

import Amelie.Types.MVC

import Amelie.Types.Paste

import Amelie.Types.Channel

import Amelie.Types.Page

import Amelie.Types.Newtypes

import Amelie.Types.View

import Amelie.Types.Config

import Amelie.Types.Activity

{-# LANGUAGE RecordWildCards #-}

-- | Code highlighting.

module Amelie.View.Highlight

  where

import Amelie.Types

import Amelie.View.Html

import Data.List                     (find)

import Language.Haskell.HsColour.CSS (hscolour)

import Prelude                       hiding ((++))

import Text.Blaze.Html5              as H hiding (map)

-- | Syntax highlight the paste.

  H.table ! aClass "code" $

    td $

      case lang of

        Just (Language{languageName="haskell"}) ->

          preEscapedString $ hscolour False (unpack pastePaste)

  where lang = find ((==pasteLanguage) . Just . languageId) langs

{-# LANGUAGE RecordWildCards #-}

-- | Show hlint suggestions.

module Amelie.View.Hlint

  where

import Amelie.Types

import Amelie.View.Html

                      Ignore  -> \_ -> return ()

                      Warning -> warnNoTitleSection

                      Error   -> errorNoTitleSection

          lns = lines $ clean $ hintContent hint

          clean = dropWhile (==':') . dropWhile (/=':')

-- | List the details of the page in a dark section.

pasteDetails :: [Paste] -> [Channel] -> [Language] -> Paste -> Html

pasteDetails pastes chans langs paste@Paste{..} =

  darkNoTitleSection $ do

    h2 $ toHtml $ fromStrict pasteTitle

    ul ! aClass "paste-specs" $ do

      detail "Paste" $ pasteLink paste $ "#" ++ show pasteId

      detail "Author" $ pasteAuthor

      detail "Language" $ showLanguage langs pasteLanguage

    where detail title content = do

            li $ do strong (title ++ ":"); toHtml content

-- | Individual paste navigation.

  H.div ! aClass "paste-nav" $ do

    diffLink

    href ("/edit/" ++ pack (show pid) ++ "") ("Annotate" :: Text)

    where pid = pasteId paste

          pairs = zip (drop 1 pastes) pastes

          parent = fmap snd $ find ((==pid).pasteId.fst) $ pairs

              Nothing -> return ()

              Just Paste{pasteId=prevId} -> do

                href ("/diff/" ++ show prevId ++ "/" ++ show pid)

                     ("Diff" :: Text)

                " - "

-- | Show the paste content with highlighting.

pasteContent :: [Language] -> Paste -> Html

pasteContent langs paste =

  lightNoTitleSection $ highlightPaste langs paste

-- | Styles for the highlighter.

highlighter :: CSS Rule

highlighter = do

  diff

  classRule "code" $ do

    tokens

    lineNumbers

    rule "pre" $ do

    tokenColor "keyword" "#397460"

    tokenColor "str" "#366354"

    tokenColor "conid" "#4F4371"

    tokenColor "varop" "#333"

    tokenColor "varid" "#333"

  rule "pre" $ do

    rule ".diff" $ do

      color "#555"

    rule "code" $ do

      jcolor "title" "#333"

data Key =

    Home

  | Paste Integer

  | Activity

    deriving (Eq,Ord)

data Cache =

  Cache {

    cacheMap :: MVar (Map Key Text)

import Database.PostgreSQL.Simple (ConnectInfo)

-- | Site-wide configuration.

data Config = Config {

  } deriving (Show)

-- | Announcer configuration.

data Announcer = Announcer {

    announceUser :: String

module Amelie.Types.Paste

       (Paste(..)

       ,PasteSubmit(..)

       ,PasteFormlet(..)

       ,PastePage(..)

       ,Hint(..))

       where

import Amelie.Types.Newtypes

import Amelie.Types.Language

import Database.PostgreSQL.Simple.QueryResults (QueryResults(..))

import Database.PostgreSQL.Simple.Result       (Result(..))

import Language.Haskell.HLint                  (Severity)

import Snap.Types                              (Params)

import Text.Blaze                              (ToHtml(..),toHtml)

-- | A paste.

data Paste = Paste {

   pasteId       :: PasteId

  ,pasteTitle    :: Text

 , pfChannels  :: [Channel]

 , pfDefChan   :: Maybe Text

 , pfEditPaste :: Maybe Paste

}

data PastePage = PastePage {

    ppPaste           :: Paste

  , ppChans           :: [Channel]

  , ppLangs           :: [Language]

  , ppHints           :: [Hint]

  , ppAnnotations     :: [Paste]

  , ppAnnotationHints :: [[Hint]]

}

instance Param Severity where

  render = Escape . toByteString . Utf8.fromString . show

  {-# INLINE render #-}

{-# LANGUAGE OverloadedStrings #-}

{-# LANGUAGE RecordWildCards #-}

{-# LANGUAGE ScopedTypeVariables #-}

{-# LANGUAGE ViewPatterns #-}

  ,createOrEdit

  ,createPaste

  ,getAnnotations

  ,getSomePastes

  ,countPublicPastes

  ,getHints)

  where

import Amelie.Types

import Amelie.Model

import Amelie.Model.Announcer

import Control.Monad

import Control.Monad.Env

import Control.Monad.IO

import Data.Char

import Language.Haskell.HLint

import System.Directory

import System.FilePath

-- | Count public pastes.

countPublicPastes :: Model Integer

        just j m = maybe (return ()) m j

-- | Create the hints for a paste.

createHints :: PasteSubmit -> PasteId -> Model ()

createHints ps pid = do

  forM_ hints $ \hint ->

    exec ["INSERT INTO hint"

         ,"(paste,type,content)"

         ,"VALUES"

         ,"(?,?,?)"]

validNick :: String -> Bool

validNick s = first && all ok s && length s > 0 where

  ok c = isDigit c || isLetter c || elem c "-_/\\;()[]{}?`'"

  first = all (\c -> isDigit c || isLetter c) $ take 1 s

  tmpdir <- getTemporaryDirectory

  exists <- doesFileExist tmp

  hints <- hlint [tmp,"--quiet","--ignore=Parse error"]

  return hints

getHints :: PasteId -> Model [Hint]

getHints pid =