{-# 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