{-# LANGUAGE CPP                        #-}
{-# LANGUAGE ConstraintKinds            #-}
{-# LANGUAGE DefaultSignatures          #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DerivingVia                #-}
{-# LANGUAGE EmptyCase                  #-}
{-# LANGUAGE ExistentialQuantification  #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE InstanceSigs               #-}
{-# LANGUAGE KindSignatures             #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE QuantifiedConstraints      #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE TemplateHaskell            #-}
{-# LANGUAGE TypeApplications           #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE TypeInType                 #-}
{-# LANGUAGE TypeOperators              #-}
{-# LANGUAGE UndecidableInstances       #-}

{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}

-- | This module contains code for documenting a set of @persistent@ entity
-- definitions. All the library provides is a means to render a Markdown
-- document with table and column documentation and comments. A further
-- expansion could use the information here to generate PostgreSQL @COMMENT@s on
-- the fields and tables too.
--
-- = Getting Started
--
-- You probably already have a @persistent@ entity definitions somewhere, and
-- they probably look like this:
--
-- @
-- 'share' ['mkPersist' 'sqlSettings'] ['persistUpperCase'|
--   User
--     firstName Text.Text
--     active    Bool
--     deriving Show Eq Read Ord
-- |]
-- @
--
-- The 'persistUpperCase' QuasiQuoter parses the block of text and returns
-- a value of type @['EntityDef']@. We need to get our hands on that
-- definition so we can document it. We'll use the 'mkEntityDefList'
-- function to expose it:
--
-- @
-- 'share'
--   [ 'mkPersist' 'sqlSettings'
--   , 'mkEntityDefList' "entityDefs"
--   ] ['persistUpperCase'|
--   User
--     firstName Text.Text
--     active    Bool
--     deriving Show Eq Read Ord
-- |]
-- @
--
-- You may want to factor out the quasiquoter into a term and import from
-- another module. This has an important downside: the ID fields from the
-- QuasiQuoter are given as 'Int64' regardless of what they actually are.
-- It's not possible for the persistent quasiquoter to properly know the
-- types of the IDs.
--
-- = Documentating The Schema
--
-- Now, we're going to use the 'document' function to link up the
-- @entityDefs@ with a documentation expression (type 'EntityDoc').
--
-- @
-- docs :: ['EntityDef']
-- docs = 'document' entityDefs $ do
--   pure ()
-- @
--
-- The 'EntityDoc' type is a monad, and we'll use @do@ notation to sequence
-- multiple entity definitions.
--
-- @
-- docs :: ['EntityDef']
-- docs = 'document' entityDefs $ do
--   User '--^' do
--     pure ()
-- @
--
-- The '--^' operator mimics the Haddock comment syntax. We use the
-- constructor of the entity (in this case, @User@). On the right, we
-- provide documentation for the entity. The right hand expression will
-- have the type 'FieldDoc', and we can use @do@ notation to construct it.
--
-- We can use string literals to document the entity itself, with the
-- @OverloadedStrings@ extension enabled. The string literals are
-- concatenated, and used to provide entity-level comments. You'll need to
-- manage whitespace yourself, though.
--
-- @
-- docs :: ['EntityDef']
-- docs = 'document' entityDefs $ do
--   User '--^' do
--     "This is user documentation. "
--     "You can have multiple lines, but you need to watch out for spaces. "
--     "The lines will be combined."
-- @
--
-- We can also document the entity fields. We do this using the '#'
-- operator.
--
-- @
-- docs :: ['EntityDef']
-- docs = 'document' entityDefs $ do
--   User '--^' do
--     "This is user documentation. "
--     "You can have multiple lines, but you need to watch out for spaces. "
--     "The lines will be combined."
--
--     UserFirstName '#' "The user's first name."
--     UserActive    '#' "Whether or not the user is able to log in."
-- @
--
-- This attaches the comment to the entity field.
--
-- = Rendering the Documentation
--
-- Finally, we'll use 'render' and provide a 'Renderer' to generate
-- documentation. For an example of what this looks like, check out the
-- file @test/example.md@ in the repository (linked from the README).
--
-- @
-- renderedDocs :: Text
-- renderedDocs = 'render' 'markdownTableRenderer' docs
-- @
module Database.Persist.Documentation
  ( -- * The Documentation DSL
    document
  , (--^)
  , (#)
  , EntityDoc
  , FieldDoc
  , deriveShowFields
    -- * Rendering Documentation
  , Renderer(..)
  , render
  , markdownTableRenderer
  ) where

import           Control.Monad.Writer
import qualified Data.Char                               as Char
import           Data.Foldable                           (fold, toList)
import           Data.Map                                (Map)
import qualified Data.Map                                as Map
import           Data.String
import           Data.Text                               (Text)
import qualified Data.Text                               as Text
import           Data.Typeable
import           Database.Persist.Sql                    hiding (insert)
import           Language.Haskell.TH

import           Data.SemiMap
import           Data.StrMap
import           Database.Persist.Documentation.Internal

#if MIN_VERSION_persistent(2,13,0)
import           Database.Persist.EntityDef.Internal
import           Database.Persist.FieldDef.Internal
import Database.Persist.Quasi.Internal
#endif

-- | This function accepts a list of 'EntityDef' and an 'EntityDoc' block, and
-- substitutes the 'entityComments' and 'fieldComments' from the
-- 'EntityDoc'.
--
-- @since 0.1.0.0
document :: [EntityDef] -> EntityDoc -> [EntityDef]
document :: [EntityDef] -> EntityDoc -> [EntityDef]
document [EntityDef]
entities (ED Writer SchemaDocs ()
docs) = (EntityDef -> EntityDef) -> [EntityDef] -> [EntityDef]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap EntityDef -> EntityDef
associate [EntityDef]
entities
  where
    schemaDocs :: SchemaDocs
schemaDocs = Writer SchemaDocs () -> SchemaDocs
forall w a. Writer w a -> w
execWriter Writer SchemaDocs ()
docs
    typeReps :: Map String SomeDocs
typeReps = (TypeRep -> String) -> Map TypeRep SomeDocs -> Map String SomeDocs
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys TypeRep -> String
forall a. Show a => a -> String
show (SchemaDocs -> Map TypeRep SomeDocs
forall k v. SemiMap k v -> Map k v
unSemiMap SchemaDocs
schemaDocs)
    associate :: EntityDef -> EntityDef
associate EntityDef
edef =
      let
        tyStr :: String
tyStr = Text -> String
Text.unpack (Text -> String) -> (EntityDef -> Text) -> EntityDef -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntityNameHS -> Text
unEntityNameHS (EntityNameHS -> Text)
-> (EntityDef -> EntityNameHS) -> EntityDef -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntityDef -> EntityNameHS
entityHaskell (EntityDef -> String) -> EntityDef -> String
forall a b. (a -> b) -> a -> b
$ EntityDef
edef
       in
        case String -> Map String SomeDocs -> Maybe SomeDocs
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
tyStr Map String SomeDocs
typeReps of
          Just (SomeDocs (EntityDocs Text
e StrMap (SomeField rec) Text
cs)) ->
            EntityDef
edef
              { entityComments :: Maybe Text
entityComments = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
e
              , entityFields :: [FieldDef]
entityFields = [FieldDef] -> StrMap (SomeField rec) Text -> [FieldDef]
forall rec.
RC rec =>
[FieldDef] -> StrMap (SomeField rec) Text -> [FieldDef]
alignFields (EntityDef -> [FieldDef]
entityFields EntityDef
edef) StrMap (SomeField rec) Text
cs
              , entityId :: EntityIdDef
entityId =
#if MIN_VERSION_persistent(2,13,0)
                  case EntityDef -> Maybe FieldDef
getEntityIdField EntityDef
edef of
                     Maybe FieldDef
Nothing ->
                        EntityDef -> EntityIdDef
entityId EntityDef
edef
                     Just FieldDef
field ->
                         -- this is safe because it's a `map`, under the
                         -- hood
                        [EntityIdDef] -> EntityIdDef
forall a. [a] -> a
head ([EntityIdDef] -> EntityIdDef) -> [EntityIdDef] -> EntityIdDef
forall a b. (a -> b) -> a -> b
$ FieldDef -> EntityIdDef
EntityIdField (FieldDef -> EntityIdDef) -> [FieldDef] -> [EntityIdDef]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FieldDef] -> StrMap (SomeField rec) Text -> [FieldDef]
forall rec.
RC rec =>
[FieldDef] -> StrMap (SomeField rec) Text -> [FieldDef]
alignFields [FieldDef
field] StrMap (SomeField rec) Text
cs
#else
                  head $ alignFields [entityId edef] cs
#endif
              }
          Maybe SomeDocs
Nothing -> EntityDef
edef

-- | A renderer for documented entities, abstract in the intermediate
-- representations of entities and fields.
--
-- @since 0.1.0.0
data Renderer rendered where
  Renderer
    :: { ()
renderField :: FieldDef -> Maybe Text -> renderedField
       -- ^ Render a field definition as some intermediate structure
       , ()
renderFields :: [renderedField] -> renderedFields
       -- ^ Fold a collection of rendered fields
       , ()
renderEntity :: EntityDef -> Maybe Text -> renderedFields -> renderedEntity
       -- ^ Attach some entity-level metadata to a rendered collection of fields
       , ()
renderEntities :: [renderedEntity] -> rendered
       -- ^ Finally, fold a collection of rendered entities
       }
    -> Renderer rendered

-- | Given a 'Renderer' for a list of entity defintiions, render it.
--
-- @since 0.1.0.0
render :: Renderer rendered -> [EntityDef] -> rendered
render :: Renderer rendered -> [EntityDef] -> rendered
render Renderer{[renderedField] -> renderedFields
[renderedEntity] -> rendered
EntityDef -> Maybe Text -> renderedFields -> renderedEntity
FieldDef -> Maybe Text -> renderedField
renderEntities :: [renderedEntity] -> rendered
renderEntity :: EntityDef -> Maybe Text -> renderedFields -> renderedEntity
renderFields :: [renderedField] -> renderedFields
renderField :: FieldDef -> Maybe Text -> renderedField
renderEntities :: ()
renderEntity :: ()
renderFields :: ()
renderField :: ()
..} =
  [renderedEntity] -> rendered
renderEntities ([renderedEntity] -> rendered)
-> ([EntityDef] -> [renderedEntity]) -> [EntityDef] -> rendered
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EntityDef -> renderedEntity) -> [EntityDef] -> [renderedEntity]
forall a b. (a -> b) -> [a] -> [b]
map EntityDef -> renderedEntity
f
  where
    f :: EntityDef -> renderedEntity
f EntityDef
ent = EntityDef -> Maybe Text -> renderedFields -> renderedEntity
renderEntity EntityDef
ent Maybe Text
entityDocs renderedFields
renderedFields
      where
        fields :: [FieldDef]
fields = NonEmpty FieldDef -> [FieldDef]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty FieldDef -> [FieldDef])
-> NonEmpty FieldDef -> [FieldDef]
forall a b. (a -> b) -> a -> b
$ EntityDef -> NonEmpty FieldDef
keyAndEntityFields EntityDef
ent
        entityDocs :: Maybe Text
entityDocs = EntityDef -> Maybe Text
entityComments EntityDef
ent
        renderedFields :: renderedFields
renderedFields =
          [renderedField] -> renderedFields
renderFields ((FieldDef -> renderedField) -> [FieldDef] -> [renderedField]
forall a b. (a -> b) -> [a] -> [b]
map (\FieldDef
f -> FieldDef -> Maybe Text -> renderedField
renderField FieldDef
f (FieldDef -> Maybe Text
fieldComments FieldDef
f)) [FieldDef]
fields)

-- | A 'Renderer' that generates Markdown tables for an entity.
--
-- === __ Example __
--
-- Given 'entityDefs' like:
--
-- @
-- entityDefs :: ['EntityDef']
-- entityDefs = ['persistUpperCase'|
--   User
--     firstName Text.Text
--     active    Bool
--     deriving Show Eq Read Ord
-- |]
-- @
--
-- and a doc block like:
--
-- @
-- docs :: [EntityDef]
-- docs = document entityDefs $ do
--   User --^ do
--     "you can use string literals to write documentation for the entity itself. "
--     "The strings will be mappended together, so you'll need to handle "
--     "whitespace yourself."
--     UserFirstName # "The user's first name."
--     UserActive # "Whether or not the user is able to log in."
--     UserId # "You can document the user's ID field."
-- @
--
-- This will rende the given Markdown output:
--
-- @
-- # `User`
--
-- you can use string literals to write documentation for the entity itself. The strings will be
-- mappended together, so you'll need to handle whitespace yourself.
--
-- * Primary ID: `id`
--
-- | Column name | Type | Description |
-- |-|-|-|
-- | `id` | integer (64) | You can document the user's ID field. |
-- | `firstName` | string | The user's first name. |
-- | `active` | boolean | Whether or not the user is able to log in. |
-- @
--
-- @since 0.1.0.0
markdownTableRenderer :: Renderer Text
markdownTableRenderer :: Renderer Text
markdownTableRenderer = Renderer :: forall renderedField renderedFields renderedEntity rendered.
(FieldDef -> Maybe Text -> renderedField)
-> ([renderedField] -> renderedFields)
-> (EntityDef -> Maybe Text -> renderedFields -> renderedEntity)
-> ([renderedEntity] -> rendered)
-> Renderer rendered
Renderer{[Text] -> Text
EntityDef -> Maybe Text -> Text -> Text
FieldDef -> Maybe Text -> Text
renderEntities :: [Text] -> Text
renderEntity :: EntityDef -> Maybe Text -> Text -> Text
renderFields :: [Text] -> Text
renderField :: FieldDef -> Maybe Text -> Text
renderEntities :: [Text] -> Text
renderEntity :: EntityDef -> Maybe Text -> Text -> Text
renderFields :: [Text] -> Text
renderField :: FieldDef -> Maybe Text -> Text
..}
  where
   renderField :: FieldDef -> Maybe Text -> Text
   renderField :: FieldDef -> Maybe Text -> Text
renderField FieldDef{Bool
[FieldAttr]
Maybe Text
FieldType
ReferenceDef
FieldCascade
SqlType
FieldNameDB
FieldNameHS
fieldHaskell :: FieldDef -> FieldNameHS
fieldDB :: FieldDef -> FieldNameDB
fieldType :: FieldDef -> FieldType
fieldSqlType :: FieldDef -> SqlType
fieldAttrs :: FieldDef -> [FieldAttr]
fieldStrict :: FieldDef -> Bool
fieldReference :: FieldDef -> ReferenceDef
fieldCascade :: FieldDef -> FieldCascade
fieldGenerated :: FieldDef -> Maybe Text
fieldIsImplicitIdColumn :: FieldDef -> Bool
fieldIsImplicitIdColumn :: Bool
fieldGenerated :: Maybe Text
fieldComments :: Maybe Text
fieldCascade :: FieldCascade
fieldReference :: ReferenceDef
fieldStrict :: Bool
fieldAttrs :: [FieldAttr]
fieldSqlType :: SqlType
fieldType :: FieldType
fieldDB :: FieldNameDB
fieldHaskell :: FieldNameHS
fieldComments :: FieldDef -> Maybe Text
..} Maybe Text
mextra =
      [Text] -> Text
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
        [ Text
"| `"
        , FieldNameDB -> Text
unFieldNameDB FieldNameDB
fieldDB
        , Text
"` | "
        , SqlType -> Text
showType SqlType
fieldSqlType
        , Text
" | "
        , (Text -> Text) -> Maybe Text -> Text
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Text -> Text
cleanComment Maybe Text
mextra
        , Text
" |"
        ]

   renderFields :: [Text] -> Text
   renderFields :: [Text] -> Text
renderFields [Text]
xs =
     [Text] -> Text
Text.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
         Text
"| Column name | Type | Description |"
       Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text
"|-|-|-|"
       Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
xs

   renderEntity :: EntityDef -> Maybe Text -> Text -> Text
   renderEntity :: EntityDef -> Maybe Text -> Text -> Text
renderEntity ed :: EntityDef
ed@EntityDef{Bool
[Text]
[UniqueDef]
[ForeignDef]
[FieldDef]
Maybe Text
Map Text [[Text]]
EntityIdDef
EntityNameHS
EntityNameDB
entityDB :: EntityDef -> EntityNameDB
entityAttrs :: EntityDef -> [Text]
entityUniques :: EntityDef -> [UniqueDef]
entityForeigns :: EntityDef -> [ForeignDef]
entityDerives :: EntityDef -> [Text]
entityExtra :: EntityDef -> Map Text [[Text]]
entitySum :: EntityDef -> Bool
entityComments :: Maybe Text
entitySum :: Bool
entityExtra :: Map Text [[Text]]
entityDerives :: [Text]
entityForeigns :: [ForeignDef]
entityUniques :: [UniqueDef]
entityFields :: [FieldDef]
entityAttrs :: [Text]
entityId :: EntityIdDef
entityDB :: EntityNameDB
entityHaskell :: EntityNameHS
entityId :: EntityDef -> EntityIdDef
entityFields :: EntityDef -> [FieldDef]
entityComments :: EntityDef -> Maybe Text
entityHaskell :: EntityDef -> EntityNameHS
..} Maybe Text
mdocs Text
fields =
     [Text] -> Text
Text.unlines ([[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
       [ Text -> [Text]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Text
"# `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> EntityNameDB -> Text
unEntityNameDB EntityNameDB
entityDB Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"`"
       , Text -> [Text]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ case Maybe Text
mdocs of
           Just Text
entityDocs -> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
entityDocs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
           Maybe Text
Nothing         -> Text
""
       ,
#if MIN_VERSION_persistent(2,13,0)
         case EntityDef -> Maybe FieldDef
getEntityIdField EntityDef
ed of
           Maybe FieldDef
Nothing ->
               []
           Just FieldDef
field ->
               Text -> [Text]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Text
"* Primary ID: `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FieldNameDB -> Text
unFieldNameDB (FieldDef -> FieldNameDB
fieldDB FieldDef
field) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"`"
#else
         pure $ "* Primary ID: `" <> unFieldNameDB (fieldDB entityId) <> "`"
#endif
       , Text -> [Text]
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
""
       ])
     Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fields

   renderEntities :: [Text] -> Text
   renderEntities :: [Text] -> Text
renderEntities =
     [Text] -> Text
Text.unlines

   showType :: SqlType -> Text
showType SqlType
SqlString    = Text
"string"
   showType SqlType
SqlInt32     = Text
"integer (32)"
   showType SqlType
SqlInt64     = Text
"integer (64)"
   showType SqlType
SqlReal      = Text
"double"
   showType SqlNumeric{} = Text
"numeric"
   showType SqlType
SqlDay       = Text
"date"
   showType SqlType
SqlTime      = Text
"time"
   showType SqlType
SqlDayTime   = Text
"datetime"
   showType SqlType
SqlBlob      = Text
"blob"
   showType SqlType
SqlBool      = Text
"boolean"
   showType (SqlOther Text
t) = Text
t
   
   cleanComment :: Text -> Text
   cleanComment :: Text -> Text
cleanComment Text
comment =
     let
       -- Newline characters may be present in a comment. The need to be removed
       -- to allow the markdown tables to render properly.
       newlineToBr :: Char -> Text
newlineToBr Char
'\n' = Text
"<br>"
       newlineToBr Char
c = Char -> Text
Text.singleton Char
c
     in
       (Char -> Text) -> Text -> Text
Text.concatMap Char -> Text
newlineToBr (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
Text.strip Text
comment

-- | Render the '[EntityDef]' into a Markdown table representation. See
-- 'markdownTable
--
-- @since 0.1.0.0
toMarkdownTables :: [EntityDef] -> Text
toMarkdownTables :: [EntityDef] -> Text
toMarkdownTables = Renderer Text -> [EntityDef] -> Text
forall rendered. Renderer rendered -> [EntityDef] -> rendered
render Renderer Text
markdownTableRenderer

-- | Formats the @'SomeField' rec@ in the keys of the 'Map' to be formatted in
-- the same way as the 'HaskellName' present in a 'FieldDef'.
--
-- @since 0.1.0.0
asHaskellNames
  :: forall rec. RC rec
  => StrMap (SomeField rec) Text -> Map Text Text
asHaskellNames :: StrMap (SomeField rec) Text -> Map Text Text
asHaskellNames (StrMap Map (AsStr (SomeField rec)) Text
extraDocMap) =
  (AsStr (SomeField rec) -> Text)
-> Map (AsStr (SomeField rec)) Text -> Map Text Text
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys (Text -> Text
lowercaseFirstChar (Text -> Text)
-> (AsStr (SomeField rec) -> Text) -> AsStr (SomeField rec) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
Text.drop (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
recName) (Text -> Text)
-> (AsStr (SomeField rec) -> Text) -> AsStr (SomeField rec) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AsStr (SomeField rec) -> Text
forall k. AsStr k -> Text
asStrText) Map (AsStr (SomeField rec)) Text
extraDocMap
  where
    recName :: String
recName =
      TypeRep -> String
forall a. Show a => a -> String
show (Proxy rec -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy rec
forall k (t :: k). Proxy t
Proxy @rec))

-- | Given a list of entity definitions, derives `Show` for all their fields.
-- This is necessary for using this library for internal reasons, unfortunately.
--
-- @since 0.1.0.0
deriveShowFields
#if MIN_VERSION_persistent(2,13,0)
    :: [UnboundEntityDef]
#else
    :: [EntityDef]
#endif
    -> Q [Dec]
deriveShowFields :: [UnboundEntityDef] -> Q [Dec]
deriveShowFields [UnboundEntityDef]
defs = ([[Dec]] -> [Dec]) -> Q [[Dec]] -> Q [Dec]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[Dec]] -> [Dec]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Q [[Dec]] -> Q [Dec])
-> ((UnboundEntityDef -> Q [Dec]) -> Q [[Dec]])
-> (UnboundEntityDef -> Q [Dec])
-> Q [Dec]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [UnboundEntityDef] -> (UnboundEntityDef -> Q [Dec]) -> Q [[Dec]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [UnboundEntityDef]
defs ((UnboundEntityDef -> Q [Dec]) -> Q [Dec])
-> (UnboundEntityDef -> Q [Dec]) -> Q [Dec]
forall a b. (a -> b) -> a -> b
$ \UnboundEntityDef
def -> do
  let name :: TypeQ
name = Name -> TypeQ
conT (Name -> TypeQ)
-> (UnboundEntityDef -> Name) -> UnboundEntityDef -> TypeQ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Name
mkName (String -> Name)
-> (UnboundEntityDef -> String) -> UnboundEntityDef -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack (Text -> String)
-> (UnboundEntityDef -> Text) -> UnboundEntityDef -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntityNameHS -> Text
unEntityNameHS (EntityNameHS -> Text)
-> (UnboundEntityDef -> EntityNameHS) -> UnboundEntityDef -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnboundEntityDef -> EntityNameHS
unname (UnboundEntityDef -> TypeQ) -> UnboundEntityDef -> TypeQ
forall a b. (a -> b) -> a -> b
$ UnboundEntityDef
def
  [d|deriving instance Show (EntityField $(name) x)|]
  where
    unname :: UnboundEntityDef -> EntityNameHS
unname =
#if MIN_VERSION_persistent(2,13,0)
      UnboundEntityDef -> EntityNameHS
getUnboundEntityNameHS
#else
      entityHaskell
#endif