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)