still working

.gitignore

@@ -4,3 +4,4 @@ state/
 dist-newstyle/
 *.db
 jwt.key
+*.lock

src-benchmark/Main.hs

@@ -3,7 +3,8 @@ import Protolude
 import Criterion
 import Criterion.Main
 
-import Lib (inc)
+inc :: Int -> Int
+inc = (+1)
 
 main :: IO ()
 main = defaultMain [bench "inc 41" (whnf inc (41 :: Int))]

src/Aggreact.hs

@@ -109,7 +109,7 @@ mainServe conf = do
 initialize :: Conf -> IO (Settings,Application)
 initialize Conf{..} = do
   uh <- newUserHandler userDBConf defaultAdminUser
-  ch <- newCommentHandler aggreactDB (dbstore uh) commentDBConf
+  ch <- newCommentHandler aggreactDB commentDBConf
   sh <- newSlugHandler slugDBConf
   ah <- newAuthorizationHandler authorizationStrategy
   myKey <- readKey jwtKeyFilePath

src/Aggreact/Auth.hs

@@ -5,6 +5,7 @@
 
 -- Common Pragmas (already stated in cabal file but repeated here for some tools)
 {-# LANGUAGE BlockArguments        #-}
+{-# LANGUAGE DeriveGeneric         #-}
 {-# LANGUAGE DerivingStrategies    #-}
 {-# LANGUAGE ExplicitForAll        #-}
 {-# LANGUAGE NamedWildCards        #-}

src/Aggreact/Comments/StoreService.hs

@@ -47,13 +47,9 @@ import           Aggreact.DB
 import qualified Aggreact.Users                as User
 
 --------------------------------------------------------------------------------
-import           Data.Time.Format                ()
-import           Database.SQLite.Simple          (Connection,query_)
-
-
-import           Database.Beam                   (references_)
 import qualified Database.Beam                 as Beam
 import qualified Database.Beam.Sqlite          as BeamSqlite
+import           Database.SQLite.Simple        (Connection, query_)
 import           Database.Store                (DefaultMetas (..), Id (..),
                                                 Store (..))
 import           Database.Store.Backend.SQLite as SQL
@@ -117,13 +113,13 @@ commentsView' conn db (Slug sl) = do
   res <- BeamSqlite.runBeamSqliteDebug putStrLn conn $
     Beam.runSelectReturningList $ Beam.select $ do
         comment <- Beam.all_ (_aggreactComments db)
-        Beam.guard_ ((_slug comment) Beam.==. Beam.val_ sl)
+        Beam.guard_ (_slug comment Beam.==. Beam.val_ sl)
         muser   <- Beam.leftJoin_
                      (Beam.all_ (_aggreactUsers db))
-                     (\u -> (Beam.maybe_
+                     (\u -> Beam.maybe_
                              (Beam.val_ False)
-                             (Beam.==. (User._id u))
-                             (_userid comment)))
+                             (Beam.==. User._id u)
+                             (_userid comment))
         pure (comment,muser)
   traverse (\(c,mu) -> pure $
              CommentView
@@ -147,8 +143,11 @@ data CommentHandler = CommentHandler
 
 -- | Init a new comment handler
 -- newCommentHandler :: AggreactDB e -> User.DBStore -> CommentDBConf -> IO CommentHandler
-newCommentHandler :: Beam.Database BeamSqlite.Sqlite db => AggreactDB (Beam.DatabaseEntity BeamSqlite.Sqlite db) -> p -> CommentDBConf -> IO CommentHandler
-newCommentHandler db userStore conf = do
+newCommentHandler :: Beam.Database BeamSqlite.Sqlite db
+                  => AggreactDB (Beam.DatabaseEntity BeamSqlite.Sqlite db)
+                  -> CommentDBConf
+                  -> IO CommentHandler
+newCommentHandler db conf = do
   dbstore <- initDBComments conf
   pure CommentHandler { createComment     = createComment' dbstore
                       , readComment       = readComment' dbstore

src/Aggreact/Comments/Types.hs

@@ -52,7 +52,7 @@ where
 
 import           Protolude
 
-import           Aggreact.Users                   (User, UserId (..), BUserT)
+import           Aggreact.Users                   (User, UserId (..))
 
 import qualified Control.Exception                as Ex
 import           Data.Aeson                       (FromJSON (..), ToJSON (..),
@@ -140,15 +140,16 @@ bCommentToCommentNoUser :: BComment -> Comment
 bCommentToCommentNoUser bc =
   Entity
   (Id (toS (_id bc)))
-  (NewComment
+  NewComment
   { parent = ParentId (fmap toS (_parent bc))
   , slug = Slug (_slug bc)
   , content = Content (_content bc)
   , userid = MUserId Nothing
-   })
-  (DefaultMetas
+  }
+  DefaultMetas
   { updated = _updated bc
-   , created = _created bc })
+  , created = _created bc
+  }
 
 data BCommentT f =
   BCommentT

src/Aggreact/DB.hs

@@ -1,14 +1,15 @@
+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
 {-# LANGUAGE DataKinds                  #-}
 {-# LANGUAGE DeriveAnyClass             #-}
 {-# LANGUAGE DeriveDataTypeable         #-}
 {-# LANGUAGE DuplicateRecordFields      #-}
 {-# LANGUAGE FlexibleContexts           #-}
 {-# LANGUAGE FlexibleInstances          #-}
+{-# LANGUAGE ImpredicativeTypes         #-}
 {-# LANGUAGE MultiParamTypeClasses      #-}
 {-# LANGUAGE TypeFamilies               #-}
 {-# LANGUAGE TypeOperators              #-}
 {-# LANGUAGE TypeSynonymInstances       #-}
-{-# LANGUAGE ImpredicativeTypes #-}
 
 {-# LANGUAGE BlockArguments             #-}
 {-# LANGUAGE DeriveGeneric              #-}

src/Service/Service.hs

@@ -34,8 +34,8 @@ import Protolude hiding (Handle)
 import Control.Exception (bracket)
 
 class Service s a where
-  type Config s a -- | the initial config a service should have
-  type Handle s a -- | a type that should contains methods provided by the service
+  type Config s a -- the initial config a service should have
+  type Handle s a -- a type that should contains methods provided by the service
   init :: Proxy (Service s a) -> Config s a -> IO (Handle s a)
   stop :: Proxy (Service s a) -> Handle s a -> IO ()
   stop _ _ = pure ()