1 {-# LANGUAGE TemplateHaskell, TypeFamilies, OverloadedStrings #-} 2 module Databrary.Model.Comment.Types 3 ( Comment(..) 4 , CommentRow(..) 5 , makeComment 6 ) where 7 8 -- import qualified Data.Time as Time 9 import Data.Maybe (fromMaybe) 10 import qualified Data.Text as T 11 12 import Databrary.Has (Has(..)) 13 import Databrary.Model.Container.Types 14 import Databrary.Model.Kind 15 import Databrary.Model.Time 16 import Databrary.Model.Id.Types 17 import Databrary.Model.Party.Types 18 -- import Databrary.Model.Permission.Types 19 -- import Databrary.Model.Release.Types 20 import Databrary.Model.Segment 21 import Databrary.Model.Slot.Types 22 import Databrary.Model.Volume.Types 23 24 type instance IdType Comment = Int32 25 26 data Comment = Comment 27 { commentId :: Id Comment 28 , commentWho :: Account 29 , commentSlot :: Slot 30 , commentTime :: Timestamp 31 , commentText :: T.Text 32 , commentParents :: [Id Comment] 33 } 34 35 instance Kinded Comment where 36 kindOf _ = "comment" 37 38 -- makeHasRec ''Comment ['commentId, 'commentWho, 'commentSlot, 'commentTime] 39 instance Has (Id Comment) Comment where 40 view = commentId 41 -- instance Has Account Comment where 42 -- view = commentWho 43 -- instance Has (Id Party) Comment where 44 -- view = (view . commentWho) 45 -- instance Has PartyRow Comment where 46 -- view = (view . commentWho) 47 -- instance Has Party Comment where 48 -- view = (view . commentWho) 49 -- instance Has Slot Comment where 50 -- view = commentSlot 51 instance Has Databrary.Model.Segment.Segment Comment where 52 view = (view . commentSlot) 53 -- instance Has Databrary.Model.Container.Types.ContainerRow Comment where 54 -- view = (view . commentSlot) 55 instance Has (Id Databrary.Model.Container.Types.Container) Comment where 56 view = (view . commentSlot) 57 -- instance Has (Maybe Databrary.Model.Release.Types.Release) Comment where 58 -- view = (view . commentSlot) 59 -- instance Has Databrary.Model.Release.Types.Release Comment where 60 -- view = (view . commentSlot) 61 instance Has Databrary.Model.Volume.Types.Volume Comment where 62 view = (view . commentSlot) 63 -- instance Has Databrary.Model.Permission.Types.Permission Comment where 64 -- view = (view . commentSlot) 65 instance Has (Id Databrary.Model.Volume.Types.Volume) Comment where 66 view = (view . commentSlot) 67 -- instance Has Databrary.Model.Volume.Types.VolumeRow Comment where 68 -- view = (view . commentSlot) 69 -- instance Has Databrary.Model.Container.Types.Container Comment where 70 -- view = (view . commentSlot) 71 -- instance Has Timestamp Comment where 72 -- view = commentTime 73 -- instance Has Time.Day Comment where 74 -- view = (Time.utctDay . commentTime) 75 76 data CommentRow = CommentRow 77 { commentRowId :: Id Comment 78 , commentRowWhoId :: Id Party 79 , commentRowSlotId :: SlotId 80 , commentRowTime :: Timestamp 81 , commentRowText :: T.Text 82 } 83 84 makeComment :: Id Comment -> Segment -> Timestamp -> T.Text -> [Maybe (Id Comment)] -> Account -> Container -> Comment 85 makeComment i s t x p w c = Comment i w (Slot c s) t x (map (fromMaybe (error "NULL comment thread")) p)