diff --git a/aggreact.cabal b/aggreact.cabal index 8cb6149..e780bcc 100644 --- a/aggreact.cabal +++ b/aggreact.cabal @@ -1,8 +1,10 @@ --- This file has been generated from package.yaml by hpack version 0.28.2. +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.31.2. -- -- see: https://github.com/sol/hpack -- --- hash: b4988a3c9435d94fc18d9e5063a020aa1bd3ef2b958b49a1fde23a8d052be970 +-- hash: 5edc28ddb6ddbaae8fca1102380d6eca821d473ed494bca0e66de11e29600b9f name: aggreact version: 0.1.0.0 @@ -16,7 +18,6 @@ copyright: © 2018 Yann Esposito license: ISC license-file: LICENSE build-type: Simple -cabal-version: >= 1.10 extra-source-files: README.md stack.yaml diff --git a/src/Aggreact/Comments/Types.hs b/src/Aggreact/Comments/Types.hs index cc3c97d..e03c108 100644 --- a/src/Aggreact/Comments/Types.hs +++ b/src/Aggreact/Comments/Types.hs @@ -52,7 +52,7 @@ where import Protolude -import Aggreact.Users (User, UserId) +import Aggreact.Users (User, UserId(..)) import qualified Control.Exception as Ex import Data.Aeson (FromJSON (..), ToJSON (..), @@ -102,13 +102,16 @@ instance IxSet.Indexable CommentIxs Comment where -- ** CommentView -- | A CommentView is a comment along its creator infos -data CommentView = CommentView Comment User +data CommentView = CommentView Comment (Maybe User) deriving (Eq,Ord,Data,Typeable,Generic,Show) -- Web deriving instance ToJSON CommentView -- SQLite Select instance FromRow CommentView where fromRow = CommentView <$> fromRow <*> fromRow + +instance FromRow (Maybe User) where fromRow = (SQL.genericFromRow :: RowParser User) + -- Indexing type CommentViews = IxSet.IxSet CommentViewIxs CommentView type CommentViewIxs = '[Id,ParentId,Slug,Content,UserId,Term] @@ -129,7 +132,7 @@ data NewComment = { parent :: ParentId -- ^ UUID , slug :: Slug -- ^ Text (URL) , content :: Content -- ^ Text - , userid :: UserId -- ^ UUID + , userid :: MUserId -- ^ UUID } deriving (Generic,Typeable,Data,Eq,Ord,Show) -- Web @@ -155,6 +158,17 @@ instance IxSet.Indexable NewCommentIxs Comment where (IxSet.ixGen (Proxy :: Proxy UserId)) (IxSet.ixFun getTerms) + +-- *** Field MUserId +newtype MUserId = MUserId (Maybe UserId) deriving (Eq,Ord,Show,Generic,Data) +deriving anyclass instance FromJSON MUserId +deriving anyclass instance ToJSON MUserId +deriving newtype instance ToField MUserId +deriving newtype instance FromField MUserId +instance (ToSQLiteFieldTypeList rest) => ToSQLiteFieldTypeList (MUserId ': rest) where + toSqliteTypes _ = "TEXT":toSqliteTypes (Proxy :: Proxy rest) + + -- *** Field ParentId newtype ParentId = ParentId (Maybe UUID) deriving (Eq,Ord,Show,Generic,Data) deriving anyclass instance FromJSON ParentId @@ -194,6 +208,15 @@ instance (ToSQLiteFieldTypeList rest) => ToSQLiteFieldTypeList (Content ': rest) newtype Term = Term Text deriving (Eq,Ord,Generic) +instance FormI.FromHttpApiData MUserId where + parseUrlPiece s = do + txt <- FormI.parseUrlPiece s + if Text.null txt + then return (MUserId Nothing) + else case UUID.fromText txt of + Nothing -> Left $ "Parent ID is not an UUID (" <> txt <> ")" + Just uuid -> return (MUserId (Just (UserId (toS uuid)))) + instance FormI.FromHttpApiData ParentId where parseUrlPiece s = do txt <- FormI.parseUrlPiece s