prepare for beam-core

aggreact.cabal

@@ -4,7 +4,7 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 5edc28ddb6ddbaae8fca1102380d6eca821d473ed494bca0e66de11e29600b9f
+-- hash: 4f6fabeda91d58ac0756a616b4bf8e77949104a3d23a2930e156a42863c457e5
 
 name:           aggreact
 version:        0.1.0.0
@@ -69,13 +69,12 @@ library
   default-extensions: OverloadedStrings NoImplicitPrelude ScopedTypeVariables TupleSections OverloadedLists ExplicitForAll RecordWildCards GeneralizedNewtypeDeriving DeriveGeneric DerivingStrategies StandaloneDeriving NamedWildCards PartialTypeSignatures BlockArguments NumericUnderscores
   ghc-options: -Wall -Wcompat -Wincomplete-uni-patterns -Wredundant-constraints -Wnoncanonical-monad-instances
   build-depends:
-      acid-state
-    , aeson
+      aeson
     , base >=4.8 && <5
+    , beam-core
+    , beam-migrate
+    , beam-sqlite
     , blaze-html
-    , cereal
-    , cereal-text
-    , cereal-time
     , clay
     , containers
     , dhall

package.yaml

@@ -40,11 +40,10 @@ library:
   source-dirs: src
   dependencies:
   - aeson
-  - acid-state
+  - beam-core
+  - beam-sqlite
+  - beam-migrate
   - blaze-html
-  - cereal
-  - cereal-text
-  - cereal-time
   - clay
   - containers
   - dhall

src/Aggreact/Comments/Server.hs

@@ -49,8 +49,7 @@ import           Aggreact.Users                 (User, UserHandler (..),
 import qualified Data.IxSet.Typed               as IxSet
 import           Data.Time                      (getCurrentTime)
 import qualified Data.UUID                      as UUID
-import           Database.Store                 (Entity (..), Id (..),
-                                                 minimalId)
+import           Database.Store                 (Entity (..), Id (..))
 import           Servant
 import           Servant.Auth.Server            (AuthResult (..))
 import           Servant.HTML.Blaze             (HTML)
@@ -111,10 +110,9 @@ showComment muser AuthorizationHandler{..} CommentHandler{..} i = do
                                      }
         _ -> notFound "" muser
 
-muserToUserId :: Maybe User -> UserId
-muserToUserId Nothing               = UserId (toS minimalId)
-muserToUserId (Just (Entity i _ _)) = UserId (toS i)
-
+muserToUserId :: Maybe User -> MUserId
+muserToUserId Nothing               = MUserId Nothing
+muserToUserId (Just (Entity i _ _)) = MUserId (Just (UserId (toS i)))
 
 postNewComment :: Maybe User -> AuthorizationHandler -> CommentHandler -> NewComment -> Handler CreatedComment
 postNewComment muser AuthorizationHandler{..} ch nc = do

src/Aggreact/Comments/StoreService.hs

@@ -46,7 +46,6 @@ import           Aggreact.Comments.Types
 import qualified Aggreact.Users                as User
 
 --------------------------------------------------------------------------------
-import           Data.Time.Clock.Serialize     ()
 import           Data.Time.Format              ()
 import           Database.SQLite.Simple        (Only (..), query, query_)
 

src/Aggreact/Comments/Types.hs

@@ -64,7 +64,6 @@ import           Data.Data                        (Data (..))
 import           Data.IxSet.OrphanInstances       ()
 import qualified Data.IxSet.Typed                 as IxSet
 import qualified Data.Text                        as Text
-import           Data.Time.Clock.Serialize        ()
 import           Data.Time.Format                 ()
 import           Data.Typeable                    (Typeable)
 import           Data.UUID                        (UUID)
@@ -110,7 +109,7 @@ deriving instance ToJSON CommentView
 -- SQLite Select
 instance FromRow CommentView where fromRow = CommentView <$> fromRow <*> fromRow
 
