import Network.URI

import Data.Text.Lazy             (Text,toStrict)

import Database.PostgreSQL.Base   (withPoolConnection)

import Database.PostgreSQL.Simple (Pool)

import Safe                       (readMay)

import Text.Blaze                 (Html)

import Text.Blaze.Renderer.Text   (renderHtml)

-- | Run a controller handler.

runHandler :: Config -> Pool -> Cache -> Chan Text -> Controller () -> Snap ()

runHandler conf pool cache anns ctrl = do

  withPoolConnection pool $ \conn -> do

    let state = ControllerState conf conn cache anns

    -- Default to HTML, can be overridden.

    modifyResponse $ setContentType "text/html"

-- | Strictly renders HTML to Text before outputting it via Snap.

--   This ensures that any lazy exceptions are caught by the Snap

--   handler.

output :: Html -> Controller ()

-- | Get pagination data.

getPagination :: Controller Pagination

getPagination = do

  p <- getInteger "page" 1

  limit <- getInteger "limit" 35

  uri <- getMyURI

  return Pagination { pnPage = max 1 p

                    , pnLimit = max 1 (min 100 limit)

                    , pnURI = uri

                    , pnResults = 0

import Hpaste.Types

import Hpaste.View.Html

import Hpaste.View.Layout

import Hpaste.View.Paste  (pasteLink)

import Control.Monad

import Data.Maybe

import Data.Time.Show     (showDateTime)

import Prelude            hiding ((++))

import Hpaste.Types

import Hpaste.View.Html

import Hpaste.View.Layout

import Hpaste.View.Paste  (pasteLink)

import Data.Text          (Text)

import Data.Time.Show     (showDateTime)

import Prelude            hiding ((++))

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

                     td $ showLanguage languages pasteLanguage

                     td $ showChannel channels pasteChannel

          authorUri author = updateUrlParam "author" author

	  	    	   $ updateUrlParam "page"   "0"

			   $ uri { uriPath = "/browse" }

-- | Browse link.

browse :: Html

browse = href ("/browse" :: Text) ("Browse all pastes" :: Text)

import           Control.Arrow               ((&&&))

import           Control.Monad               (when)

import           Data.Maybe                  (fromMaybe)

import           Data.Monoid.Operator        ((++))

import           Data.Text.Lazy              (Text)

import qualified Data.Text.Lazy              as T

import           Network.URI.Params

import           Prelude                     hiding ((++))

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

paginate :: Pagination -> Html -> Html

paginate pn inner = do

  nav pn True

  inner

  nav pn False

-- | Show a pagination navigation, with results count, if requested.

nav :: Pagination -> Bool -> Html

nav pn@Pagination{..} showTotal = do

  H.div ! aClass "pagination" $ do

    H.div ! aClass "inner" $ do

  a ! hrefURI uri $ toHtml caption

  where uri = updateUrlParam "page"

  	      		     (show (pnPage + change))

			     pnURI

{-# LANGUAGE OverloadedStrings #-}

{-# LANGUAGE RecordWildCards #-}

-- | Page layout.

                     \t/javascript'; ga.async = true; ga.src = ('https:' \

                     \== document.location.protocol ? 'https://ssl' : \

                     \'http://www') + '.google-analytics.com/ga.js'; var\

                     \ s = document.getElementsByTagName('script')[0]; \

                     \s.parentNode.insertBefore(ga, s);})(); </script>"

    where js s = script ! A.type_ "text/javascript"

                        ! A.src ("/js/" ++ s) $

                        return ()

-- | Show the hpaste logo.

  ,page

  ,pasteLink

  ,pasteRawLink)

  where

import           Hpaste.Types

import           Hpaste.View.Highlight       (highlightPaste)

import           Hpaste.View.Hlint           (viewHints)

import           Hpaste.View.Html

import           Hpaste.View.Layout

import           Control.Arrow               ((&&&))

import           Data.ByteString.UTF8        (toString)

import           Data.List                   (find,nub)

import qualified Data.Map                    as M

import           Data.Maybe

import           Data.Monoid.Operator        ((++))

import           Data.Text                   (Text,pack)

import qualified Data.Text                   as T

import           Data.Text.Lazy              (fromStrict)

