From 898e7ed11ab0958fcdaf65b99b33f7b04787630a Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 24 Sep 2017 22:14:48 +0200
Subject: Bootstrap with GHCJS and reflex:

- setup login and logout,
- first draft of payment view.
---
 src/server/Job/MonthlyPayment.hs | 11 +++++++++--
 1 file changed, 9 insertions(+), 2 deletions(-)

(limited to 'src/server/Job')

diff --git a/src/server/Job/MonthlyPayment.hs b/src/server/Job/MonthlyPayment.hs
index 8c11ccf..ba24cca 100644
--- a/src/server/Job/MonthlyPayment.hs
+++ b/src/server/Job/MonthlyPayment.hs
@@ -4,7 +4,8 @@ module Job.MonthlyPayment
 
 import Data.Time.Clock (UTCTime, getCurrentTime)
 
-import Model.Frequency
+import Common.Model (Frequency(..), Payment(..))
+
 import qualified Model.Payment as Payment
 import Utils.Time (timeToDay)
 import qualified Model.Query as Query
@@ -14,6 +15,12 @@ monthlyPayment _ = do
   monthlyPayments <- Query.run Payment.listMonthly
   now <- getCurrentTime
   actualDay <- timeToDay now
-  let punctualPayments = map (\p -> p { Payment.frequency = Punctual, Payment.date = actualDay, Payment.createdAt = now }) monthlyPayments
+  let punctualPayments = map
+        (\p -> p
+          { _payment_frequency = Punctual
+          , _payment_date = actualDay
+          , _payment_createdAt = now
+          })
+        monthlyPayments
   _ <- Query.run (Payment.createMany punctualPayments)
   return now
-- 
cgit v1.2.3


From 27e11b20b06f2f2dbfb56c0998a63169b4b8abc4 Mon Sep 17 00:00:00 2001
From: Joris
Date: Wed, 8 Nov 2017 23:47:26 +0100
Subject: Use a better project structure

---
 src/server/Job/Daemon.hs         | 36 ------------------------------
 src/server/Job/Frequency.hs      | 13 -----------
 src/server/Job/Kind.hs           | 22 -------------------
 src/server/Job/Model.hs          | 47 ----------------------------------------
 src/server/Job/MonthlyPayment.hs | 26 ----------------------
 src/server/Job/WeeklyReport.hs   | 28 ------------------------
 6 files changed, 172 deletions(-)
 delete mode 100644 src/server/Job/Daemon.hs
 delete mode 100644 src/server/Job/Frequency.hs
 delete mode 100644 src/server/Job/Kind.hs
 delete mode 100644 src/server/Job/Model.hs
 delete mode 100644 src/server/Job/MonthlyPayment.hs
 delete mode 100644 src/server/Job/WeeklyReport.hs

(limited to 'src/server/Job')

diff --git a/src/server/Job/Daemon.hs b/src/server/Job/Daemon.hs
deleted file mode 100644
index 0bc6f6e..0000000
--- a/src/server/Job/Daemon.hs
+++ /dev/null
@@ -1,36 +0,0 @@
-module Job.Daemon
-  ( runDaemons
-  ) where
-
-import Control.Concurrent (threadDelay, forkIO, ThreadId)
-import Control.Monad (forever)
-import Data.Time.Clock (UTCTime)
-
-import Conf (Conf)
-import Job.Frequency (Frequency(..), microSeconds)
-import Job.Kind (Kind(..))
-import Job.Model (getLastExecution, actualizeLastCheck, actualizeLastExecution)
-import Job.MonthlyPayment (monthlyPayment)
-import Job.WeeklyReport (weeklyReport)
-import qualified Model.Query as Query
-import Utils.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/src/server/Job/Frequency.hs b/src/server/Job/Frequency.hs
deleted file mode 100644
index 263f6e6..0000000
--- a/src/server/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/src/server/Job/Kind.hs b/src/server/Job/Kind.hs
deleted file mode 100644
index af5d4f8..0000000
--- a/src/server/Job/Kind.hs
+++ /dev/null
@@ -1,22 +0,0 @@
-module Job.Kind
-  ( Kind(..)
-  ) where
-
-import Database.SQLite.Simple (SQLData(SQLText))
-import Database.SQLite.Simple.FromField (fieldData, FromField(fromField))
-import Database.SQLite.Simple.Ok (Ok(Ok, Errors))
-import Database.SQLite.Simple.ToField (ToField(toField))
-import qualified Data.Text as T
-
-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/src/server/Job/Model.hs b/src/server/Job/Model.hs
deleted file mode 100644
index e1a3c77..0000000
--- a/src/server/Job/Model.hs
+++ /dev/null
@@ -1,47 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module Job.Model
-  ( Job(..)
-  , getLastExecution
-  , actualizeLastExecution
-  , actualizeLastCheck
-  ) where
-
-import Data.Maybe (isJust)
-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
-    [Only time] <- SQLite.query conn "SELECT last_execution FROM job WHERE kind = ?" (Only jobKind) :: IO [Only (Maybe UTCTime)]
-    return time
-  )
-
-actualizeLastExecution :: Kind -> UTCTime -> Query ()
-actualizeLastExecution jobKind time =
-  Query (\conn -> do
-    [Only result] <- SQLite.query conn "SELECT 1 FROM job WHERE kind = ?" (Only jobKind) :: IO [Only (Maybe Int)]
-    if isJust result
-      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/src/server/Job/MonthlyPayment.hs b/src/server/Job/MonthlyPayment.hs
deleted file mode 100644
index ba24cca..0000000
--- a/src/server/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 Model.Payment as Payment
-import Utils.Time (timeToDay)
-import qualified Model.Query as Query
-
-monthlyPayment :: Maybe UTCTime -> IO UTCTime
-monthlyPayment _ = do
-  monthlyPayments <- Query.run Payment.listMonthly
-  now <- getCurrentTime
-  actualDay <- timeToDay now
-  let punctualPayments = map
-        (\p -> p
-          { _payment_frequency = Punctual
-          , _payment_date = actualDay
-          , _payment_createdAt = now
-          })
-        monthlyPayments
-  _ <- Query.run (Payment.createMany punctualPayments)
-  return now
diff --git a/src/server/Job/WeeklyReport.hs b/src/server/Job/WeeklyReport.hs
deleted file mode 100644
index 5737c75..0000000
--- a/src/server/Job/WeeklyReport.hs
+++ /dev/null
@@ -1,28 +0,0 @@
-module Job.WeeklyReport
-  ( weeklyReport
-  ) where
-
-import Data.Time.Clock (UTCTime, getCurrentTime)
-
-import Conf (Conf)
-import qualified Model.Income as Income
-import qualified Model.Payment as Payment
-import qualified Model.Query as Query
-import qualified Model.User as User
-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
-      (payments, incomes, users) <- Query.run $
-        (,,) <$>
-          Payment.modifiedDuring lastExecution now <*>
-          Income.modifiedDuring lastExecution now <*>
-          User.list
-      _ <- SendMail.sendMail (WeeklyReport.mail conf users payments incomes lastExecution now)
-      return ()
-  return now
-- 
cgit v1.2.3