{-# LANGUAGE OverloadedStrings, LambdaCase #-}

module Main (main) where

import Control.Concurrent.STM.TChan
import Control.Monad (forever)
import Data.Aeson
import Data.ByteString (ByteString, toStrict)
import GHC.Conc
import Network.HTTP.Simple (Response, httpJSON, getResponseBody)
import System.AtomicWrite.Writer.LazyByteString (atomicWriteFile)
import Yesod

import qualified Data.ByteString as BS

import Bangs

data Search = Search {
    ownBangs :: TVar Bangs,
    ddgBangs :: TVar Bangs,
    serializedBangs :: TVar ByteString,
    syncFileNotifications :: TChan ()
}

reserialize :: Search -> STM ()
reserialize s = do
    own <- readTVar $ ownBangs s
    ddg <- readTVar $ ddgBangs s
    writeTVar (serializedBangs s) $ toStrict $ encode $ own <> ddg -- left biased union
    writeTChan (syncFileNotifications s) ()

-- second argument: readable tchan, duped from the tchan in 'Search'
fileSyncThread :: Search -> TChan () -> IO a
fileSyncThread s rc = forever $ do
    nextBangs <- atomically $ do
        readTChan rc
        readTVar (ownBangs s)
    atomicWriteFile "bangs.json" $ encode nextBangs

spawnFileSyncThread :: Search -> IO ()
spawnFileSyncThread s = do
    readableChan <- atomically $ dupTChan (syncFileNotifications s)
    forkIO $ fileSyncThread s readableChan
    return ()

loadOwnBangs :: IO Bangs
loadOwnBangs = eitherDecodeFileStrict "bangs.json" >>= \case
    Left e -> error e
    Right b -> return b

main :: IO ()
main = do
    ans <- (httpJSON "https://duckduckgo.com/bang.v255.js") :: IO (Response DDGBangs)
    s <- Search
        <$> (loadOwnBangs >>= newTVarIO)
        <*> newTVarIO (toBangs $ getResponseBody ans)
        <*> newTVarIO BS.empty
        <*> newBroadcastTChanIO

    spawnFileSyncThread s
    atomically $ reserialize s

    print =<< readTVarIO (serializedBangs s)
    _ <- getLine
    return ()