{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoFieldSelectors #-}
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module WikiMusic.Beam.Song where

import Data.Map qualified as Map
import Data.UUID qualified as UUID
import Database.Beam
import Optics
import Relude
import WikiMusic.Beam.Util
import WikiMusic.Model.Song
import WikiMusic.Protolude

data SongT f = Song'
  { forall (f :: * -> *). SongT f -> C f Text
identifier :: C f Text,
    forall (f :: * -> *). SongT f -> C f Text
displayName :: C f Text,
    forall (f :: * -> *). SongT f -> C f (Maybe Text)
musicKey :: C f (Maybe Text),
    forall (f :: * -> *). SongT f -> C f (Maybe Text)
musicTuning :: C f (Maybe Text),
    forall (f :: * -> *). SongT f -> C f (Maybe Text)
musicCreationDate :: C f (Maybe Text),
    forall (f :: * -> *). SongT f -> C f (Maybe Text)
albumName :: C f (Maybe Text),
    forall (f :: * -> *). SongT f -> C f (Maybe Text)
albumInfoLink :: C f (Maybe Text),
    forall (f :: * -> *). SongT f -> C f Text
createdBy :: C f Text,
    forall (f :: * -> *). SongT f -> C f Int64
visibilityStatus :: C f Int64,
    forall (f :: * -> *). SongT f -> C f (Maybe Text)
approvedBy :: C f (Maybe Text),
    forall (f :: * -> *). SongT f -> C f UTCTime
createdAt :: C f UTCTime,
    forall (f :: * -> *). SongT f -> C f (Maybe UTCTime)
lastEditedAt :: C f (Maybe UTCTime),
    forall (f :: * -> *). SongT f -> C f Int64
viewCount :: C f Int64,
    forall (f :: * -> *). SongT f -> C f (Maybe Text)
description :: C f (Maybe Text)
  }
  deriving ((forall x. SongT f -> Rep (SongT f) x)
-> (forall x. Rep (SongT f) x -> SongT f) -> Generic (SongT f)
forall x. Rep (SongT f) x -> SongT f
forall x. SongT f -> Rep (SongT f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) x. Rep (SongT f) x -> SongT f
forall (f :: * -> *) x. SongT f -> Rep (SongT f) x
$cfrom :: forall (f :: * -> *) x. SongT f -> Rep (SongT f) x
from :: forall x. SongT f -> Rep (SongT f) x
$cto :: forall (f :: * -> *) x. Rep (SongT f) x -> SongT f
to :: forall x. Rep (SongT f) x -> SongT f
Generic, TableSkeleton SongT
(forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
 Applicative m =>
 (forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
 -> SongT f -> SongT g -> m (SongT h))
-> TableSkeleton SongT -> Beamable SongT
forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> SongT f -> SongT g -> m (SongT h)
forall (table :: (* -> *) -> *).
(forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
 Applicative m =>
 (forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
 -> table f -> table g -> m (table h))
-> TableSkeleton table -> Beamable table
$czipBeamFieldsM :: forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> SongT f -> SongT g -> m (SongT h)
zipBeamFieldsM :: forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> SongT f -> SongT g -> m (SongT h)
$ctblSkeleton :: TableSkeleton SongT
tblSkeleton :: TableSkeleton SongT
Beamable)

makeFieldLabelsNoPrefix ''SongT

type Song' = SongT Identity

instance Table SongT where
  data PrimaryKey SongT f = SongId (Columnar f Text) deriving ((forall x. PrimaryKey SongT f -> Rep (PrimaryKey SongT f) x)
-> (forall x. Rep (PrimaryKey SongT f) x -> PrimaryKey SongT f)
-> Generic (PrimaryKey SongT f)
forall x. Rep (PrimaryKey SongT f) x -> PrimaryKey SongT f
forall x. PrimaryKey SongT f -> Rep (PrimaryKey SongT f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) x.
Rep (PrimaryKey SongT f) x -> PrimaryKey SongT f
forall (f :: * -> *) x.
PrimaryKey SongT f -> Rep (PrimaryKey SongT f) x
$cfrom :: forall (f :: * -> *) x.
PrimaryKey SongT f -> Rep (PrimaryKey SongT f) x
from :: forall x. PrimaryKey SongT f -> Rep (PrimaryKey SongT f) x
$cto :: forall (f :: * -> *) x.
Rep (PrimaryKey SongT f) x -> PrimaryKey SongT f
to :: forall x. Rep (PrimaryKey SongT f) x -> PrimaryKey SongT f
Generic, TableSkeleton (PrimaryKey SongT)
(forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
 Applicative m =>
 (forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
 -> PrimaryKey SongT f
 -> PrimaryKey SongT g
 -> m (PrimaryKey SongT h))
-> TableSkeleton (PrimaryKey SongT) -> Beamable (PrimaryKey SongT)
forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> PrimaryKey SongT f
-> PrimaryKey SongT g
-> m (PrimaryKey SongT h)
forall (table :: (* -> *) -> *).
(forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
 Applicative m =>
 (forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
 -> table f -> table g -> m (table h))
-> TableSkeleton table -> Beamable table
$czipBeamFieldsM :: forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> PrimaryKey SongT f
-> PrimaryKey SongT g
-> m (PrimaryKey SongT h)
zipBeamFieldsM :: forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> PrimaryKey SongT f
-> PrimaryKey SongT g
-> m (PrimaryKey SongT h)
$ctblSkeleton :: TableSkeleton (PrimaryKey SongT)
tblSkeleton :: TableSkeleton (PrimaryKey SongT)
Beamable)
  primaryKey :: forall (column :: * -> *). SongT column -> PrimaryKey SongT column
primaryKey = Columnar column Text -> PrimaryKey SongT column
forall (f :: * -> *). Columnar f Text -> PrimaryKey SongT f
SongId (Columnar column Text -> PrimaryKey SongT column)
-> (SongT column -> Columnar column Text)
-> SongT column
-> PrimaryKey SongT column
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SongT column
-> Optic' A_Lens NoIx (SongT column) (Columnar column Text)
-> Columnar column Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx (SongT column) (Columnar column Text)
#identifier)

fromSongPk :: PrimaryKey SongT f -> Columnar f Text
fromSongPk :: forall (f :: * -> *). PrimaryKey SongT f -> Columnar f Text
fromSongPk (SongId Columnar f Text
i) = Columnar f Text
i

toSong :: Song' -> ExternalSources -> (UUID, Song)
toSong :: Song' -> ExternalSources -> (UUID, Song)
toSong Song'
x ExternalSources
ex =
  ( Text -> UUID
textToUUID (Text -> UUID) -> Text -> UUID
forall a b. (a -> b) -> a -> b
$ Song'
x Song' -> Optic' A_Lens NoIx Song' Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Song' Text
#identifier,
    Song
      { $sel:identifier:Song :: UUID
identifier = Text -> UUID
textToUUID (Text -> UUID) -> Text -> UUID
forall a b. (a -> b) -> a -> b
$ Song'
x Song' -> Optic' A_Lens NoIx Song' Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Song' Text
#identifier,
        $sel:musicKey:Song :: Maybe Text
musicKey = Song'
x Song' -> Optic' A_Lens NoIx Song' (Maybe Text) -> Maybe Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Song' (Maybe Text)
#musicKey,
        $sel:musicTuning:Song :: Maybe Text
musicTuning = Song'
x Song' -> Optic' A_Lens NoIx Song' (Maybe Text) -> Maybe Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Song' (Maybe Text)
#musicTuning,
        $sel:musicCreationDate:Song :: Maybe Text
musicCreationDate = Song'
x Song' -> Optic' A_Lens NoIx Song' (Maybe Text) -> Maybe Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Song' (Maybe Text)
#musicCreationDate,
        $sel:albumName:Song :: Maybe Text
albumName = Song'
x Song' -> Optic' A_Lens NoIx Song' (Maybe Text) -> Maybe Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Song' (Maybe Text)
#albumName,
        $sel:albumInfoLink:Song :: Maybe Text
albumInfoLink = Song'
x Song' -> Optic' A_Lens NoIx Song' (Maybe Text) -> Maybe Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Song' (Maybe Text)
#albumInfoLink,
        $sel:displayName:Song :: Text
displayName = Song'
x Song' -> Optic' A_Lens NoIx Song' Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Song' Text
#displayName,
        $sel:createdBy:Song :: UUID
createdBy = Text -> UUID
textToUUID (Text -> UUID) -> Text -> UUID
forall a b. (a -> b) -> a -> b
$ Song'
x Song' -> Optic' A_Lens NoIx Song' Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Song' Text
#createdBy,
        $sel:visibilityStatus:Song :: Int
visibilityStatus = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> Int64 -> Int
forall a b. (a -> b) -> a -> b
$ Song'
x Song' -> Optic' A_Lens NoIx Song' Int64 -> Int64
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Song' Int64
#visibilityStatus,
        $sel:approvedBy:Song :: Maybe UUID
approvedBy = (Text -> UUID) -> Maybe Text -> Maybe UUID
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> UUID
textToUUID) (Song'
x Song' -> Optic' A_Lens NoIx Song' (Maybe Text) -> Maybe Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Song' (Maybe Text)
#approvedBy),
        $sel:createdAt:Song :: UTCTime
createdAt = Song'
x Song' -> Optic' A_Lens NoIx Song' UTCTime -> UTCTime
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Song' UTCTime
#createdAt,
        $sel:lastEditedAt:Song :: Maybe UTCTime
lastEditedAt = Song'
x Song' -> Optic' A_Lens NoIx Song' (Maybe UTCTime) -> Maybe UTCTime
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Song' (Maybe UTCTime)
#lastEditedAt,
        $sel:viewCount:Song :: Int
viewCount = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> Int64 -> Int
forall a b. (a -> b) -> a -> b
$ Song'
x Song' -> Optic' A_Lens NoIx Song' Int64 -> Int64
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Song' Int64
#viewCount,
        $sel:description:Song :: Maybe Text
description = Song'
x Song' -> Optic' A_Lens NoIx Song' (Maybe Text) -> Maybe Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Song' (Maybe Text)
#description,
        $sel:artworks:Song :: Map UUID SongArtwork
artworks = Map UUID SongArtwork
forall k a. Map k a
Map.empty,
        $sel:comments:Song :: [ThreadRender SongComment]
comments = [],
        $sel:opinions:Song :: Map UUID SongOpinion
opinions = Map UUID SongOpinion
forall k a. Map k a
Map.empty,
        $sel:artists:Song :: Map UUID Text
artists = Map UUID Text
forall k a. Map k a
Map.empty,
        $sel:contents:Song :: Map UUID SongContent
contents = Map UUID SongContent
forall k a. Map k a
Map.empty,
        $sel:spotifyUrl:Song :: Maybe Text
spotifyUrl = ExternalSources
ex ExternalSources
-> Optic' A_Lens NoIx ExternalSources (Maybe Text) -> Maybe Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ExternalSources (Maybe Text)
#spotifyUrl,
        $sel:youtubeUrl:Song :: Maybe Text
youtubeUrl = ExternalSources
ex ExternalSources
-> Optic' A_Lens NoIx ExternalSources (Maybe Text) -> Maybe Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ExternalSources (Maybe Text)
#youtubeUrl,
        $sel:soundcloudUrl:Song :: Maybe Text
soundcloudUrl = ExternalSources
ex ExternalSources
-> Optic' A_Lens NoIx ExternalSources (Maybe Text) -> Maybe Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ExternalSources (Maybe Text)
#soundcloudUrl,
        $sel:wikipediaUrl:Song :: Maybe Text
wikipediaUrl = ExternalSources
ex ExternalSources
-> Optic' A_Lens NoIx ExternalSources (Maybe Text) -> Maybe Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ExternalSources (Maybe Text)
#wikipediaUrl
      }
  )

toPersistenceSong :: Song -> Song'
toPersistenceSong :: Song -> Song'
toPersistenceSong Song
x =
  Song'
    { $sel:identifier:Song' :: C Identity Text
identifier = UUID -> Text
UUID.toText (UUID -> Text) -> UUID -> Text
forall a b. (a -> b) -> a -> b
$ Song
x Song -> Optic' A_Lens NoIx Song UUID -> UUID
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Song UUID
#identifier,
      $sel:musicKey:Song' :: C Identity (Maybe Text)
musicKey = Song
x Song -> Optic' A_Lens NoIx Song (Maybe Text) -> Maybe Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Song (Maybe Text)
#musicKey,
      $sel:musicTuning:Song' :: C Identity (Maybe Text)
musicTuning = Song
x Song -> Optic' A_Lens NoIx Song (Maybe Text) -> Maybe Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Song (Maybe Text)
#musicTuning,
      $sel:musicCreationDate:Song' :: C Identity (Maybe Text)
musicCreationDate = Song
x Song -> Optic' A_Lens NoIx Song (Maybe Text) -> Maybe Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Song (Maybe Text)
#musicCreationDate,
      $sel:albumName:Song' :: C Identity (Maybe Text)
albumName = Song
x Song -> Optic' A_Lens NoIx Song (Maybe Text) -> Maybe Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Song (Maybe Text)
#albumName,
      $sel:albumInfoLink:Song' :: C Identity (Maybe Text)
albumInfoLink = Song
x Song -> Optic' A_Lens NoIx Song (Maybe Text) -> Maybe Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Song (Maybe Text)
#albumInfoLink,
      $sel:displayName:Song' :: C Identity Text
displayName = Song
x Song -> Optic' A_Lens NoIx Song Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Song Text
#displayName,
      $sel:createdBy:Song' :: C Identity Text
createdBy = UUID -> Text
UUID.toText (UUID -> Text) -> UUID -> Text
forall a b. (a -> b) -> a -> b
$ Song
x Song -> Optic' A_Lens NoIx Song UUID -> UUID
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Song UUID
#createdBy,
      $sel:visibilityStatus:Song' :: C Identity Int64
visibilityStatus = Int -> C Identity Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> C Identity Int64) -> Int -> C Identity Int64
forall a b. (a -> b) -> a -> b
$ Song
x Song -> Optic' A_Lens NoIx Song Int -> Int
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Song Int
#visibilityStatus,
      $sel:approvedBy:Song' :: C Identity (Maybe Text)
approvedBy = (UUID -> Text) -> Maybe UUID -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UUID -> Text
UUID.toText (Song
x Song -> Optic' A_Lens NoIx Song (Maybe UUID) -> Maybe UUID
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Song (Maybe UUID)
#approvedBy),
      $sel:createdAt:Song' :: C Identity UTCTime
createdAt = Song
x Song -> Optic' A_Lens NoIx Song UTCTime -> UTCTime
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Song UTCTime
#createdAt,
      $sel:lastEditedAt:Song' :: C Identity (Maybe UTCTime)
lastEditedAt = Song
x Song -> Optic' A_Lens NoIx Song (Maybe UTCTime) -> Maybe UTCTime
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Song (Maybe UTCTime)
#lastEditedAt,
      $sel:viewCount:Song' :: C Identity Int64
viewCount = Int -> C Identity Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> C Identity Int64) -> Int -> C Identity Int64
forall a b. (a -> b) -> a -> b
$ Song
x Song -> Optic' A_Lens NoIx Song Int -> Int
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Song Int
#viewCount,
      $sel:description:Song' :: C Identity (Maybe Text)
description = Song
x Song -> Optic' A_Lens NoIx Song (Maybe Text) -> Maybe Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Song (Maybe Text)
#description
    }

data SongCommentT f = SongComment'
  { forall (f :: * -> *). SongCommentT f -> C f Text
identifier :: C f Text,
    forall (f :: * -> *). SongCommentT f -> C f (Maybe Text)
parentIdentifier :: C f (Maybe Text),
    forall (f :: * -> *). SongCommentT f -> PrimaryKey SongT f
songIdentifier :: PrimaryKey SongT f,
    forall (f :: * -> *). SongCommentT f -> C f Text
createdBy :: C f Text,
    forall (f :: * -> *). SongCommentT f -> C f Int64
visibilityStatus :: C f Int64,
    forall (f :: * -> *). SongCommentT f -> C f Text
contents :: C f Text,
    forall (f :: * -> *). SongCommentT f -> C f (Maybe Text)
approvedBy :: C f (Maybe Text),
    forall (f :: * -> *). SongCommentT f -> C f UTCTime
createdAt :: C f UTCTime,
    forall (f :: * -> *). SongCommentT f -> C f (Maybe UTCTime)
lastEditedAt :: C f (Maybe UTCTime)
  }
  deriving ((forall x. SongCommentT f -> Rep (SongCommentT f) x)
-> (forall x. Rep (SongCommentT f) x -> SongCommentT f)
-> Generic (SongCommentT f)
forall x. Rep (SongCommentT f) x -> SongCommentT f
forall x. SongCommentT f -> Rep (SongCommentT f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) x. Rep (SongCommentT f) x -> SongCommentT f
forall (f :: * -> *) x. SongCommentT f -> Rep (SongCommentT f) x
$cfrom :: forall (f :: * -> *) x. SongCommentT f -> Rep (SongCommentT f) x
from :: forall x. SongCommentT f -> Rep (SongCommentT f) x
$cto :: forall (f :: * -> *) x. Rep (SongCommentT f) x -> SongCommentT f
to :: forall x. Rep (SongCommentT f) x -> SongCommentT f
Generic, TableSkeleton SongCommentT
(forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
 Applicative m =>
 (forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
 -> SongCommentT f -> SongCommentT g -> m (SongCommentT h))
-> TableSkeleton SongCommentT -> Beamable SongCommentT
forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> SongCommentT f -> SongCommentT g -> m (SongCommentT h)
forall (table :: (* -> *) -> *).
(forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
 Applicative m =>
 (forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
 -> table f -> table g -> m (table h))
-> TableSkeleton table -> Beamable table
$czipBeamFieldsM :: forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> SongCommentT f -> SongCommentT g -> m (SongCommentT h)
zipBeamFieldsM :: forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> SongCommentT f -> SongCommentT g -> m (SongCommentT h)
$ctblSkeleton :: TableSkeleton SongCommentT
tblSkeleton :: TableSkeleton SongCommentT
Beamable)

type SongComment' = SongCommentT Identity

instance Table SongCommentT where
  data PrimaryKey SongCommentT f = SongCommentId (Columnar f Text) deriving ((forall x.
 PrimaryKey SongCommentT f -> Rep (PrimaryKey SongCommentT f) x)
-> (forall x.
    Rep (PrimaryKey SongCommentT f) x -> PrimaryKey SongCommentT f)
-> Generic (PrimaryKey SongCommentT f)
forall x.
Rep (PrimaryKey SongCommentT f) x -> PrimaryKey SongCommentT f
forall x.
PrimaryKey SongCommentT f -> Rep (PrimaryKey SongCommentT f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) x.
Rep (PrimaryKey SongCommentT f) x -> PrimaryKey SongCommentT f
forall (f :: * -> *) x.
PrimaryKey SongCommentT f -> Rep (PrimaryKey SongCommentT f) x
$cfrom :: forall (f :: * -> *) x.
PrimaryKey SongCommentT f -> Rep (PrimaryKey SongCommentT f) x
from :: forall x.
PrimaryKey SongCommentT f -> Rep (PrimaryKey SongCommentT f) x
$cto :: forall (f :: * -> *) x.
Rep (PrimaryKey SongCommentT f) x -> PrimaryKey SongCommentT f
to :: forall x.
Rep (PrimaryKey SongCommentT f) x -> PrimaryKey SongCommentT f
Generic, TableSkeleton (PrimaryKey SongCommentT)
(forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
 Applicative m =>
 (forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
 -> PrimaryKey SongCommentT f
 -> PrimaryKey SongCommentT g
 -> m (PrimaryKey SongCommentT h))
-> TableSkeleton (PrimaryKey SongCommentT)
-> Beamable (PrimaryKey SongCommentT)
forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> PrimaryKey SongCommentT f
-> PrimaryKey SongCommentT g
-> m (PrimaryKey SongCommentT h)
forall (table :: (* -> *) -> *).
(forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
 Applicative m =>
 (forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
 -> table f -> table g -> m (table h))
-> TableSkeleton table -> Beamable table
$czipBeamFieldsM :: forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> PrimaryKey SongCommentT f
-> PrimaryKey SongCommentT g
-> m (PrimaryKey SongCommentT h)
zipBeamFieldsM :: forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> PrimaryKey SongCommentT f
-> PrimaryKey SongCommentT g
-> m (PrimaryKey SongCommentT h)
$ctblSkeleton :: TableSkeleton (PrimaryKey SongCommentT)
tblSkeleton :: TableSkeleton (PrimaryKey SongCommentT)
Beamable)
  primaryKey :: forall (column :: * -> *).
SongCommentT column -> PrimaryKey SongCommentT column
primaryKey = Columnar column Text -> PrimaryKey SongCommentT column
forall (f :: * -> *). Columnar f Text -> PrimaryKey SongCommentT f
SongCommentId (Columnar column Text -> PrimaryKey SongCommentT column)
-> (SongCommentT column -> Columnar column Text)
-> SongCommentT column
-> PrimaryKey SongCommentT column
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SongCommentT column
-> Optic' A_Lens NoIx (SongCommentT column) (Columnar column Text)
-> Columnar column Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx (SongCommentT column) (Columnar column Text)
#identifier)

makeFieldLabelsNoPrefix ''SongCommentT

toPersistenceSongComment :: SongComment -> SongComment'
toPersistenceSongComment :: SongComment -> SongComment'
toPersistenceSongComment SongComment
x =
  SongComment'
    { $sel:identifier:SongComment' :: C Identity Text
identifier = UUID -> Text
UUID.toText (UUID -> Text) -> UUID -> Text
forall a b. (a -> b) -> a -> b
$ SongComment
x SongComment -> Optic' A_Lens NoIx SongComment UUID -> UUID
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx SongComment SongComment Comment Comment
#comment Optic A_Lens NoIx SongComment SongComment Comment Comment
-> Optic A_Lens NoIx Comment Comment UUID UUID
-> Optic' A_Lens NoIx SongComment UUID
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 A_Lens NoIx Comment Comment UUID UUID
#identifier,
      $sel:parentIdentifier:SongComment' :: C Identity (Maybe Text)
parentIdentifier = (UUID -> Text) -> Maybe UUID -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (UUID -> Text
UUID.toText) (SongComment
x SongComment
-> Optic' A_Lens NoIx SongComment (Maybe UUID) -> Maybe UUID
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx SongComment SongComment Comment Comment
#comment Optic A_Lens NoIx SongComment SongComment Comment Comment
-> Optic A_Lens NoIx Comment Comment (Maybe UUID) (Maybe UUID)
-> Optic' A_Lens NoIx SongComment (Maybe UUID)
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 A_Lens NoIx Comment Comment (Maybe UUID) (Maybe UUID)
#parentIdentifier),
      $sel:songIdentifier:SongComment' :: PrimaryKey SongT Identity
songIdentifier = Text -> PrimaryKey SongT Identity
C Identity Text -> PrimaryKey SongT Identity
forall (f :: * -> *). Columnar f Text -> PrimaryKey SongT f
SongId (Text -> PrimaryKey SongT Identity)
-> (UUID -> Text) -> UUID -> PrimaryKey SongT Identity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> Text
UUID.toText (UUID -> PrimaryKey SongT Identity)
-> UUID -> PrimaryKey SongT Identity
forall a b. (a -> b) -> a -> b
$ SongComment
x SongComment -> Optic' A_Lens NoIx SongComment UUID -> UUID
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SongComment UUID
#songIdentifier,
      $sel:createdBy:SongComment' :: C Identity Text
createdBy = UUID -> Text
UUID.toText (UUID -> Text) -> UUID -> Text
forall a b. (a -> b) -> a -> b
$ SongComment
x SongComment -> Optic' A_Lens NoIx SongComment UUID -> UUID
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx SongComment SongComment Comment Comment
#comment Optic A_Lens NoIx SongComment SongComment Comment Comment
-> Optic A_Lens NoIx Comment Comment UUID UUID
-> Optic' A_Lens NoIx SongComment UUID
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 A_Lens NoIx Comment Comment UUID UUID
#createdBy,
      $sel:visibilityStatus:SongComment' :: C Identity Int64
visibilityStatus = Int -> C Identity Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> C Identity Int64) -> Int -> C Identity Int64
forall a b. (a -> b) -> a -> b
$ SongComment
x SongComment -> Optic' A_Lens NoIx SongComment Int -> Int
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx SongComment SongComment Comment Comment
#comment Optic A_Lens NoIx SongComment SongComment Comment Comment
-> Optic A_Lens NoIx Comment Comment Int Int
-> Optic' A_Lens NoIx SongComment Int
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 A_Lens NoIx Comment Comment Int Int
#visibilityStatus,
      $sel:contents:SongComment' :: C Identity Text
contents = SongComment
x SongComment -> Optic' A_Lens NoIx SongComment Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx SongComment SongComment Comment Comment
#comment Optic A_Lens NoIx SongComment SongComment Comment Comment
-> Optic A_Lens NoIx Comment Comment Text Text
-> Optic' A_Lens NoIx SongComment Text
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 A_Lens NoIx Comment Comment Text Text
#contents,
      $sel:approvedBy:SongComment' :: C Identity (Maybe Text)
approvedBy = (UUID -> Text) -> Maybe UUID -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (UUID -> Text
UUID.toText) (SongComment
x SongComment
-> Optic' A_Lens NoIx SongComment (Maybe UUID) -> Maybe UUID
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx SongComment SongComment Comment Comment
#comment Optic A_Lens NoIx SongComment SongComment Comment Comment
-> Optic A_Lens NoIx Comment Comment (Maybe UUID) (Maybe UUID)
-> Optic' A_Lens NoIx SongComment (Maybe UUID)
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 A_Lens NoIx Comment Comment (Maybe UUID) (Maybe UUID)
#approvedBy),
      $sel:createdAt:SongComment' :: C Identity UTCTime
createdAt = SongComment
x SongComment -> Optic' A_Lens NoIx SongComment UTCTime -> UTCTime
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx SongComment SongComment Comment Comment
#comment Optic A_Lens NoIx SongComment SongComment Comment Comment
-> Optic A_Lens NoIx Comment Comment UTCTime UTCTime
-> Optic' A_Lens NoIx SongComment UTCTime
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 A_Lens NoIx Comment Comment UTCTime UTCTime
#createdAt,
      $sel:lastEditedAt:SongComment' :: C Identity (Maybe UTCTime)
lastEditedAt = SongComment
x SongComment
-> Optic' A_Lens NoIx SongComment (Maybe UTCTime) -> Maybe UTCTime
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx SongComment SongComment Comment Comment
#comment Optic A_Lens NoIx SongComment SongComment Comment Comment
-> Optic
     A_Lens NoIx Comment Comment (Maybe UTCTime) (Maybe UTCTime)
-> Optic' A_Lens NoIx SongComment (Maybe UTCTime)
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 A_Lens NoIx Comment Comment (Maybe UTCTime) (Maybe UTCTime)
#lastEditedAt
    }

toSongComment :: SongComment' -> (UUID, SongComment)
toSongComment :: SongComment' -> (UUID, SongComment)
toSongComment SongComment'
x =
  ( Text -> UUID
textToUUID (Text -> UUID) -> Text -> UUID
forall a b. (a -> b) -> a -> b
$ SongComment'
x SongComment' -> Optic' A_Lens NoIx SongComment' Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SongComment' Text
#identifier,
    SongComment
      { $sel:songIdentifier:SongComment :: UUID
songIdentifier = Text -> UUID
textToUUID (Text -> UUID) -> Text -> UUID
forall a b. (a -> b) -> a -> b
$ PrimaryKey SongT Identity -> C Identity Text
forall (f :: * -> *). PrimaryKey SongT f -> Columnar f Text
fromSongPk (PrimaryKey SongT Identity -> C Identity Text)
-> PrimaryKey SongT Identity -> C Identity Text
forall a b. (a -> b) -> a -> b
$ SongComment'
x SongComment'
-> Optic' A_Lens NoIx SongComment' (PrimaryKey SongT Identity)
-> PrimaryKey SongT Identity
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SongComment' (PrimaryKey SongT Identity)
#songIdentifier,
        $sel:comment:SongComment :: Comment
comment = SongComment' -> Comment
forall {k1} {k2} {k3} {k4} {k5} {k6} {k7} {k8} {a} {s}.
(Is k1 A_Getter, Is k2 A_Getter, Is k3 A_Getter, Is k4 A_Getter,
 Is k5 A_Getter, Is k6 A_Getter, Is k7 A_Getter, Is k8 A_Getter,
 Integral a, LabelOptic "contents" k7 s s Text Text,
 LabelOptic "identifier" k5 s s Text Text,
 LabelOptic "createdBy" k6 s s Text Text,
 LabelOptic "visibilityStatus" k3 s s a a,
 LabelOptic "approvedBy" k2 s s (Maybe Text) (Maybe Text),
 LabelOptic "createdAt" k8 s s UTCTime UTCTime,
 LabelOptic "lastEditedAt" k1 s s (Maybe UTCTime) (Maybe UTCTime),
 LabelOptic "parentIdentifier" k4 s s (Maybe Text) (Maybe Text)) =>
s -> Comment
fromPersistenceComment (SongComment' -> Comment) -> SongComment' -> Comment
forall a b. (a -> b) -> a -> b
$ SongComment'
x
      }
  )

data SongArtworkT f = SongArtwork'
  { forall (f :: * -> *). SongArtworkT f -> C f Text
identifier :: C f Text,
    forall (f :: * -> *). SongArtworkT f -> PrimaryKey SongT f
songIdentifier :: PrimaryKey SongT f,
    forall (f :: * -> *). SongArtworkT f -> C f Text
createdBy :: C f Text,
    forall (f :: * -> *). SongArtworkT f -> C f Int64
visibilityStatus :: C f Int64,
    forall (f :: * -> *). SongArtworkT f -> C f (Maybe Text)
approvedBy :: C f (Maybe Text),
    forall (f :: * -> *). SongArtworkT f -> C f Text
contentUrl :: C f Text,
    forall (f :: * -> *). SongArtworkT f -> C f (Maybe Text)
contentCaption :: C f (Maybe Text),
    forall (f :: * -> *). SongArtworkT f -> C f Int64
orderValue :: C f Int64,
    forall (f :: * -> *). SongArtworkT f -> C f UTCTime
createdAt :: C f UTCTime,
    forall (f :: * -> *). SongArtworkT f -> C f (Maybe UTCTime)
lastEditedAt :: C f (Maybe UTCTime)
  }
  deriving ((forall x. SongArtworkT f -> Rep (SongArtworkT f) x)
-> (forall x. Rep (SongArtworkT f) x -> SongArtworkT f)
-> Generic (SongArtworkT f)
forall x. Rep (SongArtworkT f) x -> SongArtworkT f
forall x. SongArtworkT f -> Rep (SongArtworkT f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) x. Rep (SongArtworkT f) x -> SongArtworkT f
forall (f :: * -> *) x. SongArtworkT f -> Rep (SongArtworkT f) x
$cfrom :: forall (f :: * -> *) x. SongArtworkT f -> Rep (SongArtworkT f) x
from :: forall x. SongArtworkT f -> Rep (SongArtworkT f) x
$cto :: forall (f :: * -> *) x. Rep (SongArtworkT f) x -> SongArtworkT f
to :: forall x. Rep (SongArtworkT f) x -> SongArtworkT f
Generic, TableSkeleton SongArtworkT
(forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
 Applicative m =>
 (forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
 -> SongArtworkT f -> SongArtworkT g -> m (SongArtworkT h))
-> TableSkeleton SongArtworkT -> Beamable SongArtworkT
forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> SongArtworkT f -> SongArtworkT g -> m (SongArtworkT h)
forall (table :: (* -> *) -> *).
(forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
 Applicative m =>
 (forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
 -> table f -> table g -> m (table h))
-> TableSkeleton table -> Beamable table
$czipBeamFieldsM :: forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> SongArtworkT f -> SongArtworkT g -> m (SongArtworkT h)
zipBeamFieldsM :: forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> SongArtworkT f -> SongArtworkT g -> m (SongArtworkT h)
$ctblSkeleton :: TableSkeleton SongArtworkT
tblSkeleton :: TableSkeleton SongArtworkT
Beamable)

type SongArtwork' = SongArtworkT Identity

instance Table SongArtworkT where
  data PrimaryKey SongArtworkT f = SongArtworkId (Columnar f Text) deriving ((forall x.
 PrimaryKey SongArtworkT f -> Rep (PrimaryKey SongArtworkT f) x)
-> (forall x.
    Rep (PrimaryKey SongArtworkT f) x -> PrimaryKey SongArtworkT f)
-> Generic (PrimaryKey SongArtworkT f)
forall x.
Rep (PrimaryKey SongArtworkT f) x -> PrimaryKey SongArtworkT f
forall x.
PrimaryKey SongArtworkT f -> Rep (PrimaryKey SongArtworkT f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) x.
Rep (PrimaryKey SongArtworkT f) x -> PrimaryKey SongArtworkT f
forall (f :: * -> *) x.
PrimaryKey SongArtworkT f -> Rep (PrimaryKey SongArtworkT f) x
$cfrom :: forall (f :: * -> *) x.
PrimaryKey SongArtworkT f -> Rep (PrimaryKey SongArtworkT f) x
from :: forall x.
PrimaryKey SongArtworkT f -> Rep (PrimaryKey SongArtworkT f) x
$cto :: forall (f :: * -> *) x.
Rep (PrimaryKey SongArtworkT f) x -> PrimaryKey SongArtworkT f
to :: forall x.
Rep (PrimaryKey SongArtworkT f) x -> PrimaryKey SongArtworkT f
Generic, TableSkeleton (PrimaryKey SongArtworkT)
(forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
 Applicative m =>
 (forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
 -> PrimaryKey SongArtworkT f
 -> PrimaryKey SongArtworkT g
 -> m (PrimaryKey SongArtworkT h))
-> TableSkeleton (PrimaryKey SongArtworkT)
-> Beamable (PrimaryKey SongArtworkT)
forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> PrimaryKey SongArtworkT f
-> PrimaryKey SongArtworkT g
-> m (PrimaryKey SongArtworkT h)
forall (table :: (* -> *) -> *).
(forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
 Applicative m =>
 (forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
 -> table f -> table g -> m (table h))
-> TableSkeleton table -> Beamable table
$czipBeamFieldsM :: forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> PrimaryKey SongArtworkT f
-> PrimaryKey SongArtworkT g
-> m (PrimaryKey SongArtworkT h)
zipBeamFieldsM :: forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> PrimaryKey SongArtworkT f
-> PrimaryKey SongArtworkT g
-> m (PrimaryKey SongArtworkT h)
$ctblSkeleton :: TableSkeleton (PrimaryKey SongArtworkT)
tblSkeleton :: TableSkeleton (PrimaryKey SongArtworkT)
Beamable)
  primaryKey :: forall (column :: * -> *).
SongArtworkT column -> PrimaryKey SongArtworkT column
primaryKey = Columnar column Text -> PrimaryKey SongArtworkT column
forall (f :: * -> *). Columnar f Text -> PrimaryKey SongArtworkT f
SongArtworkId (Columnar column Text -> PrimaryKey SongArtworkT column)
-> (SongArtworkT column -> Columnar column Text)
-> SongArtworkT column
-> PrimaryKey SongArtworkT column
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SongArtworkT column
-> Optic' A_Lens NoIx (SongArtworkT column) (Columnar column Text)
-> Columnar column Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx (SongArtworkT column) (Columnar column Text)
#identifier)

makeFieldLabelsNoPrefix ''SongArtworkT

toSongArtwork :: SongArtwork' -> (UUID, SongArtwork)
toSongArtwork :: SongArtwork' -> (UUID, SongArtwork)
toSongArtwork SongArtwork'
x =
  ( Text -> UUID
textToUUID (Text -> UUID) -> Text -> UUID
forall a b. (a -> b) -> a -> b
$ SongArtwork'
x SongArtwork' -> Optic' A_Lens NoIx SongArtwork' Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SongArtwork' Text
#identifier,
    SongArtwork
      { $sel:songIdentifier:SongArtwork :: UUID
songIdentifier = Text -> UUID
textToUUID (Text -> UUID) -> Text -> UUID
forall a b. (a -> b) -> a -> b
$ PrimaryKey SongT Identity -> C Identity Text
forall (f :: * -> *). PrimaryKey SongT f -> Columnar f Text
fromSongPk (PrimaryKey SongT Identity -> C Identity Text)
-> PrimaryKey SongT Identity -> C Identity Text
forall a b. (a -> b) -> a -> b
$ SongArtwork'
x SongArtwork'
-> Optic' A_Lens NoIx SongArtwork' (PrimaryKey SongT Identity)
-> PrimaryKey SongT Identity
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SongArtwork' (PrimaryKey SongT Identity)
#songIdentifier,
        $sel:artwork:SongArtwork :: Artwork
artwork = SongArtwork' -> Artwork
forall {k1} {k2} {k3} {k4} {k5} {k6} {k7} {k8} {k9} {a1} {a2} {s}.
(Is k1 A_Getter, Is k2 A_Getter, Is k3 A_Getter, Is k4 A_Getter,
 Is k5 A_Getter, Is k6 A_Getter, Is k7 A_Getter, Is k8 A_Getter,
 Is k9 A_Getter, Integral a1, Integral a2,
 LabelOptic "identifier" k5 s s Text Text,
 LabelOptic "createdBy" k6 s s Text Text,
 LabelOptic "visibilityStatus" k4 s s a2 a2,
 LabelOptic "approvedBy" k7 s s (Maybe Text) (Maybe Text),
 LabelOptic "contentUrl" k3 s s Text Text,
 LabelOptic "contentCaption" k8 s s (Maybe Text) (Maybe Text),
 LabelOptic "orderValue" k2 s s a1 a1,
 LabelOptic "createdAt" k9 s s UTCTime UTCTime,
 LabelOptic
   "lastEditedAt" k1 s s (Maybe UTCTime) (Maybe UTCTime)) =>
s -> Artwork
fromPersistenceArtwork SongArtwork'
x
      }
  )

mkSongArtworkP :: SongArtwork -> SongArtwork'
mkSongArtworkP :: SongArtwork -> SongArtwork'
mkSongArtworkP SongArtwork
x =
  SongArtwork'
    { $sel:identifier:SongArtwork' :: C Identity Text
identifier = UUID -> Text
UUID.toText (UUID -> Text) -> UUID -> Text
forall a b. (a -> b) -> a -> b
$ SongArtwork
x SongArtwork -> Optic' A_Lens NoIx SongArtwork UUID -> UUID
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx SongArtwork SongArtwork Artwork Artwork
#artwork Optic A_Lens NoIx SongArtwork SongArtwork Artwork Artwork
-> Optic A_Lens NoIx Artwork Artwork UUID UUID
-> Optic' A_Lens NoIx SongArtwork UUID
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 A_Lens NoIx Artwork Artwork UUID UUID
#identifier,
      $sel:songIdentifier:SongArtwork' :: PrimaryKey SongT Identity
songIdentifier = C Identity Text -> PrimaryKey SongT Identity
forall (f :: * -> *). Columnar f Text -> PrimaryKey SongT f
SongId (C Identity Text -> PrimaryKey SongT Identity)
-> C Identity Text -> PrimaryKey SongT Identity
forall a b. (a -> b) -> a -> b
$ UUID -> Text
UUID.toText (UUID -> Text) -> UUID -> Text
forall a b. (a -> b) -> a -> b
$ SongArtwork
x SongArtwork -> Optic' A_Lens NoIx SongArtwork UUID -> UUID
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SongArtwork UUID
#songIdentifier,
      $sel:createdBy:SongArtwork' :: C Identity Text
createdBy = UUID -> Text
UUID.toText (UUID -> Text) -> UUID -> Text
forall a b. (a -> b) -> a -> b
$ SongArtwork
x SongArtwork -> Optic' A_Lens NoIx SongArtwork UUID -> UUID
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx SongArtwork SongArtwork Artwork Artwork
#artwork Optic A_Lens NoIx SongArtwork SongArtwork Artwork Artwork
-> Optic A_Lens NoIx Artwork Artwork UUID UUID
-> Optic' A_Lens NoIx SongArtwork UUID
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 A_Lens NoIx Artwork Artwork UUID UUID
#createdBy,
      $sel:visibilityStatus:SongArtwork' :: C Identity Int64
visibilityStatus = Int -> C Identity Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> C Identity Int64) -> Int -> C Identity Int64
forall a b. (a -> b) -> a -> b
$ SongArtwork
x SongArtwork -> Optic' A_Lens NoIx SongArtwork Int -> Int
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx SongArtwork SongArtwork Artwork Artwork
#artwork Optic A_Lens NoIx SongArtwork SongArtwork Artwork Artwork
-> Optic A_Lens NoIx Artwork Artwork Int Int
-> Optic' A_Lens NoIx SongArtwork Int
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 A_Lens NoIx Artwork Artwork Int Int
#visibilityStatus,
      $sel:contentUrl:SongArtwork' :: C Identity Text
contentUrl = SongArtwork
x SongArtwork -> Optic' A_Lens NoIx SongArtwork Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx SongArtwork SongArtwork Artwork Artwork
#artwork Optic A_Lens NoIx SongArtwork SongArtwork Artwork Artwork
-> Optic A_Lens NoIx Artwork Artwork Text Text
-> Optic' A_Lens NoIx SongArtwork Text
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 A_Lens NoIx Artwork Artwork Text Text
#contentUrl,
      $sel:contentCaption:SongArtwork' :: C Identity (Maybe Text)
contentCaption = SongArtwork
x SongArtwork
-> Optic' A_Lens NoIx SongArtwork (Maybe Text) -> Maybe Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx SongArtwork SongArtwork Artwork Artwork
#artwork Optic A_Lens NoIx SongArtwork SongArtwork Artwork Artwork
-> Optic A_Lens NoIx Artwork Artwork (Maybe Text) (Maybe Text)
-> Optic' A_Lens NoIx SongArtwork (Maybe Text)
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 A_Lens NoIx Artwork Artwork (Maybe Text) (Maybe Text)
#contentCaption,
      $sel:orderValue:SongArtwork' :: C Identity Int64
orderValue = Int -> C Identity Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> C Identity Int64) -> Int -> C Identity Int64
forall a b. (a -> b) -> a -> b
$ SongArtwork
x SongArtwork -> Optic' A_Lens NoIx SongArtwork Int -> Int
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx SongArtwork SongArtwork Artwork Artwork
#artwork Optic A_Lens NoIx SongArtwork SongArtwork Artwork Artwork
-> Optic A_Lens NoIx Artwork Artwork Int Int
-> Optic' A_Lens NoIx SongArtwork Int
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 A_Lens NoIx Artwork Artwork Int Int
#orderValue,
      $sel:approvedBy:SongArtwork' :: C Identity (Maybe Text)
approvedBy = (UUID -> Text) -> Maybe UUID -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UUID -> Text
UUID.toText (Maybe UUID -> Maybe Text) -> Maybe UUID -> Maybe Text
forall a b. (a -> b) -> a -> b
$ SongArtwork
x SongArtwork
-> Optic' A_Lens NoIx SongArtwork (Maybe UUID) -> Maybe UUID
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx SongArtwork SongArtwork Artwork Artwork
#artwork Optic A_Lens NoIx SongArtwork SongArtwork Artwork Artwork
-> Optic A_Lens NoIx Artwork Artwork (Maybe UUID) (Maybe UUID)
-> Optic' A_Lens NoIx SongArtwork (Maybe UUID)
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 A_Lens NoIx Artwork Artwork (Maybe UUID) (Maybe UUID)
#approvedBy,
      $sel:createdAt:SongArtwork' :: C Identity UTCTime
createdAt = SongArtwork
x SongArtwork -> Optic' A_Lens NoIx SongArtwork UTCTime -> UTCTime
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx SongArtwork SongArtwork Artwork Artwork
#artwork Optic A_Lens NoIx SongArtwork SongArtwork Artwork Artwork
-> Optic A_Lens NoIx Artwork Artwork UTCTime UTCTime
-> Optic' A_Lens NoIx SongArtwork UTCTime
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 A_Lens NoIx Artwork Artwork UTCTime UTCTime
#createdAt,
      $sel:lastEditedAt:SongArtwork' :: C Identity (Maybe UTCTime)
lastEditedAt = SongArtwork
x SongArtwork
-> Optic' A_Lens NoIx SongArtwork (Maybe UTCTime) -> Maybe UTCTime
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx SongArtwork SongArtwork Artwork Artwork
#artwork Optic A_Lens NoIx SongArtwork SongArtwork Artwork Artwork
-> Optic
     A_Lens NoIx Artwork Artwork (Maybe UTCTime) (Maybe UTCTime)
-> Optic' A_Lens NoIx SongArtwork (Maybe UTCTime)
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 A_Lens NoIx Artwork Artwork (Maybe UTCTime) (Maybe UTCTime)
#lastEditedAt
    }

data SongOpinionT f = SongOpinion'
  { forall (f :: * -> *). SongOpinionT f -> C f Text
identifier :: C f Text,
    forall (f :: * -> *). SongOpinionT f -> PrimaryKey SongT f
songIdentifier :: PrimaryKey SongT f,
    forall (f :: * -> *). SongOpinionT f -> C f Text
createdBy :: C f Text,
    forall (f :: * -> *). SongOpinionT f -> C f Bool
isLike :: C f Bool,
    forall (f :: * -> *). SongOpinionT f -> C f Bool
isDislike :: C f Bool,
    forall (f :: * -> *). SongOpinionT f -> C f UTCTime
createdAt :: C f UTCTime,
    forall (f :: * -> *). SongOpinionT f -> C f (Maybe UTCTime)
lastEditedAt :: C f (Maybe UTCTime)
  }
  deriving ((forall x. SongOpinionT f -> Rep (SongOpinionT f) x)
-> (forall x. Rep (SongOpinionT f) x -> SongOpinionT f)
-> Generic (SongOpinionT f)
forall x. Rep (SongOpinionT f) x -> SongOpinionT f
forall x. SongOpinionT f -> Rep (SongOpinionT f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) x. Rep (SongOpinionT f) x -> SongOpinionT f
forall (f :: * -> *) x. SongOpinionT f -> Rep (SongOpinionT f) x
$cfrom :: forall (f :: * -> *) x. SongOpinionT f -> Rep (SongOpinionT f) x
from :: forall x. SongOpinionT f -> Rep (SongOpinionT f) x
$cto :: forall (f :: * -> *) x. Rep (SongOpinionT f) x -> SongOpinionT f
to :: forall x. Rep (SongOpinionT f) x -> SongOpinionT f
Generic, TableSkeleton SongOpinionT
(forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
 Applicative m =>
 (forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
 -> SongOpinionT f -> SongOpinionT g -> m (SongOpinionT h))
-> TableSkeleton SongOpinionT -> Beamable SongOpinionT
forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> SongOpinionT f -> SongOpinionT g -> m (SongOpinionT h)
forall (table :: (* -> *) -> *).
(forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
 Applicative m =>
 (forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
 -> table f -> table g -> m (table h))
-> TableSkeleton table -> Beamable table
$czipBeamFieldsM :: forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> SongOpinionT f -> SongOpinionT g -> m (SongOpinionT h)
zipBeamFieldsM :: forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> SongOpinionT f -> SongOpinionT g -> m (SongOpinionT h)
$ctblSkeleton :: TableSkeleton SongOpinionT
tblSkeleton :: TableSkeleton SongOpinionT
Beamable)

type SongOpinion' = SongOpinionT Identity

instance Table SongOpinionT where
  data PrimaryKey SongOpinionT f = SongOpinionId (Columnar f Text) deriving ((forall x.
 PrimaryKey SongOpinionT f -> Rep (PrimaryKey SongOpinionT f) x)
-> (forall x.
    Rep (PrimaryKey SongOpinionT f) x -> PrimaryKey SongOpinionT f)
-> Generic (PrimaryKey SongOpinionT f)
forall x.
Rep (PrimaryKey SongOpinionT f) x -> PrimaryKey SongOpinionT f
forall x.
PrimaryKey SongOpinionT f -> Rep (PrimaryKey SongOpinionT f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) x.
Rep (PrimaryKey SongOpinionT f) x -> PrimaryKey SongOpinionT f
forall (f :: * -> *) x.
PrimaryKey SongOpinionT f -> Rep (PrimaryKey SongOpinionT f) x
$cfrom :: forall (f :: * -> *) x.
PrimaryKey SongOpinionT f -> Rep (PrimaryKey SongOpinionT f) x
from :: forall x.
PrimaryKey SongOpinionT f -> Rep (PrimaryKey SongOpinionT f) x
$cto :: forall (f :: * -> *) x.
Rep (PrimaryKey SongOpinionT f) x -> PrimaryKey SongOpinionT f
to :: forall x.
Rep (PrimaryKey SongOpinionT f) x -> PrimaryKey SongOpinionT f
Generic, TableSkeleton (PrimaryKey SongOpinionT)
(forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
 Applicative m =>
 (forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
 -> PrimaryKey SongOpinionT f
 -> PrimaryKey SongOpinionT g
 -> m (PrimaryKey SongOpinionT h))
-> TableSkeleton (PrimaryKey SongOpinionT)
-> Beamable (PrimaryKey SongOpinionT)
forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> PrimaryKey SongOpinionT f
-> PrimaryKey SongOpinionT g
-> m (PrimaryKey SongOpinionT h)
forall (table :: (* -> *) -> *).
(forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
 Applicative m =>
 (forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
 -> table f -> table g -> m (table h))
-> TableSkeleton table -> Beamable table
$czipBeamFieldsM :: forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> PrimaryKey SongOpinionT f
-> PrimaryKey SongOpinionT g
-> m (PrimaryKey SongOpinionT h)
zipBeamFieldsM :: forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> PrimaryKey SongOpinionT f
-> PrimaryKey SongOpinionT g
-> m (PrimaryKey SongOpinionT h)
$ctblSkeleton :: TableSkeleton (PrimaryKey SongOpinionT)
tblSkeleton :: TableSkeleton (PrimaryKey SongOpinionT)
Beamable)
  primaryKey :: forall (column :: * -> *).
SongOpinionT column -> PrimaryKey SongOpinionT column
primaryKey = Columnar column Text -> PrimaryKey SongOpinionT column
forall (f :: * -> *). Columnar f Text -> PrimaryKey SongOpinionT f
SongOpinionId (Columnar column Text -> PrimaryKey SongOpinionT column)
-> (SongOpinionT column -> Columnar column Text)
-> SongOpinionT column
-> PrimaryKey SongOpinionT column
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SongOpinionT column
-> Optic' A_Lens NoIx (SongOpinionT column) (Columnar column Text)
-> Columnar column Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx (SongOpinionT column) (Columnar column Text)
#identifier)

makeFieldLabelsNoPrefix ''SongOpinionT

toSongOpinion :: SongOpinion' -> (UUID, SongOpinion)
toSongOpinion :: SongOpinion' -> (UUID, SongOpinion)
toSongOpinion SongOpinion'
x =
  ( Text -> UUID
textToUUID (Text -> UUID) -> Text -> UUID
forall a b. (a -> b) -> a -> b
$ SongOpinion'
x SongOpinion' -> Optic' A_Lens NoIx SongOpinion' Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SongOpinion' Text
#identifier,
    SongOpinion
      { $sel:songIdentifier:SongOpinion :: UUID
songIdentifier = Text -> UUID
textToUUID (Text -> UUID) -> Text -> UUID
forall a b. (a -> b) -> a -> b
$ PrimaryKey SongT Identity -> C Identity Text
forall (f :: * -> *). PrimaryKey SongT f -> Columnar f Text
fromSongPk (PrimaryKey SongT Identity -> C Identity Text)
-> PrimaryKey SongT Identity -> C Identity Text
forall a b. (a -> b) -> a -> b
$ SongOpinion'
x SongOpinion'
-> Optic' A_Lens NoIx SongOpinion' (PrimaryKey SongT Identity)
-> PrimaryKey SongT Identity
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SongOpinion' (PrimaryKey SongT Identity)
#songIdentifier,
        $sel:opinion:SongOpinion :: Opinion
opinion = SongOpinion' -> Opinion
forall {k1} {k2} {k3} {k4} {k5} {k6} {s}.
(Is k1 A_Getter, Is k2 A_Getter, Is k3 A_Getter, Is k4 A_Getter,
 Is k5 A_Getter, Is k6 A_Getter,
 LabelOptic "identifier" k4 s s Text Text,
 LabelOptic "createdBy" k3 s s Text Text,
 LabelOptic "createdAt" k6 s s UTCTime UTCTime,
 LabelOptic "lastEditedAt" k1 s s (Maybe UTCTime) (Maybe UTCTime),
 LabelOptic "isLike" k5 s s Bool Bool,
 LabelOptic "isDislike" k2 s s Bool Bool) =>
s -> Opinion
fromPersistenceOpinion SongOpinion'
x
      }
  )

data SongExternalSourcesT f = SongExternalSources'
  { forall (f :: * -> *). SongExternalSourcesT f -> C f Text
identifier :: C f Text,
    forall (f :: * -> *). SongExternalSourcesT f -> PrimaryKey SongT f
songIdentifier :: PrimaryKey SongT f,
    forall (f :: * -> *). SongExternalSourcesT f -> C f Text
createdBy :: C f Text,
    forall (f :: * -> *). SongExternalSourcesT f -> C f (Maybe Text)
spotifyUrl :: C f (Maybe Text),
    forall (f :: * -> *). SongExternalSourcesT f -> C f (Maybe Text)
youtubeUrl :: C f (Maybe Text),
    forall (f :: * -> *). SongExternalSourcesT f -> C f (Maybe Text)
soundcloudUrl :: C f (Maybe Text),
    forall (f :: * -> *). SongExternalSourcesT f -> C f (Maybe Text)
wikipediaUrl :: C f (Maybe Text),
    forall (f :: * -> *). SongExternalSourcesT f -> C f UTCTime
createdAt :: C f UTCTime,
    forall (f :: * -> *). SongExternalSourcesT f -> C f (Maybe UTCTime)
lastEditedAt :: C f (Maybe UTCTime)
  }
  deriving ((forall x.
 SongExternalSourcesT f -> Rep (SongExternalSourcesT f) x)
-> (forall x.
    Rep (SongExternalSourcesT f) x -> SongExternalSourcesT f)
-> Generic (SongExternalSourcesT f)
forall x. Rep (SongExternalSourcesT f) x -> SongExternalSourcesT f
forall x. SongExternalSourcesT f -> Rep (SongExternalSourcesT f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) x.
Rep (SongExternalSourcesT f) x -> SongExternalSourcesT f
forall (f :: * -> *) x.
SongExternalSourcesT f -> Rep (SongExternalSourcesT f) x
$cfrom :: forall (f :: * -> *) x.
SongExternalSourcesT f -> Rep (SongExternalSourcesT f) x
from :: forall x. SongExternalSourcesT f -> Rep (SongExternalSourcesT f) x
$cto :: forall (f :: * -> *) x.
Rep (SongExternalSourcesT f) x -> SongExternalSourcesT f
to :: forall x. Rep (SongExternalSourcesT f) x -> SongExternalSourcesT f
Generic, TableSkeleton SongExternalSourcesT
(forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
 Applicative m =>
 (forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
 -> SongExternalSourcesT f
 -> SongExternalSourcesT g
 -> m (SongExternalSourcesT h))
-> TableSkeleton SongExternalSourcesT
-> Beamable SongExternalSourcesT
forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> SongExternalSourcesT f
-> SongExternalSourcesT g
-> m (SongExternalSourcesT h)
forall (table :: (* -> *) -> *).
(forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
 Applicative m =>
 (forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
 -> table f -> table g -> m (table h))
-> TableSkeleton table -> Beamable table
$czipBeamFieldsM :: forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> SongExternalSourcesT f
-> SongExternalSourcesT g
-> m (SongExternalSourcesT h)
zipBeamFieldsM :: forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> SongExternalSourcesT f
-> SongExternalSourcesT g
-> m (SongExternalSourcesT h)
$ctblSkeleton :: TableSkeleton SongExternalSourcesT
tblSkeleton :: TableSkeleton SongExternalSourcesT
Beamable)

type SongExternalSources' = SongExternalSourcesT Identity

instance Table SongExternalSourcesT where
  data PrimaryKey SongExternalSourcesT f = SongExternalSourcesId (Columnar f Text) deriving ((forall x.
 PrimaryKey SongExternalSourcesT f
 -> Rep (PrimaryKey SongExternalSourcesT f) x)
-> (forall x.
    Rep (PrimaryKey SongExternalSourcesT f) x
    -> PrimaryKey SongExternalSourcesT f)
-> Generic (PrimaryKey SongExternalSourcesT f)
forall x.
Rep (PrimaryKey SongExternalSourcesT f) x
-> PrimaryKey SongExternalSourcesT f
forall x.
PrimaryKey SongExternalSourcesT f
-> Rep (PrimaryKey SongExternalSourcesT f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) x.
Rep (PrimaryKey SongExternalSourcesT f) x
-> PrimaryKey SongExternalSourcesT f
forall (f :: * -> *) x.
PrimaryKey SongExternalSourcesT f
-> Rep (PrimaryKey SongExternalSourcesT f) x
$cfrom :: forall (f :: * -> *) x.
PrimaryKey SongExternalSourcesT f
-> Rep (PrimaryKey SongExternalSourcesT f) x
from :: forall x.
PrimaryKey SongExternalSourcesT f
-> Rep (PrimaryKey SongExternalSourcesT f) x
$cto :: forall (f :: * -> *) x.
Rep (PrimaryKey SongExternalSourcesT f) x
-> PrimaryKey SongExternalSourcesT f
to :: forall x.
Rep (PrimaryKey SongExternalSourcesT f) x
-> PrimaryKey SongExternalSourcesT f
Generic, TableSkeleton (PrimaryKey SongExternalSourcesT)
(forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
 Applicative m =>
 (forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
 -> PrimaryKey SongExternalSourcesT f
 -> PrimaryKey SongExternalSourcesT g
 -> m (PrimaryKey SongExternalSourcesT h))
-> TableSkeleton (PrimaryKey SongExternalSourcesT)
-> Beamable (PrimaryKey SongExternalSourcesT)
forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> PrimaryKey SongExternalSourcesT f
-> PrimaryKey SongExternalSourcesT g
-> m (PrimaryKey SongExternalSourcesT h)
forall (table :: (* -> *) -> *).
(forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
 Applicative m =>
 (forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
 -> table f -> table g -> m (table h))
-> TableSkeleton table -> Beamable table
$czipBeamFieldsM :: forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> PrimaryKey SongExternalSourcesT f
-> PrimaryKey SongExternalSourcesT g
-> m (PrimaryKey SongExternalSourcesT h)
zipBeamFieldsM :: forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> PrimaryKey SongExternalSourcesT f
-> PrimaryKey SongExternalSourcesT g
-> m (PrimaryKey SongExternalSourcesT h)
$ctblSkeleton :: TableSkeleton (PrimaryKey SongExternalSourcesT)
tblSkeleton :: TableSkeleton (PrimaryKey SongExternalSourcesT)
Beamable)
  primaryKey :: forall (column :: * -> *).
SongExternalSourcesT column
-> PrimaryKey SongExternalSourcesT column
primaryKey = Columnar column Text -> PrimaryKey SongExternalSourcesT column
forall (f :: * -> *).
Columnar f Text -> PrimaryKey SongExternalSourcesT f
SongExternalSourcesId (Columnar column Text -> PrimaryKey SongExternalSourcesT column)
-> (SongExternalSourcesT column -> Columnar column Text)
-> SongExternalSourcesT column
-> PrimaryKey SongExternalSourcesT column
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SongExternalSourcesT column
-> Optic'
     A_Lens NoIx (SongExternalSourcesT column) (Columnar column Text)
-> Columnar column Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic'
  A_Lens NoIx (SongExternalSourcesT column) (Columnar column Text)
#identifier)

makeFieldLabelsNoPrefix ''SongExternalSourcesT

toPersistenceSongExternalContents :: Song -> UUID -> SongExternalSources'
toPersistenceSongExternalContents :: Song -> UUID -> SongExternalSources'
toPersistenceSongExternalContents Song
x UUID
newIdentifier =
  SongExternalSources'
    { $sel:identifier:SongExternalSources' :: C Identity Text
identifier = UUID -> Text
UUID.toText (UUID -> Text) -> UUID -> Text
forall a b. (a -> b) -> a -> b
$ UUID
newIdentifier,
      $sel:songIdentifier:SongExternalSources' :: PrimaryKey SongT Identity
songIdentifier = C Identity Text -> PrimaryKey SongT Identity
forall (f :: * -> *). Columnar f Text -> PrimaryKey SongT f
SongId (C Identity Text -> PrimaryKey SongT Identity)
-> C Identity Text -> PrimaryKey SongT Identity
forall a b. (a -> b) -> a -> b
$ UUID -> Text
UUID.toText (UUID -> Text) -> UUID -> Text
forall a b. (a -> b) -> a -> b
$ Song
x Song -> Optic' A_Lens NoIx Song UUID -> UUID
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Song UUID
#identifier,
      $sel:createdBy:SongExternalSources' :: C Identity Text
createdBy = UUID -> Text
UUID.toText (UUID -> Text) -> UUID -> Text
forall a b. (a -> b) -> a -> b
$ Song
x Song -> Optic' A_Lens NoIx Song UUID -> UUID
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Song UUID
#createdBy,
      $sel:spotifyUrl:SongExternalSources' :: C Identity (Maybe Text)
spotifyUrl = Song
x Song -> Optic' A_Lens NoIx Song (Maybe Text) -> Maybe Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Song (Maybe Text)
#spotifyUrl,
      $sel:youtubeUrl:SongExternalSources' :: C Identity (Maybe Text)
youtubeUrl = Song
x Song -> Optic' A_Lens NoIx Song (Maybe Text) -> Maybe Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Song (Maybe Text)
#youtubeUrl,
      $sel:soundcloudUrl:SongExternalSources' :: C Identity (Maybe Text)
soundcloudUrl = Song
x Song -> Optic' A_Lens NoIx Song (Maybe Text) -> Maybe Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Song (Maybe Text)
#soundcloudUrl,
      $sel:wikipediaUrl:SongExternalSources' :: C Identity (Maybe Text)
wikipediaUrl = Song
x Song -> Optic' A_Lens NoIx Song (Maybe Text) -> Maybe Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Song (Maybe Text)
#wikipediaUrl,
      $sel:createdAt:SongExternalSources' :: C Identity UTCTime
createdAt = Song
x Song -> Optic' A_Lens NoIx Song UTCTime -> UTCTime
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Song UTCTime
#createdAt,
      $sel:lastEditedAt:SongExternalSources' :: C Identity (Maybe UTCTime)
lastEditedAt = Song
x Song -> Optic' A_Lens NoIx Song (Maybe UTCTime) -> Maybe UTCTime
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Song (Maybe UTCTime)
#lastEditedAt
    }

toPersistenceSongExternalSources :: SongExternalSources -> SongExternalSources'
toPersistenceSongExternalSources :: SongExternalSources -> SongExternalSources'
toPersistenceSongExternalSources SongExternalSources
x =
  SongExternalSources'
    { $sel:identifier:SongExternalSources' :: C Identity Text
identifier = UUID -> Text
UUID.toText (UUID -> Text) -> UUID -> Text
forall a b. (a -> b) -> a -> b
$ SongExternalSources
x SongExternalSources
-> Optic' A_Lens NoIx SongExternalSources UUID -> UUID
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SongExternalSources UUID
#identifier,
      $sel:songIdentifier:SongExternalSources' :: PrimaryKey SongT Identity
songIdentifier = C Identity Text -> PrimaryKey SongT Identity
forall (f :: * -> *). Columnar f Text -> PrimaryKey SongT f
SongId (C Identity Text -> PrimaryKey SongT Identity)
-> C Identity Text -> PrimaryKey SongT Identity
forall a b. (a -> b) -> a -> b
$ UUID -> Text
UUID.toText (UUID -> Text) -> UUID -> Text
forall a b. (a -> b) -> a -> b
$ SongExternalSources
x SongExternalSources
-> Optic' A_Lens NoIx SongExternalSources UUID -> UUID
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SongExternalSources UUID
#songIdentifier,
      $sel:createdBy:SongExternalSources' :: C Identity Text
createdBy = UUID -> Text
UUID.toText (UUID -> Text) -> UUID -> Text
forall a b. (a -> b) -> a -> b
$ SongExternalSources
x SongExternalSources
-> Optic' A_Lens NoIx SongExternalSources UUID -> UUID
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SongExternalSources UUID
#createdBy,
      $sel:spotifyUrl:SongExternalSources' :: C Identity (Maybe Text)
spotifyUrl = SongExternalSources
x SongExternalSources
-> Optic' A_Lens NoIx SongExternalSources (Maybe Text)
-> Maybe Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SongExternalSources (Maybe Text)
#spotifyUrl,
      $sel:youtubeUrl:SongExternalSources' :: C Identity (Maybe Text)
youtubeUrl = SongExternalSources
x SongExternalSources
-> Optic' A_Lens NoIx SongExternalSources (Maybe Text)
-> Maybe Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SongExternalSources (Maybe Text)
#youtubeUrl,
      $sel:soundcloudUrl:SongExternalSources' :: C Identity (Maybe Text)
soundcloudUrl = SongExternalSources
x SongExternalSources
-> Optic' A_Lens NoIx SongExternalSources (Maybe Text)
-> Maybe Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SongExternalSources (Maybe Text)
#soundcloudUrl,
      $sel:wikipediaUrl:SongExternalSources' :: C Identity (Maybe Text)
wikipediaUrl = SongExternalSources
x SongExternalSources
-> Optic' A_Lens NoIx SongExternalSources (Maybe Text)
-> Maybe Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SongExternalSources (Maybe Text)
#wikipediaUrl,
      $sel:createdAt:SongExternalSources' :: C Identity UTCTime
createdAt = SongExternalSources
x SongExternalSources
-> Optic' A_Lens NoIx SongExternalSources UTCTime -> UTCTime
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SongExternalSources UTCTime
#createdAt,
      $sel:lastEditedAt:SongExternalSources' :: C Identity (Maybe UTCTime)
lastEditedAt = SongExternalSources
x SongExternalSources
-> Optic' A_Lens NoIx SongExternalSources (Maybe UTCTime)
-> Maybe UTCTime
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SongExternalSources (Maybe UTCTime)
#lastEditedAt
    }

songTModification :: SongT (FieldModification (TableField SongT))
songTModification :: SongT (FieldModification (TableField SongT))
songTModification =
  SongT (FieldModification Any)
forall (f :: * -> *) (tbl :: (* -> *) -> *).
Beamable tbl =>
tbl (FieldModification f)
tableModification
    { identifier = "identifier",
      displayName = "display_name",
      createdBy = "created_by",
      musicKey = "music_key",
      musicTuning = "music_tuning",
      musicCreationDate = "music_creation_date",
      albumName = "album_name",
      albumInfoLink = "album_info_link",
      visibilityStatus = "visibility_status",
      approvedBy = "approved_by",
      createdAt = "created_at",
      lastEditedAt = "last_edited_at",
      viewCount = "views",
      description = "description"
    }

songCommentTModification :: SongCommentT (FieldModification (TableField SongCommentT))
songCommentTModification :: SongCommentT (FieldModification (TableField SongCommentT))
songCommentTModification =
  SongCommentT (FieldModification Any)
forall (f :: * -> *) (tbl :: (* -> *) -> *).
Beamable tbl =>
tbl (FieldModification f)
tableModification
    { identifier = "identifier",
      songIdentifier = SongId "song_identifier",
      parentIdentifier = "parent_identifier",
      createdBy = "created_by",
      visibilityStatus = "visibility_status",
      contents = "contents",
      approvedBy = "approved_by",
      createdAt = "created_at",
      lastEditedAt = "last_edited_at"
    }

songArtworkTModification :: SongArtworkT (FieldModification (TableField SongArtworkT))
songArtworkTModification :: SongArtworkT (FieldModification (TableField SongArtworkT))
songArtworkTModification =
  SongArtworkT (FieldModification Any)
forall (f :: * -> *) (tbl :: (* -> *) -> *).
Beamable tbl =>
tbl (FieldModification f)
tableModification
    { identifier = "identifier",
      songIdentifier = SongId "song_identifier",
      createdBy = "created_by",
      visibilityStatus = "visibility_status",
      approvedBy = "approved_by",
      contentUrl = "content_url",
      contentCaption = "content_caption",
      orderValue = "order_value",
      createdAt = "created_at",
      lastEditedAt = "last_edited_at"
    }

songOpinionTModification :: SongOpinionT (FieldModification (TableField SongOpinionT))
songOpinionTModification :: SongOpinionT (FieldModification (TableField SongOpinionT))
songOpinionTModification =
  SongOpinionT (FieldModification Any)
forall (f :: * -> *) (tbl :: (* -> *) -> *).
Beamable tbl =>
tbl (FieldModification f)
tableModification
    { identifier = "identifier",
      songIdentifier = SongId "song_identifier",
      createdBy = "created_by",
      isLike = "is_like",
      isDislike = "is_dislike",
      createdAt = "created_at",
      lastEditedAt = "last_edited_at"
    }

songExternalSourcesTModification :: SongExternalSourcesT (FieldModification (TableField SongExternalSourcesT))
songExternalSourcesTModification :: SongExternalSourcesT
  (FieldModification (TableField SongExternalSourcesT))
songExternalSourcesTModification =
  SongExternalSourcesT (FieldModification Any)
forall (f :: * -> *) (tbl :: (* -> *) -> *).
Beamable tbl =>
tbl (FieldModification f)
tableModification
    { identifier = "identifier",
      songIdentifier = SongId "song_identifier",
      createdBy = "created_by",
      spotifyUrl = "spotify_url",
      youtubeUrl = "youtube_url",
      soundcloudUrl = "soundcloud_url",
      wikipediaUrl = "wikipedia_url",
      createdAt = "created_at",
      lastEditedAt = "last_edited_at"
    }

mkSongOpinionP :: SongOpinion -> SongOpinion'
mkSongOpinionP :: SongOpinion -> SongOpinion'
mkSongOpinionP SongOpinion
x =
  SongOpinion'
    { $sel:identifier:SongOpinion' :: C Identity Text
identifier = UUID -> Text
UUID.toText (UUID -> Text) -> UUID -> Text
forall a b. (a -> b) -> a -> b
$ SongOpinion
x SongOpinion -> Optic' A_Lens NoIx SongOpinion UUID -> UUID
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx SongOpinion SongOpinion Opinion Opinion
#opinion Optic A_Lens NoIx SongOpinion SongOpinion Opinion Opinion
-> Optic A_Lens NoIx Opinion Opinion UUID UUID
-> Optic' A_Lens NoIx SongOpinion UUID
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 A_Lens NoIx Opinion Opinion UUID UUID
#identifier,
      $sel:songIdentifier:SongOpinion' :: PrimaryKey SongT Identity
songIdentifier = C Identity Text -> PrimaryKey SongT Identity
forall (f :: * -> *). Columnar f Text -> PrimaryKey SongT f
SongId (C Identity Text -> PrimaryKey SongT Identity)
-> C Identity Text -> PrimaryKey SongT Identity
forall a b. (a -> b) -> a -> b
$ UUID -> Text
UUID.toText (UUID -> Text) -> UUID -> Text
forall a b. (a -> b) -> a -> b
$ SongOpinion
x SongOpinion -> Optic' A_Lens NoIx SongOpinion UUID -> UUID
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SongOpinion UUID
#songIdentifier,
      $sel:createdBy:SongOpinion' :: C Identity Text
createdBy = UUID -> Text
UUID.toText (UUID -> Text) -> UUID -> Text
forall a b. (a -> b) -> a -> b
$ SongOpinion
x SongOpinion -> Optic' A_Lens NoIx SongOpinion UUID -> UUID
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx SongOpinion SongOpinion Opinion Opinion
#opinion Optic A_Lens NoIx SongOpinion SongOpinion Opinion Opinion
-> Optic A_Lens NoIx Opinion Opinion UUID UUID
-> Optic' A_Lens NoIx SongOpinion UUID
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 A_Lens NoIx Opinion Opinion UUID UUID
#createdBy,
      $sel:isLike:SongOpinion' :: C Identity Bool
isLike = SongOpinion
x SongOpinion -> Optic' A_Lens NoIx SongOpinion Bool -> Bool
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx SongOpinion SongOpinion Opinion Opinion
#opinion Optic A_Lens NoIx SongOpinion SongOpinion Opinion Opinion
-> Optic A_Lens NoIx Opinion Opinion Bool Bool
-> Optic' A_Lens NoIx SongOpinion Bool
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 A_Lens NoIx Opinion Opinion Bool Bool
#isLike,
      $sel:isDislike:SongOpinion' :: C Identity Bool
isDislike = SongOpinion
x SongOpinion -> Optic' A_Lens NoIx SongOpinion Bool -> Bool
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx SongOpinion SongOpinion Opinion Opinion
#opinion Optic A_Lens NoIx SongOpinion SongOpinion Opinion Opinion
-> Optic A_Lens NoIx Opinion Opinion Bool Bool
-> Optic' A_Lens NoIx SongOpinion Bool
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 A_Lens NoIx Opinion Opinion Bool Bool
#isDislike,
      $sel:createdAt:SongOpinion' :: C Identity UTCTime
createdAt = SongOpinion
x SongOpinion -> Optic' A_Lens NoIx SongOpinion UTCTime -> UTCTime
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx SongOpinion SongOpinion Opinion Opinion
#opinion Optic A_Lens NoIx SongOpinion SongOpinion Opinion Opinion
-> Optic A_Lens NoIx Opinion Opinion UTCTime UTCTime
-> Optic' A_Lens NoIx SongOpinion UTCTime
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 A_Lens NoIx Opinion Opinion UTCTime UTCTime
#createdAt,
      $sel:lastEditedAt:SongOpinion' :: C Identity (Maybe UTCTime)
lastEditedAt = SongOpinion
x SongOpinion
-> Optic' A_Lens NoIx SongOpinion (Maybe UTCTime) -> Maybe UTCTime
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx SongOpinion SongOpinion Opinion Opinion
#opinion Optic A_Lens NoIx SongOpinion SongOpinion Opinion Opinion
-> Optic
     A_Lens NoIx Opinion Opinion (Maybe UTCTime) (Maybe UTCTime)
-> Optic' A_Lens NoIx SongOpinion (Maybe UTCTime)
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 A_Lens NoIx Opinion Opinion (Maybe UTCTime) (Maybe UTCTime)
#lastEditedAt
    }

data SongContentsT f = SongContents'
  { forall (f :: * -> *). SongContentsT f -> C f Text
identifier :: C f Text,
    forall (f :: * -> *). SongContentsT f -> PrimaryKey SongT f
songIdentifier :: PrimaryKey SongT f,
    forall (f :: * -> *). SongContentsT f -> C f Text
versionName :: C f Text,
    forall (f :: * -> *). SongContentsT f -> C f Text
createdBy :: C f Text,
    forall (f :: * -> *). SongContentsT f -> C f Int64
visibilityStatus :: C f Int64,
    forall (f :: * -> *). SongContentsT f -> C f (Maybe Text)
approvedBy :: C f (Maybe Text),
    forall (f :: * -> *). SongContentsT f -> C f Text
instrumentType :: C f Text,
    forall (f :: * -> *). SongContentsT f -> C f (Maybe Text)
asciiLegend :: C f (Maybe Text),
    forall (f :: * -> *). SongContentsT f -> C f (Maybe Text)
asciiContents :: C f (Maybe Text),
    forall (f :: * -> *). SongContentsT f -> C f (Maybe Text)
pdfContents :: C f (Maybe Text),
    forall (f :: * -> *). SongContentsT f -> C f (Maybe Text)
guitarProContents :: C f (Maybe Text),
    forall (f :: * -> *). SongContentsT f -> C f UTCTime
createdAt :: C f UTCTime,
    forall (f :: * -> *). SongContentsT f -> C f (Maybe UTCTime)
lastEditedAt :: C f (Maybe UTCTime)
  }
  deriving ((forall x. SongContentsT f -> Rep (SongContentsT f) x)
-> (forall x. Rep (SongContentsT f) x -> SongContentsT f)
-> Generic (SongContentsT f)
forall x. Rep (SongContentsT f) x -> SongContentsT f
forall x. SongContentsT f -> Rep (SongContentsT f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) x. Rep (SongContentsT f) x -> SongContentsT f
forall (f :: * -> *) x. SongContentsT f -> Rep (SongContentsT f) x
$cfrom :: forall (f :: * -> *) x. SongContentsT f -> Rep (SongContentsT f) x
from :: forall x. SongContentsT f -> Rep (SongContentsT f) x
$cto :: forall (f :: * -> *) x. Rep (SongContentsT f) x -> SongContentsT f
to :: forall x. Rep (SongContentsT f) x -> SongContentsT f
Generic, TableSkeleton SongContentsT
(forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
 Applicative m =>
 (forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
 -> SongContentsT f -> SongContentsT g -> m (SongContentsT h))
-> TableSkeleton SongContentsT -> Beamable SongContentsT
forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> SongContentsT f -> SongContentsT g -> m (SongContentsT h)
forall (table :: (* -> *) -> *).
(forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
 Applicative m =>
 (forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
 -> table f -> table g -> m (table h))
-> TableSkeleton table -> Beamable table
$czipBeamFieldsM :: forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> SongContentsT f -> SongContentsT g -> m (SongContentsT h)
zipBeamFieldsM :: forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> SongContentsT f -> SongContentsT g -> m (SongContentsT h)
$ctblSkeleton :: TableSkeleton SongContentsT
tblSkeleton :: TableSkeleton SongContentsT
Beamable)

type SongContents' = SongContentsT Identity

instance Table SongContentsT where
  data PrimaryKey SongContentsT f = SongContentsId (Columnar f Text) deriving ((forall x.
 PrimaryKey SongContentsT f -> Rep (PrimaryKey SongContentsT f) x)
-> (forall x.
    Rep (PrimaryKey SongContentsT f) x -> PrimaryKey SongContentsT f)
-> Generic (PrimaryKey SongContentsT f)
forall x.
Rep (PrimaryKey SongContentsT f) x -> PrimaryKey SongContentsT f
forall x.
PrimaryKey SongContentsT f -> Rep (PrimaryKey SongContentsT f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) x.
Rep (PrimaryKey SongContentsT f) x -> PrimaryKey SongContentsT f
forall (f :: * -> *) x.
PrimaryKey SongContentsT f -> Rep (PrimaryKey SongContentsT f) x
$cfrom :: forall (f :: * -> *) x.
PrimaryKey SongContentsT f -> Rep (PrimaryKey SongContentsT f) x
from :: forall x.
PrimaryKey SongContentsT f -> Rep (PrimaryKey SongContentsT f) x
$cto :: forall (f :: * -> *) x.
Rep (PrimaryKey SongContentsT f) x -> PrimaryKey SongContentsT f
to :: forall x.
Rep (PrimaryKey SongContentsT f) x -> PrimaryKey SongContentsT f
Generic, TableSkeleton (PrimaryKey SongContentsT)
(forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
 Applicative m =>
 (forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
 -> PrimaryKey SongContentsT f
 -> PrimaryKey SongContentsT g
 -> m (PrimaryKey SongContentsT h))
-> TableSkeleton (PrimaryKey SongContentsT)
-> Beamable (PrimaryKey SongContentsT)
forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> PrimaryKey SongContentsT f
-> PrimaryKey SongContentsT g
-> m (PrimaryKey SongContentsT h)
forall (table :: (* -> *) -> *).
(forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
 Applicative m =>
 (forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
 -> table f -> table g -> m (table h))
-> TableSkeleton table -> Beamable table
$czipBeamFieldsM :: forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> PrimaryKey SongContentsT f
-> PrimaryKey SongContentsT g
-> m (PrimaryKey SongContentsT h)
zipBeamFieldsM :: forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> PrimaryKey SongContentsT f
-> PrimaryKey SongContentsT g
-> m (PrimaryKey SongContentsT h)
$ctblSkeleton :: TableSkeleton (PrimaryKey SongContentsT)
tblSkeleton :: TableSkeleton (PrimaryKey SongContentsT)
Beamable)
  primaryKey :: forall (column :: * -> *).
SongContentsT column -> PrimaryKey SongContentsT column
primaryKey = Columnar column Text -> PrimaryKey SongContentsT column
forall (f :: * -> *). Columnar f Text -> PrimaryKey SongContentsT f
SongContentsId (Columnar column Text -> PrimaryKey SongContentsT column)
-> (SongContentsT column -> Columnar column Text)
-> SongContentsT column
-> PrimaryKey SongContentsT column
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SongContentsT column
-> Optic' A_Lens NoIx (SongContentsT column) (Columnar column Text)
-> Columnar column Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx (SongContentsT column) (Columnar column Text)
#identifier)

makeFieldLabelsNoPrefix ''SongContentsT

songContentsTModification :: SongContentsT (FieldModification (TableField SongContentsT))
songContentsTModification :: SongContentsT (FieldModification (TableField SongContentsT))
songContentsTModification =
  SongContentsT (FieldModification Any)
forall (f :: * -> *) (tbl :: (* -> *) -> *).
Beamable tbl =>
tbl (FieldModification f)
tableModification
    { identifier = "identifier",
      songIdentifier = SongId "song_identifier",
      versionName = "version_name",
      createdBy = "created_by",
      visibilityStatus = "visibility_status",
      approvedBy = "approved_by",
      instrumentType = "instrument_type",
      asciiLegend = "ascii_legend",
      asciiContents = "ascii_contents",
      pdfContents = "pdf_contents",
      guitarProContents = "guitarpro_contents",
      createdAt = "created_at",
      lastEditedAt = "last_edited_at"
    }

mkSongContentsP :: SongContent -> SongContents'
mkSongContentsP :: SongContent -> SongContents'
mkSongContentsP SongContent
x =
  SongContents'
    { $sel:identifier:SongContents' :: C Identity Text
identifier = UUID -> Text
UUID.toText (UUID -> Text) -> UUID -> Text
forall a b. (a -> b) -> a -> b
$ SongContent
x SongContent -> Optic' A_Lens NoIx SongContent UUID -> UUID
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SongContent UUID
#identifier,
      $sel:songIdentifier:SongContents' :: PrimaryKey SongT Identity
songIdentifier = C Identity Text -> PrimaryKey SongT Identity
forall (f :: * -> *). Columnar f Text -> PrimaryKey SongT f
SongId (C Identity Text -> PrimaryKey SongT Identity)
-> C Identity Text -> PrimaryKey SongT Identity
forall a b. (a -> b) -> a -> b
$ UUID -> Text
UUID.toText (UUID -> Text) -> UUID -> Text
forall a b. (a -> b) -> a -> b
$ SongContent
x SongContent -> Optic' A_Lens NoIx SongContent UUID -> UUID
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SongContent UUID
#songIdentifier,
      $sel:versionName:SongContents' :: C Identity Text
versionName = SongContent
x SongContent -> Optic' A_Lens NoIx SongContent Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SongContent Text
#versionName,
      $sel:createdBy:SongContents' :: C Identity Text
createdBy = UUID -> Text
UUID.toText (UUID -> Text) -> UUID -> Text
forall a b. (a -> b) -> a -> b
$ SongContent
x SongContent -> Optic' A_Lens NoIx SongContent UUID -> UUID
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SongContent UUID
#createdBy,
      $sel:visibilityStatus:SongContents' :: C Identity Int64
visibilityStatus = Int -> C Identity Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> C Identity Int64) -> Int -> C Identity Int64
forall a b. (a -> b) -> a -> b
$ SongContent
x SongContent -> Optic' A_Lens NoIx SongContent Int -> Int
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SongContent Int
#visibilityStatus,
      $sel:approvedBy:SongContents' :: C Identity (Maybe Text)
approvedBy = (UUID -> Text) -> Maybe UUID -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UUID -> Text
UUID.toText (Maybe UUID -> Maybe Text) -> Maybe UUID -> Maybe Text
forall a b. (a -> b) -> a -> b
$ SongContent
x SongContent
-> Optic' A_Lens NoIx SongContent (Maybe UUID) -> Maybe UUID
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SongContent (Maybe UUID)
#approvedBy,
      $sel:instrumentType:SongContents' :: C Identity Text
instrumentType = SongContent
x SongContent -> Optic' A_Lens NoIx SongContent Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SongContent Text
#instrumentType,
      $sel:asciiLegend:SongContents' :: C Identity (Maybe Text)
asciiLegend = SongContent
x SongContent
-> Optic' A_Lens NoIx SongContent (Maybe Text) -> Maybe Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SongContent (Maybe Text)
#asciiLegend,
      $sel:asciiContents:SongContents' :: C Identity (Maybe Text)
asciiContents = SongContent
x SongContent
-> Optic' A_Lens NoIx SongContent (Maybe Text) -> Maybe Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SongContent (Maybe Text)
#asciiContents,
      $sel:pdfContents:SongContents' :: C Identity (Maybe Text)
pdfContents = SongContent
x SongContent
-> Optic' A_Lens NoIx SongContent (Maybe Text) -> Maybe Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SongContent (Maybe Text)
#pdfContents,
      $sel:guitarProContents:SongContents' :: C Identity (Maybe Text)
guitarProContents = SongContent
x SongContent
-> Optic' A_Lens NoIx SongContent (Maybe Text) -> Maybe Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SongContent (Maybe Text)
#guitarProContents,
      $sel:createdAt:SongContents' :: C Identity UTCTime
createdAt = SongContent
x SongContent -> Optic' A_Lens NoIx SongContent UTCTime -> UTCTime
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SongContent UTCTime
#createdAt,
      $sel:lastEditedAt:SongContents' :: C Identity (Maybe UTCTime)
lastEditedAt = SongContent
x SongContent
-> Optic' A_Lens NoIx SongContent (Maybe UTCTime) -> Maybe UTCTime
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SongContent (Maybe UTCTime)
#lastEditedAt
    }

mkSongContentsM :: SongContents' -> SongContent
mkSongContentsM :: SongContents' -> SongContent
mkSongContentsM SongContents'
x =
  SongContent
    { $sel:identifier:SongContent :: UUID
identifier = Text -> UUID
textToUUID (Text -> UUID) -> Text -> UUID
forall a b. (a -> b) -> a -> b
$ SongContents'
x SongContents' -> Optic' A_Lens NoIx SongContents' Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SongContents' Text
#identifier,
      $sel:songIdentifier:SongContent :: UUID
songIdentifier = Text -> UUID
textToUUID (Text -> UUID) -> Text -> UUID
forall a b. (a -> b) -> a -> b
$ PrimaryKey SongT Identity -> C Identity Text
forall (f :: * -> *). PrimaryKey SongT f -> Columnar f Text
fromSongPk (PrimaryKey SongT Identity -> C Identity Text)
-> PrimaryKey SongT Identity -> C Identity Text
forall a b. (a -> b) -> a -> b
$ SongContents'
x SongContents'
-> Optic' A_Lens NoIx SongContents' (PrimaryKey SongT Identity)
-> PrimaryKey SongT Identity
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SongContents' (PrimaryKey SongT Identity)
#songIdentifier,
      $sel:versionName:SongContent :: Text
versionName = SongContents'
x SongContents' -> Optic' A_Lens NoIx SongContents' Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SongContents' Text
#versionName,
      $sel:createdBy:SongContent :: UUID
createdBy = Text -> UUID
textToUUID (Text -> UUID) -> Text -> UUID
forall a b. (a -> b) -> a -> b
$ SongContents'
x SongContents' -> Optic' A_Lens NoIx SongContents' Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SongContents' Text
#createdBy,
      $sel:visibilityStatus:SongContent :: Int
visibilityStatus = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> Int64 -> Int
forall a b. (a -> b) -> a -> b
$ SongContents'
x SongContents' -> Optic' A_Lens NoIx SongContents' Int64 -> Int64
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SongContents' Int64
#visibilityStatus,
      $sel:approvedBy:SongContent :: Maybe UUID
approvedBy = (Text -> UUID) -> Maybe Text -> Maybe UUID
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> UUID
textToUUID (Maybe Text -> Maybe UUID) -> Maybe Text -> Maybe UUID
forall a b. (a -> b) -> a -> b
$ SongContents'
x SongContents'
-> Optic' A_Lens NoIx SongContents' (Maybe Text) -> Maybe Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SongContents' (Maybe Text)
#approvedBy,
      $sel:instrumentType:SongContent :: Text
instrumentType = SongContents'
x SongContents' -> Optic' A_Lens NoIx SongContents' Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SongContents' Text
#instrumentType,
      $sel:asciiLegend:SongContent :: Maybe Text
asciiLegend = SongContents'
x SongContents'
-> Optic' A_Lens NoIx SongContents' (Maybe Text) -> Maybe Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SongContents' (Maybe Text)
#asciiLegend,
      $sel:asciiContents:SongContent :: Maybe Text
asciiContents = SongContents'
x SongContents'
-> Optic' A_Lens NoIx SongContents' (Maybe Text) -> Maybe Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SongContents' (Maybe Text)
#asciiContents,
      $sel:pdfContents:SongContent :: Maybe Text
pdfContents = SongContents'
x SongContents'
-> Optic' A_Lens NoIx SongContents' (Maybe Text) -> Maybe Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SongContents' (Maybe Text)
#pdfContents,
      $sel:guitarProContents:SongContent :: Maybe Text
guitarProContents = SongContents'
x SongContents'
-> Optic' A_Lens NoIx SongContents' (Maybe Text) -> Maybe Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SongContents' (Maybe Text)
#guitarProContents,
      $sel:createdAt:SongContent :: UTCTime
createdAt = SongContents'
x SongContents'
-> Optic' A_Lens NoIx SongContents' UTCTime -> UTCTime
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SongContents' UTCTime
#createdAt,
      $sel:lastEditedAt:SongContent :: Maybe UTCTime
lastEditedAt = SongContents'
x SongContents'
-> Optic' A_Lens NoIx SongContents' (Maybe UTCTime)
-> Maybe UTCTime
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SongContents' (Maybe UTCTime)
#lastEditedAt
    }