69 lines
2.4 KiB
Haskell
69 lines
2.4 KiB
Haskell
{-# LANGUAGE DataKinds #-}
|
|
{-# LANGUAGE DeriveGeneric #-}
|
|
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE RecordWildCards #-}
|
|
{-# LANGUAGE TypeFamilies #-}
|
|
{-# LANGUAGE TypeOperators #-}
|
|
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 Data.Caesar
|
|
import Data.Language
|
|
import Solidabis.API (HasClientEnv, HasToken, bullshits,
|
|
getBullshits, message)
|
|
|
|
data Index =
|
|
Index { converted :: [Text]
|
|
, unconverted :: [Text]
|
|
}
|
|
|
|
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
|
|
|
|
newtype API route
|
|
= API { _index :: route :- Get '[HTML] Index }
|
|
deriving Generic
|
|
|
|
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 (map (findBest languageModel) sentences)
|
|
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
|