import           Data.Time.Show              (showDateTime)

import           Data.Traversable hiding (forM)

import           Prelude                     hiding ((++))

import           Safe                        (readMay)

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

import qualified Text.Blaze.Html5.Attributes as A

import           Text.Blaze.Html5.Extra

                                  ppChans

                                  ppLangs

                                  (zip ppAnnotations ppAnnotationHints)

  , pageName = "paste"

  }

-- | A formlet for paste submission / annotateing.

pasteFormlet :: PasteFormlet -> (Formlet PasteSubmit,Html)

pasteFormlet pf@PasteFormlet{..} =

  let form = postForm ! A.action (toValue action) $ do

        when pfSubmitted $

            H.div ! aClass "errors" $

              mapM_ (p . toHtml) pfErrors

        formletHtml (pasteSubmit pf) pfParams

        submitInput "submit" "Submit"

  in (pasteSubmit pf,form)

  where action = case pfAnnotatePaste of

                   Just Paste{..} -> "/annotate/" ++ show (fromMaybe pasteId pasteParent)

                       where pasteParent = case pasteType of

                               AnnotationOf pid -> Just pid

                               _ -> Nothing

    where defaulting def = fmap swap where

    	    swap "" = def

	    swap x  = x

    	  channels = options channelName channelName pfChannels

          languages = options languageName languageTitle pfLanguages

          lookupLang slug = findOption ((==slug).languageName) pfLanguages languageId

          lookupChan slug = findOption ((==slug).channelName) pfChannels channelId

          defChan = maybe (fromMaybe "" (annotateChan <|> editChan)

	  	    	  ,fromMaybe "haskell" (annotateLanguage <|> editLanguage))

                          (channelName &&& trim.channelName)

                          (pfDefChan >>= findChan)

          findChan name = find ((==name).trim.channelName) pfChannels

          trim = T.dropWhile (=='#')

          annotateTitle = ((++ " (annotation)") . pasteTitle) <$> pfAnnotatePaste

          annotateLanguage = join (fmap pasteLanguage pfAnnotatePaste) >>= findLangById

          annotateChan = join (fmap pasteChannel pfAnnotatePaste) >>= findChanById

          editTitle = Nothing

          editLanguage = join (fmap pasteLanguage pfEditPaste) >>= findLangById

          editChan = join (fmap pasteChannel pfEditPaste) >>= findChanById

          findChanById id = channelName <$> find ((==id).channelId) pfChannels

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

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

pasteDetails revisions annotations chans langs paste =

  darkNoTitleSection $ do

    h2 $ toHtml $ fromStrict (pasteTitle paste)

    ul ! aClass "paste-specs" $ do

      detail "Paste" $ do

        pasteLink paste $ "#" ++ show (pasteId paste)

	" "

    AnnotationOf pid -> do "(an annotation of "; pidLink pid; ")"

    RevisionOf pid -> do "(a revision of "; pidLink pid; ")"

-- | List the revisions of a paste.

listRevisions :: Paste -> [Paste] -> Html

listRevisions p [x] = revisionDetails p x

listRevisions p (x:y:xs) = do

  revisionDetails y x

  listRevisions p (y:xs)

  " ("

  linkAuthor (pasteAuthor revision)

  ")"

-- | Individual paste navigation.

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

    diffLink

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

    " - "

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

    " - "

    href ("/report/" ++ pack (show pid) ++ "") ("Report/Delete" :: Text)

    where pid = pasteId paste

          pairs = zip (drop 1 pastes) pastes

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

          diffLink = do

            case listToMaybe pastes of

                  " / "

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

                       ("prev" :: Text)

            case listToMaybe pastes of

              Nothing -> return (); Just{} -> " - "

-- | Show the paste content with highlighting.

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

pasteContent revisions langs paste =

  case revisions of

  ,pasteDate     :: UTCTime

  ,pasteAuthor   :: Text

  ,pasteLanguage :: Maybe LanguageId

  ,pasteChannel  :: Maybe ChannelId

  ,pastePaste    :: Text

  ,pasteType     :: PasteType

} deriving Show

-- | The type of a paste.

