{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoFieldSelectors #-}

module WikiMusic.Model.Comment
  ( Comment (..),
    parseCommentRows,
  )
where

import Data.Aeson hiding (Success)
import Data.OpenApi
import Data.Time
import Data.UUID
import Relude
import Optics

data Comment = Comment
  { Comment -> UUID
identifier :: UUID,
    Comment -> Maybe UUID
parentIdentifier :: Maybe UUID,
    Comment -> UUID
createdBy :: UUID,
    Comment -> Int
visibilityStatus :: Int,
    Comment -> Text
contents :: Text,
    Comment -> Maybe UUID
approvedBy :: Maybe UUID,
    Comment -> UTCTime
createdAt :: UTCTime,
    Comment -> Maybe UTCTime
lastEditedAt :: Maybe UTCTime
  }
  deriving (Comment -> Comment -> Bool
(Comment -> Comment -> Bool)
-> (Comment -> Comment -> Bool) -> Eq Comment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Comment -> Comment -> Bool
== :: Comment -> Comment -> Bool
$c/= :: Comment -> Comment -> Bool
/= :: Comment -> Comment -> Bool
Eq, Int -> Comment -> ShowS
[Comment] -> ShowS
Comment -> String
(Int -> Comment -> ShowS)
-> (Comment -> String) -> ([Comment] -> ShowS) -> Show Comment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Comment -> ShowS
showsPrec :: Int -> Comment -> ShowS
$cshow :: Comment -> String
show :: Comment -> String
$cshowList :: [Comment] -> ShowS
showList :: [Comment] -> ShowS
Show, (forall x. Comment -> Rep Comment x)
-> (forall x. Rep Comment x -> Comment) -> Generic Comment
forall x. Rep Comment x -> Comment
forall x. Comment -> Rep Comment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Comment -> Rep Comment x
from :: forall x. Comment -> Rep Comment x
$cto :: forall x. Rep Comment x -> Comment
to :: forall x. Rep Comment x -> Comment
Generic, Maybe Comment
Value -> Parser [Comment]
Value -> Parser Comment
(Value -> Parser Comment)
-> (Value -> Parser [Comment]) -> Maybe Comment -> FromJSON Comment
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Comment
parseJSON :: Value -> Parser Comment
$cparseJSONList :: Value -> Parser [Comment]
parseJSONList :: Value -> Parser [Comment]
$comittedField :: Maybe Comment
omittedField :: Maybe Comment
FromJSON, [Comment] -> Value
[Comment] -> Encoding
Comment -> Bool
Comment -> Value
Comment -> Encoding
(Comment -> Value)
-> (Comment -> Encoding)
-> ([Comment] -> Value)
-> ([Comment] -> Encoding)
-> (Comment -> Bool)
-> ToJSON Comment
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Comment -> Value
toJSON :: Comment -> Value
$ctoEncoding :: Comment -> Encoding
toEncoding :: Comment -> Encoding
$ctoJSONList :: [Comment] -> Value
toJSONList :: [Comment] -> Value
$ctoEncodingList :: [Comment] -> Encoding
toEncodingList :: [Comment] -> Encoding
$comitField :: Comment -> Bool
omitField :: Comment -> Bool
ToJSON, Typeable Comment
Typeable Comment =>
(Proxy Comment -> Declare (Definitions Schema) NamedSchema)
-> ToSchema Comment
Proxy Comment -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy Comment -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy Comment -> Declare (Definitions Schema) NamedSchema
ToSchema)

makeFieldLabelsNoPrefix ''Comment

parseCommentRows :: (JoinKinds k1 l k2, Is k2 A_Getter, LabelOptic "identifier" l u v a1 a1, LabelOptic "comment" k1 b b u v) => (a2 -> b) -> [a2] -> [(a1, b)]
parseCommentRows :: forall k1 l k2 u v a1 b a2.
(JoinKinds k1 l k2, Is k2 A_Getter,
 LabelOptic "identifier" l u v a1 a1,
 LabelOptic "comment" k1 b b u v) =>
(a2 -> b) -> [a2] -> [(a1, b)]
parseCommentRows a2 -> b
fromRow = (a2 -> (a1, b)) -> [a2] -> [(a1, b)]
forall a b. (a -> b) -> [a] -> [b]
map ((\b
x -> (b
x b -> Optic' k2 NoIx b a1 -> a1
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic k1 NoIx b b u v
#comment Optic k1 NoIx b b u v
-> Optic l NoIx u v a1 a1 -> Optic' k2 NoIx b a1
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic l NoIx u v a1 a1
#identifier, b
x)) (b -> (a1, b)) -> (a2 -> b) -> a2 -> (a1, b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a2 -> b
fromRow)