improve documentation

src/Application.hs

@@ -5,6 +5,10 @@
 {-# LANGUAGE DeriveGeneric        #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
+{-|
+This module contains the web application
+and API implementation of Breve.
+-}
 module Application where
 
 -- Breve modules
@@ -36,7 +40,7 @@ import GHC.TypeNats             (Nat)
 -- * Types
 
 -- | API successful reply
--- This is the reply returned by the API
+-- This is the reply returned by the JSON API
 -- handler when the url has been shortned
 -- successfully.
 data ApiReply = ApiReply
@@ -55,13 +59,25 @@ instance FromForm Url where
 
 -- | API spec
 --
--- Breve has three main components:
+-- Breve has two main components:
+--
 -- 1. the web app
--- 2. the JSON API
--- 3. the static files server
+-- 2. the JSON API itself
 type Breve = API :<|> App
 
 -- | Web app spec
+--
+-- +----------+------+----------------------+
+-- | path     | type | description          |
+-- +==========+======+======================+
+-- | /        | GET  | homepage             |
+-- +----------+------+----------------------+
+-- | /        | POST | upload a new url     |
+-- +----------+------+----------------------+
+-- | /static  | GET  | static assets        |
+-- +----------+------+----------------------+
+-- | /:name   | GET  | resolves a short url |
+-- +----------+------+----------------------+
 type App =
        Get '[HTML] Html
   :<|> "static" :> Raw
@@ -69,18 +85,15 @@ type App =
   :<|> ReqBody '[FormUrlEncoded] Url :> Post '[HTML] Html
 
 -- | JSON API spec
+--
+-- +----------+------+----------------------+
+-- | path     | type | description          |
+-- +==========+======+======================+
+-- | /        | POST | upload a new url     |
+-- +----------+------+----------------------+
 type API =
   "api" :> ReqBody '[FormUrlEncoded] Url :> Post '[JSON] ApiReply
 
--- | Verb that encodes an HTTP 302 redirection
-type Redirect =
-  Verb 'GET 302 '[PlainText] Redirection
-
--- | Reply with Location redirect header
-type Redirection =
-  Headers '[Header "Location" Text] NoContent
-
-
 -- | Breve application
 --
 -- Breve takes as parameters the bind url and the urls table
@@ -126,7 +139,7 @@ uploader bindUrl table url = do
   logStr ("Registered " <> url <> " -> " <> name)
   pure (done $ bindUrl <> name)
 
--- Takes a 'Url' via POST and returns
+-- | Takes a 'Url' via POST and returns
 -- the shortned one in an 'ApiReply' as JSON.
 api :: Url -> UrlTable -> Url -> Handler ApiReply
 api bindUrl table url = do
@@ -141,4 +154,12 @@ api bindUrl table url = do
 
 -- | Handy function to log to stdout
 logStr :: Text -> Handler ()
-logStr = liftIO . T.putStrLn
+logStr = liftIO . T.putStrLn . ("[breve] " <>)
+
+-- | Verb that encodes an HTTP 302 redirection
+type Redirect =
+  Verb 'GET 302 '[PlainText] Redirection
+
+-- | Reply with Location redirect header
+type Redirection =
+  Headers '[Header "Location" Text] NoContent

src/Breve/Generator.hs

@@ -1,8 +1,12 @@
+{-|
+This module implements the algorithm
+by which a URL is converted into a word.
+-}
 module Breve.Generator
-( nameHash
-, intHash
-, Name
+( Name
 , Url
+, nameHash
+, intHash
 ) where
 
 import Control.Monad.State
@@ -13,7 +17,10 @@ import Data.ByteString.Lazy   (fromStrict)
 import Data.Text              (Text, pack)
 import Data.Text.Encoding     (encodeUtf8)
 
+-- | A phonetic word associated to a URL
 type Name = Text
+
+-- | Any kind of URL
 type Url  = Text
 
 -- | Takes a random element of a list
@@ -32,6 +39,10 @@ word = pack <$> replicateM 10 letter where
 intHash :: Url -> Int
 intHash = decode . fromStrict . hash . encodeUtf8
 
--- | Assigns a unique name to the url
+-- | Assigns a unique name to the given URL
+--
+-- The result is a computation based on a RNG
+-- seeded by URL itself and is therefore
+-- deterministic.
 nameHash :: Url -> Name
 nameHash = evalState word . mkStdGen . intHash

src/Breve/Settings.hs

@@ -1,9 +1,18 @@
-module Breve.Settings where
+{-# LANGUAGE OverloadedStrings #-}
+
+{-|
+This module defines the Breve configuration
+parser and application settings.
+-}
+module Breve.Settings
+( AppSettings(..)
+, createEmptyIfMissing
+, settings
+) where
 
 import Control.Monad                  (when)
 import System.Environment             (lookupEnv)
-import System.Environment.XDG.BaseDir
-import System.Directory                (doesFileExist)
+import System.Directory               (doesFileExist, getXdgDirectory, XdgDirectory(..))
 import Data.Text                      (Text, pack)
 import Data.Configurator
 import Data.Monoid
@@ -12,21 +21,22 @@ import Network.Wai.Handler.WarpTLS     (TLSSettings (..), tlsSettingsChain)
 import Network.TLS                    (Version (..))
 import Network.TLS.Extra              (ciphersuite_strong)
 
+-- | Breve settings
 data AppSettings = AppSettings
-  { bindHost    :: Text
-  , bindPort    :: Int
-  , bindUrl     :: Text
-  , urlTable    :: FilePath
-  , tlsSettings :: TLSSettings
+  { bindHost    :: Text         -- ^ the host to bind to
+  , bindPort    :: Int          -- ^ the port to bind to
+  , bindUrl     :: Text         -- ^ the url used to reach breve
+  , urlTable    :: FilePath     -- ^ path where to save the url table
+  , tlsSettings :: TLSSettings  -- ^ warp TLS settings
   }
 
-
+-- | Initialises a file if it doesn't exist
 createEmptyIfMissing :: FilePath -> IO ()
 createEmptyIfMissing file = do
   exists <- doesFileExist file
   when (not exists) (writeFile file "")
 
-
+-- | Configuration file parser
 settings :: Maybe FilePath -> IO AppSettings
 settings path = do
   configPath <- case path of

src/Breve/UrlTable.hs

@@ -1,3 +1,7 @@
+{-|
+This modules defines the data structure used
+to store the URLs in memory and on disk.
+-}
 module Breve.UrlTable
 ( UrlTable
 , load
@@ -12,16 +16,23 @@ import Control.Concurrent  (forkIO, threadDelay)
 import Text.Read           (readMaybe)
 import qualified Data.HashTable.IO as H
 
+-- | The hash table that stores URLs
 type UrlTable = H.CuckooHashTable Name Url
 
--- | Periodically write a url table to a file
+-- | Periodically writes a 'UrlTable' to a file
+--
+-- The table is stored in a text file
+-- as Haskell code for semplicity.
 sync :: UrlTable -> FilePath -> IO ()
 sync table file = forever $ do
   threadDelay (round 3.0e8)
   content <- show <$> H.toList table
   writeFile file content
 
--- | Load a url table from a file
+-- | Loads a URL table from a file
+--
+-- The format should be the same one used
+-- by the 'sync' function.
 load :: FilePath -> IO UrlTable
 load file = do
   content <- readFile file
@@ -31,11 +42,11 @@ load file = do
   forkIO (sync table file)
   return table
 
--- | Insert the url in a table and return the name
+-- | Insert the URL in a table and return the name
 insert :: UrlTable -> Url -> IO Name
 insert table url = H.insert table new url >> return new
   where new = nameHash url
 
--- | Lookup a table for the associated url
+-- | Lookup a table for the associated URL
 extract :: UrlTable -> Name -> IO (Maybe Url)
 extract = H.lookup

src/Main.hs

@@ -1,6 +1,12 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards   #-}
 
+{-|
+This is the main module, which actually
+run the Breve webserver.
+-}
+module Main where
+
 -- Breve modules
 import Application
 import Breve.Settings
@@ -39,8 +45,8 @@ run (AppSettings{..}) =
 
 -- | Main
 --
--- Reads the config (given as the unique argument)
--- and runs the breve web app
+-- Reads the configuration (given as the unique cli argument),
+-- sets things accordingly and runs the webserver.
 main :: IO ()
 main = do
   configPath               <- fmap listToMaybe getArgs
@@ -48,6 +54,9 @@ main = do
   table                    <- load urlTable
   static                   <- getDataFileName "static/"
 
+  -- Middlewares are just functions of type
+  -- (Application -> Application). We use a couple here
+  -- to add requests logging and HTTPS redirection.
   let
     middlewares =
       logStdout .

src/Views.hs

@@ -1,16 +1,17 @@
 {-# LANGUAGE OverloadedStrings #-}
 
+{-|
+This module contains the HTML pages used by the
+web application. These are all obtained by filling
+a single template with the page structure.
+-}
 module Views where
 
 import Data.Text                   (Text)
 import Text.Blaze.Html5            as H
 import Text.Blaze.Html5.Attributes as A
 
-done :: Text -> Html
-done url = template $ do
-  "here's your new link: "
-  a ! href (toValue url) $ (toHtml url)
-
+-- | The homepage
 index :: Html
 index = template $ do
   H.form ! method "POST" $ do
@@ -18,9 +19,22 @@ index = template $ do
     input ! type_ "text" ! name "url"
     input ! type_ "submit" ! value "go"
 
+-- | The page shown when a new url has been
+-- submitted successfully. Takes the resulting
+-- url as an argument.
+done :: Text -> Html
+done url = template $ do
+  "here's your new link: "
+  a ! href (toValue url) $ (toHtml url)
+
+-- | Displays a text message in the page center
 message :: Text -> Html
 message = template . toHtml
 
+-- | The main Breve template
+--
+-- Takes HTML code and embeds it in the
+-- inner page container.
 template :: Html -> Html
 template fill =
   docTypeHtml $ do