data PasteType

    , pastePaste = content

    , pasteDate = zonedTimeToUTC date

    , pasteId = pid

    , pasteViews = views

    , pasteType = case annotation_of of

      _ -> case revision_of of

	_ -> NormalPaste

    }

    where (pid,title,content,author,date,views,language,channel,annotation_of,revision_of) =

            convertResults field values

module Hpaste.Types.View

  (Pagination(..))

  where

import Network.URI (URI)

-- | Pagination data.

data Pagination = Pagination {

   pnPage :: Integer

-- | Get hints for a Haskell paste from hlint.

generateHintsForPaste :: PasteSubmit -> PasteId -> Model [Suggestion]

generateHintsForPaste PasteSubmit{..} (fromIntegral -> pid :: Integer) = io $

  E.catch (generateHints (show pid) pasteSubmitPaste)

-- | Get hints for a Haskell paste from hlint.

generateHints :: FilePath -> Text -> IO [Suggestion]

generateHints pid contents = io $ do

  tmpdir <- getTemporaryDirectory

            ,pasteSubmitPaste

            ,pasteSubmitLanguage

            ,pasteSubmitChannel

            ,pid)

  return ()

    where fields = "title author content language channel"

          set key = unwords [key,"=","?"]

{-# LANGUAGE ViewPatterns #-}

-- | Report model.

module Hpaste.Model.Report

  where

import Hpaste.Types

import Hpaste.Model

import Hpaste.Controller.Cache

import Hpaste.Types.Cache as Key

import Control.Monad

import Control.Monad.Env

import Control.Monad.IO

import Data.Maybe

import Data.Monoid.Operator ((++))

import qualified Data.Text.Lazy as LT

        resetCacheModel (Key.Revision (fromIntegral pid))

  reset rsPaste

  sendReport rs

  return res

sendReport ReportSubmit{..} = do

  conf <- env modelStateConfig

  _ <- io $ simpleMail (configAdmin conf)

		       (configSiteAddy conf)

		       (T.pack ("Paste reported: #" ++ show rsPaste))

		       (LT.pack body)

		       (LT.pack body)

		       []

  return ()

  	  "Paste " ++ show rsPaste ++ "\n\n" ++

	  rsComments

module Hpaste.Controller.Cache

       (newCache

       ,cache

       ,cacheIf

       ,resetCache

       where

import           Hpaste.Types.Cache

import           Hpaste.Types.Config

import           Hpaste.Types.MVC

import           Control.Concurrent

-- | Generate and save into the cache, or retrieve existing from the

-- | cache.

cache :: Key -> Controller (Maybe Html) -> Controller (Maybe Text)

cache key generate = do

  tmpdir <- asks (configCacheDir . controllerStateConfig)

  let cachePath = tmpdir ++ "/" ++ keyToString key

  exists <- io $ doesFileExist cachePath

  if exists

     then do text <- io $ T.readFile cachePath

resetCache key = do

  tmpdir <- asks (configCacheDir . controllerStateConfig)

  io $ do

   let cachePath = tmpdir ++ "/" ++ keyToString key

   exists <- io $ doesFileExist cachePath

-- | Reset an item in the cache.

resetCacheModel :: Key -> Model ()

resetCacheModel key = do

  tmpdir <- asks (configCacheDir . modelStateConfig)

  io $ do

   let cachePath = tmpdir ++ "/" ++ keyToString key

   exists <- io $ doesFileExist cachePath

keyToString :: Key -> String

keyToString Home = "home.html"

keyToString Activity = "activity.html"

keyToString (Paste i) = "paste-" ++ show i ++ ".html"

  where

import Hpaste.Types

import Hpaste.Controller

import Hpaste.Model

import Hpaste.Model.Channel    (getChannels)

import Hpaste.Model.Language   (getLanguages)

import Hpaste.Model.Paste

import Hpaste.Types.Cache      as Key

-- | Get the paste id by a key.

getPasteIdKey :: ByteString -> Controller (Maybe Integer)

getPasteIdKey key = (fmap toString >=> readMay) <$> getParam key

withPasteKey :: ByteString -> (Paste -> Controller a) -> Controller ()

withPasteKey key with = do

  pid <- getPasteIdKey key

  justOrGoHome pid $ \(pid :: Integer) -> do

    paste <- model $ getPasteById (fromIntegral pid)