<commit_before>{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}

-- |
-- Module : Site
-- Copyright : (C) 2015 <NAME>
-- License : MIT (see LICENSE file)
-- Maintainer : (C) <NAME> <<EMAIL>>
-- Stability : experimental
--
-- This module is where all the routes and handlers are defined for your
-- site. The 'app' function is the initializer that combines everything
-- together and is exported by this module.
module Site ( app ) where

import Application
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative
#endif
import Control.Lens
import Data.ByteString (ByteString)
import qualified Data.Map as M
import Data.Monoid
import Data.Text.Encoding
import Snap.Core
import Snap.Snaplet
import Snap.Snaplet.AcidState
import Snap.Snaplet.Auth
import Snap.Snaplet.Auth.Backends.Acid
import Snap.Snaplet.Heist
import Snap.Snaplet.Session.Backends.CookieSession
import Snap.Snaplet.Sass
import Snap.Util.FileServe
import Text.Digestive.Heist
import Text.Digestive.Snap hiding (method)
import Heist
import qualified Heist.Interpreted as I

import Auth.Login
import Auth.Logout
import Auth.Register
import Forms.QuoteCategory
import Lenses
import Types.QuoteCategory
import Types.Slug

allQuoteCategorySplices :: [QuoteCategory] -> Splices (SnapletISplice App)
allQuoteCategorySplices qcs = "allQuoteCategories" ## renderQuoteCategories qcs
  where
    renderQuoteCategories =
      I.mapSplices $ I.runChildrenWith . splicesFromQuoteCategory

-- | Render category list of quotes.
handleViewCategory :: Handler App (AuthManager App) ()
handleViewCategory = do
  slugMaybe <- getParam "slug"
  case decodeUtf8 <$> slugMaybe of
    Just slug' -> do
      categoryMaybe <- query (SearchQuoteCategory (Slug slug'))
      case categoryMaybe of
        Nothing -> render "error404"
        Just category' ->
          let splices = "categoryName" ## category' ^. name . to I.textSplice
          in renderWithSplices "view_category" splices
    -- TODO: A 400 message would be better.
    Nothing -> redirect "/"

-- | Render new category form/handle new category form submit
handleNewCategory :: Handler App (AuthManager App) ()
handleNewCategory = do
  (view', result) <- runForm "form" quoteCategoryForm
  case result of
   Just x -> update (AddQuoteCategory x) >> renderAllCategories view'
   Nothing -> renderAllCategories view'
  where
    renderAllCategories view' = do
      categories' <- query AllQuoteCategories
      let enabledCategories = filter quoteCategoryEnabled categories'
          splices = I.bindSplices (allQuoteCategorySplices enabledCategories)
                  . bindDigestiveSplices view'
      heistLocal splices (render "list_categories")<commit_msg>Render 404 error page for a not given category as real 404 too<commit_after>{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}

-- |
-- Module : Site
-- Copyright : (C) 2015 <NAME>
-- License : MIT (see LICENSE file)
-- Maintainer : (C) <NAME> <<EMAIL>>
-- Stability : experimental
--
-- This module is where all the routes and handlers are defined for your
-- site. The 'app' function is the initializer that combines everything
-- together and is exported by this module.
module Site ( app ) where

import Application
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative
#endif
import Control.Lens
import Data.ByteString (ByteString)
import qualified Data.Map as M
import Data.Monoid
import Data.Text.Encoding
import Snap.Core
import Snap.Snaplet
import Snap.Snaplet.AcidState
import Snap.Snaplet.Auth
import Snap.Snaplet.Auth.Backends.Acid
import Snap.Snaplet.Heist
import Snap.Snaplet.Session.Backends.CookieSession
import Snap.Snaplet.Sass
import Snap.Util.FileServe
import Text.Digestive.Heist
import Text.Digestive.Snap hiding (method)
import Heist
import qualified Heist.Interpreted as I

import Auth.Login
import Auth.Logout
import Auth.Register
import Forms.QuoteCategory
import Lenses
import Types.QuoteCategory
import Types.Slug

allQuoteCategorySplices :: [QuoteCategory] -> Splices (SnapletISplice App)
allQuoteCategorySplices qcs = "allQuoteCategories" ## renderQuoteCategories qcs
  where
    renderQuoteCategories =
      I.mapSplices $ I.runChildrenWith . splicesFromQuoteCategory

-- | Render category list of quotes.
handleViewCategory :: Handler App (AuthManager App) ()
handleViewCategory = do
  slugMaybe <- getParam "slug"
  case decodeUtf8 <$> slugMaybe of
    Just slug' -> do
      categoryMaybe <- query (SearchQuoteCategory (Slug slug'))
      case categoryMaybe of
        Nothing -> renderTemplateAs 404 "error404"
        Just category' ->
          let splices = "categoryName" ## category' ^. name . to I.textSplice
          in renderWithSplices "view_category" splices
    -- TODO: A 400 message would be better.
    Nothing -> redirect "/"

-- | Render new category form/handle new category form submit
handleNewCategory :: Handler App (AuthManager App) ()
handleNewCategory = do
  (view', result) <- runForm "form" quoteCategoryForm
  case result of
   Just x -> update (AddQuoteCategory x) >> renderAllCategories view'
   Nothing -> renderAllCategories view'
  where
    renderAllCategories view' = do
      categories' <- query AllQuoteCategories
      let enabledCategories = filter quoteCategoryEnabled categories'
          splices = I.bindSplices (allQuoteCategorySplices enabledCategories)
                  . bindDigestiveSplices view'
      heistLocal splices (render "list_categories")
{'fraction_non_alphanumeric': 0.08337945028592511, 'fraction_numerical': 0.006825308983582365, 'mean_word_length': 3.911231884057971, 'pattern_counts': {'":': 0, '<': 23, '<?xml version=': 0, '>': 31, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5577413', 'n_tokens_mistral': 1659, 'n_tokens_neox': 1523, 'n_words': 508}