Main.hs

{-# LANGUAGE DeriveGeneric       #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Main where

import           Control.Monad.IO.Class
import qualified Control.Monad.Random      as R
import           Data.Aeson
import qualified Data.ByteString.Lazy.UTF8 as BS
import qualified Data.Map                  as M
import           Data.Maybe
import qualified Data.Text                 as T
import           Database.SQLite.Simple
import           Flow                      ((|>))
import           GHC.Generics
import           Text.Regex

type Source = String
type Target = String

type Transitions = [(Source, Target)]
type TargetF = (Target, Rational)

type TransitionMatrix = M.Map Source [TargetF]

generateSequence :: (R.MonadRandom m, MonadIO m) => TransitionMatrix -> String -> m String
generateSequence tm s
    | (not . null $ s) && (last s) == '.' = return s
    | otherwise = do
        s' <- R.fromList $ M.findWithDefault [("", 1.0)] s tm
        ss <- generateSequence tm s'
        return $ if null s then ss else s ++ " " ++ ss

generateSequenceN :: (R.MonadRandom m, MonadIO m) => TransitionMatrix -> String -> Int -> Int -> m String
generateSequenceN tm s n m
    | m == n = return s
    | otherwise = do
        s' <- R.fromList $ M.findWithDefault [("", 1.0)] s tm
        ss <- generateSequenceN tm s' n (m+1)
        return $ if null s then ss else s ++ " " ++ ss

addTargetF :: TargetF -> [TargetF] -> [TargetF]
addTargetF (t, f) ts = case lookup t ts of
    Nothing -> (t, f) : ts
    Just n  -> (t, n+f) : filter notT ts where
        notT (r, _) = r /= t

addTargetFs :: [TargetF] -> [TargetF] -> [TargetF]
addTargetFs tsA tsB = foldr addTargetF tsB tsA

transitionsToMatrix :: Transitions -> TransitionMatrix
transitionsToMatrix = foldr insert M.empty
        where
            insert t = M.insertWith addTargetFs (fst t) [(snd t, 1.0)]

getTransitions :: [String] -> Transitions
getTransitions (s:ss) = zip ("":ws) ws ++ getTransitions ss
    where ws = words s
getTransitions _      = []

data BruhEvent
    = BruhEvent { content :: T.Text }
    deriving (Generic, Show)

instance FromJSON BruhEvent

main :: IO ()
main = do
    conn <- open "bruh.db"
    res  <- query_ conn "SELECT content FROM bruh"

    let samples = res
          |> map (decode . BS.fromString . T.unpack . head)
          |> catMaybes
          |> map (T.unpack . content)
          |> filter (not . null)
          |> filter (('!' /=) . head)
          |> map (delPat emoji . delPat mention)
          |> filter (not . null)
          where delPat  = flip flip ([]) . subRegex
                emoji   = mkRegex "<a?:.*:[0-9]+>"
                mention = mkRegex "<@[0-9]+>"

    let mat = transitionsToMatrix $ getTransitions samples
    s <- generateSequence mat ""
    putStrLn s