-instance FromRow (Maybe User) where fromRow = (SQL.genericFromRow :: RowParser User)
+instance FromRow (Maybe User) where fromRow = Just <$> fromRow
 
 -- Indexing
 type CommentViews = IxSet.IxSet CommentViewIxs CommentView

src/Aggreact/Comments/Views.hs

@@ -52,7 +52,6 @@ import           Data.Duration               (approximativeDuration)
 import qualified Data.IxSet.Typed            as IxSet
 import           Data.String                 (IsString (..))
 import           Data.Time                   (UTCTime, diffUTCTime)
-import           Data.Time.Clock.Serialize   ()
 import           Data.Time.Format            ()
 import qualified Data.UUID                   as UUID
 import           Database.Store              (DefaultMetas (..), Entity (..))
@@ -192,7 +191,7 @@ displayHidingBlock cid comment children =
         children
 
 displayCommentView :: CommentView -> UTCTime -> H.Markup -> H.Markup
-displayCommentView (CommentView comment user) vt children = do
+displayCommentView (CommentView comment muser) vt children = do
   let inputid = "toggle-" <> UUID.toString (toS (id comment))
   H.input ! A.type_ "checkbox" ! A.class_ "toggleinput" ! A.id (cvt inputid)
   H.div $ do
@@ -200,7 +199,9 @@ displayCommentView (CommentView comment user) vt children = do
       H.div ! A.id (cvt cid) ! A.class_ "metas" $ do
           H.label ! A.for (cvt inputid) ! A.class_ "togglelabel" $ H.span (H.text "[-]")
           H.a ! A.href (cvt ('#':cid)) $ "§ "
-          H.a ! A.href (cvt ("/user/" <> urlEncode (toS (id user)))) $ H.text (toS (nick (val user)))
+          case muser of
+            Nothing -> H.span (H.text "Anonymous Coward")
+            Just user -> H.a ! A.href (cvt ("/user/" <> urlEncode (toS (id user)))) $ H.text (toS (nick (val user)))
           displayTime vt comment
       displayHidingBlock cid comment children
 

src/Aggreact/Slugs/StoreService.hs

@@ -45,7 +45,6 @@ import           Protolude
 import           Aggreact.Slugs.Types
 
 --------------------------------------------------------------------------------
-import           Data.Time.Clock.Serialize     ()
 import           Data.Time.Format              ()
 import           Database.SQLite.Simple        (query_)
 

src/Aggreact/Slugs/Types.hs

@@ -60,7 +60,6 @@ import           Data.Aeson                       (FromJSON (..), ToJSON (..),
                                                    genericToJSON)
 import           Data.Data                        (Data (..))
 import qualified Data.IxSet.Typed                 as IxSet
-import           Data.Time.Clock.Serialize        ()
 import           Data.Time.Format                 ()
 import           Data.Typeable                    (Typeable)
 import           Database.SQLite.Simple.FromField (FromField (..))

src/Aggreact/Slugs/Views.hs

@@ -50,7 +50,6 @@ import           Aggreact.Users              (NewUser (..), User, loginWidget)
 import           Data.Aeson                  (ToJSON (..))
 import           Data.String                 (IsString (..))
 import           Data.Time                   (UTCTime)
-import           Data.Time.Clock.Serialize   ()
 import           Data.Time.Format            ()
 import           Database.Store              (Entity (..))
 import           Text.Blaze.Html5            ((!))

stack.yaml

@@ -41,9 +41,11 @@ packages:
 # (e.g., acme-missiles-0.3)
 extra-deps:
 - ixset-1.1.1
-- syb-with-class-0.6.1.10
-- acid-state-0.14.3
 - human-readable-duration-0.2.1.2
+- beam-core-0.8.0.0
+- beam-migrate-0.4.0.0
+- beam-sqlite-0.4.0.0
+
 
 # Override default flag values for local packages and extra-deps
 # flags: {}