<commit_before>{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE GADTs #-}

module Protocol where

import System.Console.Haskeline hiding (catch)
import Control.Applicative
import Data.String
import Control.Monad
import Control.Monad.Writer
import Database.SQLite.Simple
import System.Process
import Database.SQLite.Simple.FromRow
import System.Random
import Data.Typeable
import Control.Exception
import Control.Monad.Error
import Text.Read hiding (lift, get)
import System.Directory

import DB0
import DB.Users
import DB.Put
import DB.Get
import DB.Votes

data Put
        = Boot Mail			
        | Invite Login Mail
        | Logout Login
        | Reminds Mail
        | Migrate Login Mail
        | New Login Attach String
        | Retract Login MessageId
        | Leave Login Dispose MessageId
        | Vote Login MessageId Bool
        deriving Read

put' :: Env -> Put -> ConnectionMonad ()
put' e (Boot m) = boot e m
put' e (Invite l m) = inviteUser e l m (\_ _ -> return ())
put' e (Logout l) = logout e l
put' e (Reminds m) = reminder e m
put' e (Migrate l m) = migrate e l m
put' e (New l at x) = insertMessage e l at x
put' e (Retract l mi) = retractMessage e l mi
put' e (Leave l d mi) = disposeMessage e l d mi 
put' e (Vote l mi v) = vote e l mi v
      
put :: Env -> Put -> WriterT [Event] IO (Either DBError ())
put e l = runErrorT (put' e l)
   
data Get 
        = Past Login MessageId Integer
        | Future Login MessageId
        | ForMe Login
        | FromMe Login
        | ForAll Login
        deriving Read

get'  :: Env -> Get -> ConnectionMonad [Exposed]
get' e (Past l mi n) = getPast e l mi n
get' e (Future l mi) = getFuture e l mi
get' e (ForMe mi) = getClosed e mi
get' e (FromMe mi) = getEnvelopes e mi
get' e (ForAll mi) = getOpens e mi

get :: Env -> Get -> WriterT [Event] IO (Either DBError [Exposed])
get e l = runErrorT (get' e l)

clean = callCommand "cat schema.sql | sqlite3 mootzoo.db"
prepare = do         
        b <- doesFileExist "mootzoo.db"
        when (not b) clean
        conn <- open "mootzoo.db"
        execute_ conn "PRAGMA foreign_keys = ON"
        let     p = put (mkEnv conn)
                g = get (mkEnv conn)
        return (not b,p,g)

console :: IO ()
console = do
        (t,p,g) <- prepare 
        runInputT defaultSettings $ forever $ do 
                l <- getInputLine "> "
                case fmap readMaybe l of 
                        Nothing -> outputStrLn "should stop here"<commit_msg>transfer<commit_after>{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE GADTs #-}

module Protocol where

import System.Console.Haskeline hiding (catch)
import Control.Applicative
import Data.String
import Control.Monad
import Control.Monad.Writer
import Database.SQLite.Simple
import System.Process
import Database.SQLite.Simple.FromRow
import System.Random
import Data.Typeable
import Control.Exception
import Control.Monad.Error
import Text.Read hiding (lift, get)
import System.Directory

import DB0
import DB.Users
import DB.Put
import DB.Get
import DB.Votes

data Put
        = Boot Mail			
        | Invite Login Mail
        | Logout Login
        | Reminds Mail
        | Migrate Login Mail
        | New Login Attach String
        | Retract Login MessageId
        | Leave Login Dispose MessageId
        | Vote Login MessageId Bool
        deriving Read

put' :: Env -> Put -> ConnectionMonad ()
put' e (Boot m) = boot e m
put' e (Invite l m) = inviteUser e l m (\_ _ -> return ())
put' e (Logout l) = logout e l
put' e (Reminds m) = reminder e m
put' e (Migrate l m) = migrate e l m
put' e (New l at x) = insertMessage e l at x
put' e (Retract l mi) = retractMessage e l mi
put' e (Leave l d mi) = disposeMessage e l d mi 
put' e (Vote l mi v) = vote e l mi v
      
put :: Env -> Put -> WriterT [Event] IO (Either DBError ())
put e l = runErrorT (put' e l)
   
data Get 
        = Past Login MessageId Integer
        | Future Login MessageId
        | ForMe Login
        | FromMe Login
        | ForAll Login
        | Conversation Login MessageId
        deriving Read

get'  :: Env -> Get -> ConnectionMonad [Exposed]
get' e (Past l mi n) = getPast e l mi n
get' e (Future l mi) = getFuture e l mi
get' e (ForMe l) = getClosed e l
get' e (FromMe l) = getEnvelopes e l
get' e (ForAll l) = getOpens e l
get' e (Conversation l mi) = getConversation e l mi 

get :: Env -> Get -> WriterT [Event] IO (Either DBError [Exposed])
get e l = runErrorT (get' e l)

clean = callCommand "cat schema.sql | sqlite3 mootzoo.db"
prepare = do         
        b <- doesFileExist "mootzoo.db"
        when (not b) clean
        conn <- open "mootzoo.db"
        execute_ conn "PRAGMA foreign_keys = ON"
        let     p = put (mkEnv conn)
                g = get (mkEnv conn)
        return (not b,p,g)

console :: IO ()
console = do
        (t,p,g) <- prepare 
        runInputT defaultSettings $ forever $ do 
                l <- getInputLine "> "
                case fmap readMaybe l of 
                        Nothing -> outputStrLn "should stop here"
{'fraction_non_alphanumeric': 0.09404328672668072, 'fraction_numerical': 0.0007661367554108408, 'mean_word_length': 2.390909090909091, 'pattern_counts': {'":': 0, '<': 11, '<?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': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '6361166', 'n_tokens_mistral': 1735, 'n_tokens_neox': 1677, 'n_words': 661}