solidabis-koodihaaste/src/API.hs

{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# 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)
import           Control.Monad.Trans    (MonadIO)
import           Data.Either            (partitionEithers)
import           Data.Foldable          (traverse_)
import           Data.List              (find, sortOn)
import           Data.Text              (Text)
import qualified Data.Text              as T
import           Lucid.Base             (HtmlT, ToHtml (..))
import           Lucid.Html5
import           Servant.API
import           Servant.API.Generic
import           Servant.HTML.Lucid
import           Servant.Server.Generic
import Control.Parallel.Strategies

import           Data.Caesar
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_

instance ToHtml Index where
  toHtml Index{..} = page $ div_ $ do
    div_ [class_ "decrypted"] $ do
      h3_ "No bullshit"
      ul_ $ traverse_ (li_ . toHtml) converted
    div_ [class_ "bullshit"] $ do
      h3_ "Bullshit"
      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)
handler =
  API {
    _index = do
      languageModel <- asks getModel
      sentences <- map message . bullshits <$> getBullshits
      let (bullshit, noBullshit) = partitionEithers best
          best = map (findBest languageModel) sentences `using` parBuffer 10 rdeepseq
      return $ Index noBullshit bullshit
  }
  where
    findBest :: Model -> Text -> Either Text Text
    findBest model sentence =
      let caesared = map (\n -> T.map (caesar n) . T.toLower $ sentence) [0..29]
          ranked = sortOn fst [(goodness model x, x) | x <- caesared]
          found = find (\(rank, _) -> rank > -7.9) (reverse ranked)
      in maybe (Left sentence) (Right . snd) found