Haddocks

src/API.hs

@@ -4,6 +4,19 @@
 {-# LANGUAGE RecordWildCards            #-}
 {-# LANGUAGE TypeFamilies               #-}
 {-# LANGUAGE TypeOperators              #-}
+{-|
+Module      : API
+Description : The application API and handlers
+Copyright   : (c) Mats Rauhala, 2019
+License     : BSD3
+Maintainer  : mats.rauhala@iki.fi
+Stability   : experimental
+Portability : POSIX
+
+Provides the API and handlers for the application.
+
+Even if this is only one module, I'm using this same style in all of my projects. Each level of APIs provide their own `API` type and a `handler` who is responsible only for that specific subsection of an API.
+-}
 module API where
 
 import           Control.Monad.Reader   (MonadReader, asks)
@@ -25,11 +38,15 @@ import           Data.Language
 import           Solidabis.API          (HasClientEnv, HasToken, bullshits,
                                          getBullshits, message)
 
+-- | Data for the frontpage
+--
+-- Our "UI" only cares about the decrypted and non-decryptable sentences
 data Index =
   Index { converted   :: [Text]
         , unconverted :: [Text]
         }
 
+-- | Wrap a UI within an HTML page
 page :: Monad m => HtmlT m () -> HtmlT m ()
 page = doctypehtml_ . body_
 
@@ -43,10 +60,16 @@ instance ToHtml Index where
       ul_ $ traverse_ (li_ . toHtml) unconverted
   toHtmlRaw = toHtml
 
+-- | Our API type
+--
+-- Consists only of the index route
 newtype API route
   = API { _index :: route :- Get '[HTML] Index }
   deriving Generic
 
+-- | API handler
+--
+-- Compares the sentences given by the solidabis api against the model
 handler
   :: (HasModel r, MonadReader r m, HasToken r, HasClientEnv r, MonadIO m)
   => API (AsServerT m)

src/Control/Lens.hs

@@ -1,23 +1,43 @@
 {-# LANGUAGE RankNTypes #-}
+{-|
+Module      : Control.Lens
+Description : Simplified functional lenses
+Copyright   : (c) Mats Rauhala, 2019
+License     : BSD3
+Maintainer  : mats.rauhala@iki.fi
+Stability   : experimental
+Portability : POSIX
+
+A very small subset of the lens library reimplemented
+
+See http://hackage.haskell.org/package/lens for proper docs
+-}
 module Control.Lens where
 
 import           Control.Monad.Reader  (MonadReader, asks)
 import           Data.Functor.Const    (Const (..))
 import           Data.Functor.Identity (Identity (..))
 
+-- | Full lens type
 type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t
 
+-- | Simplified lens type
 type Lens' s b = Lens s s b b
 
+-- | Build a lens out of a getter and a setter
 lens :: (s -> a) -> (s -> b -> t) -> Lens s t a b
 lens sa sbt afb s = sbt s <$> afb (sa s)
 
+-- | Getting a value
 type Getting r s a = (a -> Const r a) -> s -> Const r s
 
+-- | View a value
 view :: MonadReader r m => Getting a r a -> m a
 view l = asks (getConst . l Const)
 
+-- | Settering a value
 type ASetter s t a b = (a -> Identity b) -> s -> Identity t
 
+-- | Set a value
 set :: ASetter s t a b -> b -> s -> t
 set l b = runIdentity . l (\_ -> Identity b)

src/Control/Monad/App.hs

@@ -1,5 +1,20 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE RankNTypes                 #-}
+{-|
+Module      : Control.Monad.App
+Description : Our application monad
+Copyright   : (c) Mats Rauhala, 2019
+License     : BSD3
+Maintainer  : mats.rauhala@iki.fi
+Stability   : experimental
+Portability : POSIX
+
+Provides the application monad, which is just a newtype over a ReaderT environment.
+
+The environment contains the configuration as well as values determind at startup.
+
+The environment can be thought of as dependency injection.
+-}
 module Control.Monad.App where
 
 import           Control.Monad.Reader (MonadReader, ReaderT, runReaderT)
@@ -14,26 +29,33 @@ import           Solidabis.API        (HasClientEnv (..), HasToken (..), Token)
 
 
 
+-- | Lens for accessing token
 accessToken :: Lens' Config Token
 accessToken = lens _accessToken (\st x -> st{_accessToken=x})
 
+-- | Lens for accessing solidabis base url
 solidabisBase :: Lens' Config BaseUrl
 solidabisBase = lens _solidabisBase (\st x -> st{_solidabisBase=x})
 
+-- | Lens for accessing the server port
 port :: Lens' Config Port
 port = lens _port (\st x -> st{_port = x})
 
+-- | The environment
 data App
   = App { _config          :: Config
         , _solidabisClient :: ClientEnv
         , _languageModel   :: Model}
 
+-- | Lens for accessing the config
 config :: Lens' App Config
 config = lens _config (\st x -> st{_config=x})
 
+-- | Lens for accessing the client environment
 solidabisClient :: Lens' App ClientEnv
 solidabisClient = lens _solidabisClient (\st x -> st{_solidabisClient=x})
 
+-- | Lens for accessing the language model
 model :: Lens' App Model
 model = lens _languageModel (\st x -> st{_languageModel=x})
 
@@ -53,8 +75,12 @@ instance HasModel App where
   getModel = view model
   setModel app tk = set model tk app
 
+-- | The application monad
+--
+-- This is just a 'ReaderT App IO'
 newtype AppM a = AppM (ReaderT App IO a)
   deriving (Functor, Applicative, Monad, MonadReader App, MonadIO)
 
+-- | Run the application monad into IO
 runAppM :: App -> AppM a -> IO a
 runAppM st (AppM f) = runReaderT f st

src/Data/Caesar.hs

@@ -1,7 +1,21 @@
+{-|
+Module      : Data.Caesar
+Description : Utilities for doing caesar transforms
+Copyright   : (c) Mats Rauhala, 2019
+License     : BSD3
+Maintainer  : mats.rauhala@iki.fi
+Stability   : experimental
+Portability : POSIX
+
+-}
 module Data.Caesar where
 
+-- | Type alias over char
 type Caesar = Char
 
+-- | Translate to the next character on the left
+--
+-- Has special handling for some symbols
 next :: Char -> Char
 next c =
   case c of
@@ -13,5 +27,6 @@ next c =
      'a' -> 'ö'
      x   -> pred x
 
+-- | Translate a character n times
 caesar :: Int -> Caesar -> Caesar
 caesar n x = foldr ($) x (replicate n next)

src/Data/Config.hs

@@ -1,4 +1,15 @@
 {-# LANGUAGE DeriveGeneric #-}
+{-|
+Module      : Config
+Description : Config types
+Copyright   : (c) Mats Rauhala, 2019
+License     : BSD3
+Maintainer  : mats.rauhala@iki.fi
+Stability   : experimental
+Portability : POSIX
+
+The config type with a helper function for reading the config from disk
+-}
 module Data.Config where
 
 import           Server              (Port)
@@ -10,6 +21,9 @@ import           Data.Yaml.Config
 import           GHC.Generics        (Generic)
 import           Servant.Client      (BaseUrl)
 
+-- | Config type
+--
+-- These are all values that should be known statically beforehand
 data Config
   = Config { _accessToken   :: Token
            , _solidabisBase :: BaseUrl
@@ -19,5 +33,6 @@ data Config
 
 instance FromJSON Config
 
+-- | Read the configuration yaml from file
 readConfigFromFile :: MonadIO m => FilePath -> m Config
 readConfigFromFile path = liftIO $ loadYamlSettings [path] [] ignoreEnv

src/Data/Language.hs

@@ -1,4 +1,17 @@
 {-# LANGUAGE RecordWildCards #-}
+{-|
+Module      : Data.Language
+Description : The language model
+Copyright   : (c) Mats Rauhala, 2019
+License     : BSD3
+Maintainer  : mats.rauhala@iki.fi
+Stability   : experimental
+Portability : POSIX
+
+An n-gram model over a language. Should be trained with regular text.
+
+The idea behind this module is to compare a sentence n-grams against the model. Higher the results, higher the probability of it being the same language as the model.
+-}
 module Data.Language where
 
 import           Data.Foldable   (fold)
@@ -10,10 +23,12 @@ import           Data.Text       (Text)
 
 import           Data.NGram
 
+-- | Model represents the language
 data Model
   = Model { parts :: Map Text (Sum Int)
           , total :: Sum Int }
 
+-- | Has* style pattern for accessing the language model
 class HasModel a where
   getModel :: a -> Model
   setModel :: a -> Model -> a
@@ -22,15 +37,20 @@ instance HasModel Model where
   getModel = id
   setModel = const
 
+-- | The default n-gram size
 ngramSize :: Int
 ngramSize = 3
 
+-- | Build a language model out of a corpus content
 buildModel :: Text -> Model
 buildModel str =
   let parts = ngram ngramSize str
       total = fold parts
   in Model{..}
 
+-- | Calculate the 'goodness' of a sentence
+--
+-- Higher numbers means higher probability of being part of the same language as the model
 goodness :: Model -> Text -> Double
 goodness Model{..} str =
   let comparison = M.keys $ ngram ngramSize str

src/Data/NGram.hs

@@ -1,4 +1,15 @@
 {-# LANGUAGE OverloadedStrings #-}
+{-|
+Module      : Data.NGram
+Description : N-gram utilities
+Copyright   : (c) Mats Rauhala, 2019
+License     : BSD3
+Maintainer  : mats.rauhala@iki.fi
+Stability   : experimental
+Portability : POSIX
+
+Utilities for building n-gram models
+-}
 module Data.NGram where
 
 import           Data.List       (unfoldr)
@@ -8,6 +19,7 @@ import           Data.Monoid     (Sum (..))
 import           Data.Text       (Text)
 import qualified Data.Text       as T
 
+-- | Build a n-gram frequency map
 ngram :: Int -> Text -> Map Text (Sum Int)
 ngram n = M.unionsWith (<>) . unfoldr go
   where

src/Main.hs

@@ -3,6 +3,18 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards   #-}
 {-# LANGUAGE TypeOperators     #-}
+{-|
+Module      : Main
+Description : The main module
+Copyright   : (c) Mats Rauhala, 2019
+License     : BSD3
+Maintainer  : mats.rauhala@iki.fi
+Stability   : experimental
+Portability : POSIX
+
+
+The main access point for the koodihaaste
+-}
 module Main where
 
 import           Control.Monad.App
@@ -14,11 +26,16 @@ import           Options.Generic
 import           Servant.Client
 import           Server
 
+-- | The command line endpoint
+--
+-- Parses only the path to the config file
+-- see config.yaml.sample for the format
 newtype Cmd = Cmd (FilePath <?> "Config path")
   deriving Generic
 
 instance ParseRecord Cmd
 
+-- | The main function
 main :: IO ()
 main = do
   Cmd (Helpful configPath) <- getRecord "koodihaaste"

src/Server.hs

@@ -1,4 +1,15 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-|
+Module      : Server
+Description : Run the http server
+Copyright   : (c) Mats Rauhala, 2019
+License     : BSD3
+Maintainer  : mats.rauhala@iki.fi
+Stability   : experimental
+Portability : POSIX
+
+
+-}
 module Server where
 
 import           Control.Monad.Reader     (MonadReader, ask, asks, runReaderT)
@@ -12,8 +23,14 @@ import           API                      (handler)
 import           Data.Language            (HasModel)
 import           Solidabis.API            (HasClientEnv, HasToken)
 
+-- | The port to run on
+--
+-- Should be provided within the environment
 newtype Port = Port Int deriving (Show, FromJSON)
 
+-- | Has* pattern
+--
+-- Locate the port within the larger environment structure
 class HasPort a where
   getPort :: a -> Port
   setPort :: a -> Port -> a
@@ -22,9 +39,11 @@ instance HasPort Port where
   getPort = id
   setPort = const
 
+-- | Convert the servant handler into wai application
 app :: (HasModel r, HasClientEnv r, HasToken r) => r -> Application
 app env = genericServeT (`runReaderT` env) API.handler
 
+-- | Run the server
 server
   :: (HasModel r, HasClientEnv r, HasToken r, HasPort r, MonadReader r m, MonadIO m)
   => m ()

src/Solidabis/API.hs

@@ -4,6 +4,17 @@
 {-# LANGUAGE OverloadedStrings          #-}
 {-# LANGUAGE TypeFamilies               #-}
 {-# LANGUAGE TypeOperators              #-}
+{-|
+Module      : Solidabis.API
+Description : The client API for solidabis API
+Copyright   : (c) Mats Rauhala, 2019
+License     : BSD3
+Maintainer  : mats.rauhala@iki.fi
+Stability   : experimental
+Portability : POSIX
+
+Provides the client API for the solidabis API. Implemented through servant generics.
+-}
 module Solidabis.API
   ( getBullshits
   , Bullshit(..)
@@ -28,9 +39,11 @@ import           Servant.Client.Core.Request (Request)
 import qualified Servant.Client.Core.Request as Req
 import           Servant.Client.Generic
 
+-- | JSON representation of the message layer
 newtype Message = Message { message :: Text }
   deriving Generic
 
+-- | JSON representation of the bullshit layer
 newtype Bullshit
   = Bullshit { bullshits :: [ Message ] }
   deriving Generic
@@ -42,6 +55,7 @@ newtype API route
   = API { _bullshit :: route :- AuthProtect "jwt" :> "bullshit" :> Get '[JSON] Bullshit }
   deriving (Generic)
 
+-- | Has* style pattern for accessing the client environment
 class HasClientEnv a where
   getClientEnv :: a -> ClientEnv
   setClientEnv :: a -> ClientEnv -> a
@@ -54,9 +68,11 @@ routes :: (MonadReader r m, MonadIO m, HasClientEnv r) => API (AsClientT m)
 routes = genericClientHoist
   (\x -> asks getClientEnv >>= \env -> liftIO (runClientM x env >>= either throwIO return))
 
+-- | Newtype wrapper over the jwt token
 newtype Token = Token String
   deriving (Semigroup, Monoid, ToHttpApiData, IsString, Show, FromJSON)
 
+-- | Has* style pattern for accessing the authentication token
 class HasToken a where
   getToken :: a -> Token
   setToken :: a -> Token -> a
@@ -70,6 +86,7 @@ type instance AuthClientData (AuthProtect "jwt") = Token
 authReq :: Token -> Request -> Request
 authReq token = Req.addHeader "Authorization" ("Bearer " <> token)
 
+-- | Return the encoded sentences from the solidabis API
 getBullshits
   :: (HasToken r, MonadReader r m, MonadIO m, HasClientEnv r)
   => m Bullshit