run threaded by default

.gitignore

@@ -1,16 +1,3 @@
 dist
-cabal-dev
+result
-*.o
+default.nix
-*.hi
-*.chi
-*.chs.h
-*.dyn_o
-*.dyn_hi
-.virtualenv
-.hpc
-.hsenv
-.cabal-sandbox/
-cabal.sandbox.config
-*.prof
-*.aux
-*.hp

breve.cabal

@@ -23,19 +23,21 @@ source-repository head
   location: https://maxwell.ydns.eu/git/rnhmjoj/breve
 
 executable breve
-  main-is:           Main.hs
+  main-is:            Main.hs
-  hs-source-dirs:    src
+  hs-source-dirs:     src
-  default-language:  Haskell2010
+  default-language:   Haskell2010
-  other-modules:     Application, Views, Breve.Settings,
+  other-modules:      Application, Views, Breve.Settings,
-                     Breve.Generator, Breve.UrlTable,
+                      Breve.Generator, Breve.UrlTable,
-                     Paths_breve
+                      Paths_breve
-  other-extensions:  OverloadedStrings
+  default-extensions: OverloadedStrings
-  build-depends:     base >=4.8 && <5.0,
+  other-extensions:   RecordWildCards, DeriveGeneric,
-                     warp, warp-tls, tls, blaze-html, blaze-markup,
+                      DataKinds, KindSignatures, TypeOperators
-                     servant-server, servant, servant-blaze,
+  build-depends:      base >=4.8 && <5.0,
-                     wai, wai-extra, streaming-commons, http-api-data,
+                      warp, warp-tls, tls, blaze-html,
-                     transformers, mtl,
+                      servant, servant-server, servant-blaze,
-                     text, aeson, bytestring, binary,
+                      wai, wai-extra, streaming-commons, http-api-data,
-                     hashtables, cryptohash, random,
+
-                     configurator, directory
+                      mtl, text, aeson, bytestring, binary,
-  ghc-options:       -threaded -O2
+                      hashtables, cryptohash, random,
+                      configurator, directory
+  ghc-options:        -threaded -O2 "-with-rtsopts=-N -qg"

src/Application.hs

@@ -1,9 +1,7 @@
 {-# LANGUAGE DataKinds            #-}
 {-# LANGUAGE KindSignatures       #-}
 {-# LANGUAGE TypeOperators        #-}
-{-# LANGUAGE OverloadedStrings    #-}
 {-# LANGUAGE DeriveGeneric        #-}
-{-# LANGUAGE TypeSynonymInstances #-}
 
 {-|
 This module contains the web application
@@ -17,7 +15,6 @@ import Breve.UrlTable
 import Views
 
 -- Misc
-import Data.Monoid
 import Control.Monad.IO.Class  (liftIO)
 import qualified Data.Text.IO  as T
 
@@ -27,19 +24,19 @@ import Data.Aeson               (ToJSON)
 import GHC.Generics             (Generic)
 
 -- HTML replies
-import Text.Blaze.Html5         (Html)
+import Text.Blaze.Html5              (Html)
-import Text.Blaze.Renderer.Utf8 (renderMarkup)
+import Text.Blaze.Html.Renderer.Utf8 (renderHtml)
 
 -- API definition
 import Servant
 import Servant.HTML.Blaze       (HTML)
 import Web.FormUrlEncoded       (FromForm(..), parseUnique)
-import GHC.TypeNats             (Nat)
 
 
 -- * Types
 
 -- | API successful reply
+--
 -- This is the reply returned by the JSON API
 -- handler when the url has been shortned
 -- successfully.
@@ -51,8 +48,13 @@ data ApiReply = ApiReply
 
 instance ToJSON ApiReply
 
-instance FromForm Url where
+-- | This type is just a wrapper around a 'Text'
-  fromForm f = parseUnique "url" f
+-- value. It's used to create a 'FromForm' instance
+-- for a 'Url'.
+newtype UrlForm = UrlForm Text
+
+instance FromForm UrlForm where
+  fromForm f = UrlForm <$> parseUnique "url" f
 
 
 -- * Breve API
@@ -82,22 +84,23 @@ type App =
        Get '[HTML] Html
   :<|> "static" :> Raw
   :<|> Capture "name" Name :> Redirect
-  :<|> ReqBody '[FormUrlEncoded] Url :> Post '[HTML] Html
+  :<|> ReqBody '[FormUrlEncoded] UrlForm :> Post '[HTML] Html
 
 -- | JSON API spec
 --
 -- +----------+------+----------------------+
 -- | path     | type | description          |
 -- +==========+======+======================+
--- | /        | POST | upload a new url     |
+-- | /api     | POST | upload a new url     |
 -- +----------+------+----------------------+
 type API =
-  "api" :> ReqBody '[FormUrlEncoded] Url :> Post '[JSON] ApiReply
+  "api" :> ReqBody '[FormUrlEncoded] UrlForm :> Post '[JSON] ApiReply
 
 -- | Breve application
---
+breve :: FilePath    -- ^ static assets path
--- Breve takes as parameters the bind url and the urls table
+      -> Url         -- ^ bind url
-breve :: FilePath -> Url -> UrlTable -> Application
+      -> UrlTable    -- ^ url hashtable
+      -> Application
 breve static url table = serve (Proxy :: Proxy Breve) (breveServer static url table)
 
 -- | Empty application
@@ -132,24 +135,24 @@ resolver table name = do
   url <- liftIO (extract table name)
   case url of
     Nothing  ->
-      throwError $ err404 { errBody = renderMarkup (message "404: not found") }
+      throwError $ err404 { errBody = renderHtml (message "404: not found") }
     Just url -> do
       logStr ("Resolved " <> name <> " -> " <> url)
       pure (addHeader url NoContent)
 
 
--- | Takes a 'Url' via POST
+-- | Takes a 'UrlForm' via POST
 -- and prints the shortned one
-uploader :: Url -> UrlTable -> Url -> Handler Html
+uploader :: Url -> UrlTable -> UrlForm -> Handler Html
-uploader bindUrl table url = do
+uploader bindUrl table (UrlForm url) = do
   name <- liftIO (insert table url)
   logStr ("Registered " <> url <> " -> " <> name)
   pure (done $ bindUrl <> name)
 
 -- | Takes a 'Url' via POST and returns
 -- the shortned one in an 'ApiReply' as JSON.
-api :: Url -> UrlTable -> Url -> Handler ApiReply
+api :: Url -> UrlTable -> UrlForm -> Handler ApiReply
-api bindUrl table url = do
+api bindUrl table (UrlForm url) = do
   name <- liftIO (insert table url)
   logStr ("Registered " <> url <> " -> " <> name)
   pure $ ApiReply { link     = (bindUrl <> name)

src/Breve/Settings.hs

@@ -1,5 +1,3 @@
-{-# LANGUAGE OverloadedStrings #-}
-
 {-|
 This module defines the Breve configuration
 parser and application settings.

src/Main.hs

@@ -1,5 +1,4 @@
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE RecordWildCards   #-}
 
 {-|
 This is the main module, which actually
@@ -8,7 +7,7 @@ run the Breve webserver.
 module Main where
 
 -- Breve modules
-import Application
+import Application     (breve, emptyApp)
 import Breve.Settings
 import Breve.UrlTable
 import Paths_breve     (getDataFileName)

src/Views.hs

@@ -1,5 +1,3 @@
-{-# LANGUAGE OverloadedStrings #-}
-
 {-|
 This module contains the HTML pages used by the
 web application. These are all obtained by filling