Rewrite in Rust

6 files changed, 0 insertions, 200 deletions

diff --git a/server/src/Job/Daemon.hs b/server/src/Job/Daemon.hs
deleted file mode 100644
index d8cd522..0000000
--- a/server/src/Job/Daemon.hs
+++ /dev/null
@@ -1,37 +0,0 @@
-module Job.Daemon
-  ( runDaemons
-  ) where
-
-import           Control.Concurrent (ThreadId, forkIO, threadDelay)
-import           Control.Monad      (forever)
-import           Data.Time.Clock    (UTCTime)
-
-import           Conf               (Conf)
-import           Job.Frequency      (Frequency (..), microSeconds)
-import           Job.Kind           (Kind (..))
-import           Job.Model          (actualizeLastCheck, actualizeLastExecution,
-                                     getLastExecution)
-import           Job.MonthlyPayment (monthlyPayment)
-import           Job.WeeklyReport   (weeklyReport)
-import qualified Model.Query        as Query
-import           Util.Time          (belongToCurrentMonth, belongToCurrentWeek)
-
-runDaemons :: Conf -> IO ()
-runDaemons conf = do
-  _ <- runDaemon MonthlyPayment EveryHour (fmap not . belongToCurrentMonth) monthlyPayment
-  _ <- runDaemon WeeklyReport EveryHour (fmap not . belongToCurrentWeek) (weeklyReport conf)
-  return ()
-
-runDaemon :: Kind -> Frequency -> (UTCTime -> IO Bool) -> (Maybe UTCTime -> IO UTCTime) -> IO ThreadId
-runDaemon kind frequency isLastExecutionTooOld runJob =
-  forkIO . forever $ do
-    mbLastExecution <- Query.run $ do
-      actualizeLastCheck kind
-      getLastExecution kind
-    hasToRun <- case mbLastExecution of
-      Just lastExecution -> isLastExecutionTooOld lastExecution
-      Nothing            -> return True
-    if hasToRun
-      then runJob mbLastExecution >>= (Query.run . actualizeLastExecution kind)
-      else return ()
-    threadDelay . microSeconds $ frequency
diff --git a/server/src/Job/Frequency.hs b/server/src/Job/Frequency.hs
deleted file mode 100644
index c5bef42..0000000
--- a/server/src/Job/Frequency.hs
+++ /dev/null
@@ -1,13 +0,0 @@
-module Job.Frequency
-  ( Frequency(..)
-  , microSeconds
-  ) where
-
-data Frequency =
-  EveryHour
-  | EveryDay
-  deriving (Eq, Read, Show)
-
-microSeconds :: Frequency -> Int
-microSeconds EveryHour = 1000000 * 60 * 60
-microSeconds EveryDay  = (microSeconds EveryHour) * 24
diff --git a/server/src/Job/Kind.hs b/server/src/Job/Kind.hs
deleted file mode 100644
index 17997f7..0000000
--- a/server/src/Job/Kind.hs
+++ /dev/null
@@ -1,23 +0,0 @@
-module Job.Kind
-  ( Kind(..)
-  ) where
-
-import qualified Data.Text                        as T
-import           Database.SQLite.Simple           (SQLData (SQLText))
-import           Database.SQLite.Simple.FromField (FromField (fromField),
-                                                   fieldData)
-import           Database.SQLite.Simple.Ok        (Ok (Errors, Ok))
-import           Database.SQLite.Simple.ToField   (ToField (toField))
-
-data Kind =
-  MonthlyPayment
-  | WeeklyReport
-  deriving (Eq, Show, Read)
-
-instance FromField Kind where
-  fromField field = case fieldData field of
-    SQLText text -> Ok (read (T.unpack text) :: Kind)
-    _            -> Errors [error "SQLText field required for job kind"]
-
-instance ToField Kind where
-  toField kind = SQLText . T.pack . show $ kind
diff --git a/server/src/Job/Model.hs b/server/src/Job/Model.hs
deleted file mode 100644
index 1dd6c63..0000000
--- a/server/src/Job/Model.hs
+++ /dev/null
@@ -1,49 +0,0 @@
-module Job.Model
-  ( Job(..)
-  , getLastExecution
-  , actualizeLastExecution
-  , actualizeLastCheck
-  ) where
-
-import           Data.Time.Clock        (UTCTime, getCurrentTime)
-import           Database.SQLite.Simple (Only (Only))
-import qualified Database.SQLite.Simple as SQLite
-import           Prelude                hiding (id)
-
-import           Job.Kind
-import           Model.Query            (Query (Query))
-
-data Job = Job
-  { id            :: String
-  , kind          :: Kind
-  , lastExecution :: Maybe UTCTime
-  , lastCheck     :: Maybe UTCTime
-  } deriving (Show)
-
-getLastExecution :: Kind -> Query (Maybe UTCTime)
-getLastExecution jobKind =
-  Query (\conn -> do
-    result <- SQLite.query conn "SELECT last_execution FROM job WHERE kind = ?" (Only jobKind) :: IO [Only UTCTime]
-    return $ case result of
-      [Only time] -> Just time
-      _           -> Nothing
-  )
-
-actualizeLastExecution :: Kind -> UTCTime -> Query ()
-actualizeLastExecution jobKind time =
-  Query (\conn -> do
-    result <- SQLite.query conn "SELECT 1 FROM job WHERE kind = ?" (Only jobKind) :: IO [Only Int]
-    let hasJob = case result of
-         [Only _] -> True
-         _        -> False
-    if hasJob
-      then SQLite.execute conn "UPDATE job SET last_execution = ? WHERE kind = ?" (time, jobKind)
-      else SQLite.execute conn "INSERT INTO job (kind, last_execution, last_check) VALUES (?, ?, ?)" (jobKind, time, time)
-  )
-
-actualizeLastCheck :: Kind -> Query ()
-actualizeLastCheck jobKind =
-  Query (\conn -> do
-    now <- getCurrentTime
-    SQLite.execute conn "UPDATE job SET kind = ? WHERE last_check = ?" (jobKind, now)
-  )
diff --git a/server/src/Job/MonthlyPayment.hs b/server/src/Job/MonthlyPayment.hs
deleted file mode 100644
index dfbe8b4..0000000
--- a/server/src/Job/MonthlyPayment.hs
+++ /dev/null
@@ -1,26 +0,0 @@
-module Job.MonthlyPayment
-  ( monthlyPayment
-  ) where
-
-import           Data.Time.Clock     (UTCTime, getCurrentTime)
-
-import           Common.Model        (Frequency (..), Payment (..))
-import qualified Common.Util.Time    as Time
-
-import qualified Model.Query         as Query
-import qualified Persistence.Payment as PaymentPersistence
-
-monthlyPayment :: Maybe UTCTime -> IO UTCTime
-monthlyPayment _ = do
-  monthlyPayments <- Query.run PaymentPersistence.listActiveMonthlyOrderedByName
-  now <- getCurrentTime
-  actualDay <- Time.timeToDay now
-  let punctualPayments = map
-        (\p -> p
-          { _payment_frequency = Punctual
-          , _payment_date = actualDay
-          , _payment_createdAt = now
-          })
-        monthlyPayments
-  _ <- Query.run (PaymentPersistence.createMany punctualPayments)
-  return now
diff --git a/server/src/Job/WeeklyReport.hs b/server/src/Job/WeeklyReport.hs
deleted file mode 100644
index 282f2f1..0000000
--- a/server/src/Job/WeeklyReport.hs
+++ /dev/null
@@ -1,52 +0,0 @@
-module Job.WeeklyReport
-  ( weeklyReport
-  ) where
-
-import qualified Data.Map               as M
-import qualified Data.Time.Clock              as Clock
-import           Data.Time.Clock        (UTCTime, getCurrentTime)
-
-import           Common.Model           (User (..))
-
-import           Conf                   (Conf)
-import qualified Model.Query            as Query
-import qualified Persistence.Income     as IncomePersistence
-import qualified Persistence.Payment    as PaymentPersistence
-import qualified Persistence.User       as UserPersistence
-import qualified SendMail
-import qualified View.Mail.WeeklyReport as WeeklyReport
-
-weeklyReport :: Conf -> Maybe UTCTime -> IO UTCTime
-weeklyReport conf mbLastExecution = do
-  now <- getCurrentTime
-
-  case mbLastExecution of
-    Nothing ->
-      return ()
-
-    Just lastExecution -> do
-      (weekPayments, cumulativeIncome, preIncomeRepartition, postIncomeRepartition, weekIncomes, users) <- Query.run $ do
-        users <- UserPersistence.list
-        paymentRange <- PaymentPersistence.getRange
-        incomeDefinedForAll <- IncomePersistence.definedForAll (_user_id <$> users)
-        cumulativeIncome <-
-          case (incomeDefinedForAll, paymentRange) of
-            (Just incomeStart, Just (paymentStart, _))  ->
-              IncomePersistence.getCumulativeIncome (max incomeStart paymentStart) (Clock.utctDay now)
-
-            _ ->
-              return M.empty
-        weekPayments <- PaymentPersistence.listModifiedPunctualSince lastExecution
-        weekIncomes <- IncomePersistence.listModifiedSince lastExecution
-        (preIncomeRepartition, postIncomeRepartition) <-
-          PaymentPersistence.getPreAndPostPaymentRepartition paymentRange users
-        return (weekPayments, cumulativeIncome, preIncomeRepartition, postIncomeRepartition, weekIncomes, users)
-
-      _ <-
-        SendMail.sendMail
-          conf
-          (WeeklyReport.mail conf users weekIncomes weekPayments cumulativeIncome preIncomeRepartition postIncomeRepartition lastExecution now)
-
-      return ()
-
-  return now