<commit_before>{-# LANGUAGE QuasiQuotes               #-}
{-# LANGUAGE TypeFamilies              #-}
{-# LANGUAGE TemplateHaskell           #-}
{-# LANGUAGE OverloadedStrings         #-}
{-# LANGUAGE MultiParamTypeClasses     #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
module Utils.Vigilance.Web.Yesod ( runServer
                                 , WebApp(..) ) where

import Control.Applicative ( (<$>)
                           , (<*>)
                           , pure )
import Control.Lens
import Control.Monad ( (<=<)
                     , join )
import Data.Acid (AcidState)
import qualified Data.Acid as A
import Data.Time.Clock.POSIX (getPOSIXTime)
import Network.Wai.Handler.Warp (run)
import Yesod

import Utils.Vigilance.TableOps
import Utils.Vigilance.Types
import Utils.Vigilance.Utils ( bindM2
                             , bindM3 )

data WebApp = WebApp { _acid :: AcidState AppState
                     , _logChan :: LogChan }

makeClassy ''WebApp

instance Yesod WebApp where
  makeSessionBackend = const $ return Nothing

mkYesod "WebApp" [parseRoutes|
  /watches             WatchesR      GET POST
  /watches/#ID         WatchR        GET DELETE
  /watches/#ID/pause   PauseWatchR   POST
  /watches/#ID/unpause UnPauseWatchR POST
  /watches/#ID/checkin CheckInWatchR POST
|]

getWatchesR :: Handler Value
getWatchesR = undefined

postWatchesR :: Handler Value
postWatchesR = returnJson =<< bindM2 createWatchS getDb parseJsonBody_

getWatchR :: ID -> Handler Value
getWatchR =  returnJson <=< onWatch findWatchS

deleteWatchR :: ID -> Handler Value
deleteWatchR = returnJson <=< onWatch deleteWatchS

postPauseWatchR :: ID -> Handler Value
postPauseWatchR = returnJson <=< onWatch pauseWatchS

postUnPauseWatchR :: ID -> Handler Value
postUnPauseWatchR = returnJson <=< bindM3 unPauseWatchS getDb getPOSIXTime' . return

postCheckInWatchR :: ID -> Handler Value
postCheckInWatchR = returnJson <=< bindM3 checkInWatchS getDb getPOSIXTime' . return

runServer :: WebApp -> IO ()
runServer = run 3000 <=< toWaiApp

getDb = view acid <$> getYesod --might be able to use `use`

-- TODO: handle Nothing with 404 
onWatch f i = join $ f <$> getDb <*> pure i

getPOSIXTime' = liftIO getPOSIXTime
<commit_msg>add TODO<commit_after>{-# LANGUAGE QuasiQuotes               #-}
{-# LANGUAGE TypeFamilies              #-}
{-# LANGUAGE TemplateHaskell           #-}
{-# LANGUAGE OverloadedStrings         #-}
{-# LANGUAGE MultiParamTypeClasses     #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
module Utils.Vigilance.Web.Yesod ( runServer
                                 , WebApp(..) ) where

import Control.Applicative ( (<$>)
                           , (<*>)
                           , pure )
import Control.Lens
import Control.Monad ( (<=<)
                     , join )
import Data.Acid (AcidState)
import qualified Data.Acid as A
import Data.Time.Clock.POSIX (getPOSIXTime)
import Network.Wai.Handler.Warp (run)
import Yesod

import Utils.Vigilance.TableOps
import Utils.Vigilance.Types
import Utils.Vigilance.Utils ( bindM2
                             , bindM3 )

data WebApp = WebApp { _acid :: AcidState AppState
                     , _logChan :: LogChan }

makeClassy ''WebApp

instance Yesod WebApp where
  makeSessionBackend = const $ return Nothing

mkYesod "WebApp" [parseRoutes|
  /watches             WatchesR      GET POST
  /watches/#ID         WatchR        GET DELETE
  /watches/#ID/pause   PauseWatchR   POST
  /watches/#ID/unpause UnPauseWatchR POST
  /watches/#ID/checkin CheckInWatchR POST
|]

getWatchesR :: Handler Value
getWatchesR = undefined

postWatchesR :: Handler Value
postWatchesR = returnJson =<< bindM2 createWatchS getDb parseJsonBody_

getWatchR :: ID -> Handler Value
getWatchR =  returnJson <=< onWatch findWatchS

deleteWatchR :: ID -> Handler Value
deleteWatchR = returnJson <=< onWatch deleteWatchS

postPauseWatchR :: ID -> Handler Value
postPauseWatchR = returnJson <=< onWatch pauseWatchS

postUnPauseWatchR :: ID -> Handler Value
postUnPauseWatchR = returnJson <=< bindM3 unPauseWatchS getDb getPOSIXTime' . return

postCheckInWatchR :: ID -> Handler Value
postCheckInWatchR = returnJson <=< bindM3 checkInWatchS getDb getPOSIXTime' . return

--TODO: configurable port
runServer :: WebApp -> IO ()
runServer = run 3000 <=< toWaiApp

getDb = view acid <$> getYesod --might be able to use `use`

-- TODO: handle Nothing with 404 
onWatch f i = join $ f <$> getDb <*> pure i

getPOSIXTime' = liftIO getPOSIXTime

{'fraction_non_alphanumeric': 0.09675977653631285, 'fraction_numerical': 0.005363128491620112, 'mean_word_length': 2.777215189873418, 'pattern_counts': {'":': 0, '<': 45, '<?xml version=': 0, '>': 25, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 2, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '4101234', 'n_tokens_mistral': 1512, 'n_tokens_neox': 1419, 'n_words': 366}