Safe Haskell | None |
---|---|
Language | Haskell2010 |
Database.Persist.Documentation.Internal
Description
This module defines the helpers and internal types that are used in the documentation DSL.
Synopsis
- alignFields :: forall rec. RC rec => [FieldDef] -> StrMap (SomeField rec) Text -> [FieldDef]
- asHaskellNames :: forall rec. RC rec => StrMap (SomeField rec) Text -> Map Text Text
- newtype EntityDoc' a = ED (Writer SchemaDocs a)
- type SchemaDocs = SemiMap TypeRep SomeDocs
- data SomeDocs where
- SomeDocs :: RC rec => EntityDocs rec -> SomeDocs
- type RC rec = Typeable rec
- data EntityDocs rec = EntityDocs {
- entityDocumentation :: Text
- fieldDocumentation :: StrMap (SomeField rec) Text
- type EntityDoc = EntityDoc' ()
- type FieldDoc s = FieldDoc' s ()
- data SomeField rec where
- SomeField :: FC rec typ => EntityField rec typ -> SomeField rec
- type FC rec typ = forall x. Show (EntityField rec x)
- newtype FieldDoc' rec a = FD (Writer (EntityDocs rec) a)
- single :: FC rec typ => EntityField rec typ -> Text -> StrMap (SomeField rec) Text
- type family KnowResult a where ...
- lowercaseFirstChar :: Text -> Text
- (--^) :: forall a r. (KnowResult a ~ r, Typeable r, RC r) => a -> FieldDoc r -> EntityDoc
- (#) :: FC rec typ => EntityField rec typ -> Text -> FieldDoc rec
Documentation
alignFields :: forall rec. RC rec => [FieldDef] -> StrMap (SomeField rec) Text -> [FieldDef] Source #
Given a list of FieldDef
s, this associates each FieldDef
with the
additional documentation comment provided in the
for that entity, if any is present.StrMap
(SomeField
rec)
Text
Precondition: The [
comes from the FieldDef
]
that
this is called for. Doing eg:PersistEntity
rec
alignFields (entityFields (entityDef (Proxy :: Proxy User))) (strMap :: StrMap (SomeField Order) Text)
will be extremely weird.
Since: 0.1.0.0
asHaskellNames :: forall rec. RC rec => StrMap (SomeField rec) Text -> Map Text Text Source #
Formats the
in the keys of the SomeField
recMap
to be formatted in
the same way as the HaskellName
present in a FieldDef
.
Since: 0.1.0.0
newtype EntityDoc' a Source #
A type for defining documentation for a schema.
Since: 0.1.0.0
Constructors
ED (Writer SchemaDocs a) |
Instances
type SchemaDocs = SemiMap TypeRep SomeDocs Source #
The SchemaDocs
maps a TypeRep
of the
that is documented
to the Entity
recSomeDocs
for that entity.
Since: 0.1.0.0
A wrapper around EntityDocs
that allows them to be stored in a list
together. Contains the RC
constraint alias, which will ensure that all
necessary constraints for document rendering are packaged in.
Constructors
SomeDocs :: RC rec => EntityDocs rec -> SomeDocs |
Instances
Semigroup SomeDocs Source # | |
MonadWriter SchemaDocs EntityDoc' Source # | |
Defined in Database.Persist.Documentation.Internal Methods writer :: (a, SchemaDocs) -> EntityDoc' a # tell :: SchemaDocs -> EntityDoc' () # listen :: EntityDoc' a -> EntityDoc' (a, SchemaDocs) # pass :: EntityDoc' (a, SchemaDocs -> SchemaDocs) -> EntityDoc' a # |
type RC rec = Typeable rec Source #
Expand this constraint synonym to pack necessary constraints in with the
EntityDocs
type. Used in a few places to ensure that constraints are easy to
modify in one place.
Since: 0.1.0.0
data EntityDocs rec Source #
EntityDocs
contain the documentation comment for the
that
is being documented, as well as a map of documentation for the fields of that
entity.Entity
rec
Since: 0.1.0.0
Constructors
EntityDocs | |
Fields
|
Instances
Semigroup (EntityDocs rec) Source # | |
Defined in Database.Persist.Documentation.Internal Methods (<>) :: EntityDocs rec -> EntityDocs rec -> EntityDocs rec # sconcat :: NonEmpty (EntityDocs rec) -> EntityDocs rec # stimes :: Integral b => b -> EntityDocs rec -> EntityDocs rec # | |
Monoid (EntityDocs rec) Source # | |
Defined in Database.Persist.Documentation.Internal Methods mempty :: EntityDocs rec # mappend :: EntityDocs rec -> EntityDocs rec -> EntityDocs rec # mconcat :: [EntityDocs rec] -> EntityDocs rec # | |
MonadWriter (EntityDocs rec) (FieldDoc' rec) Source # | |
Defined in Database.Persist.Documentation.Internal Methods writer :: (a, EntityDocs rec) -> FieldDoc' rec a # tell :: EntityDocs rec -> FieldDoc' rec () # listen :: FieldDoc' rec a -> FieldDoc' rec (a, EntityDocs rec) # pass :: FieldDoc' rec (a, EntityDocs rec -> EntityDocs rec) -> FieldDoc' rec a # |
type EntityDoc = EntityDoc' () Source #
An expression of EntityDoc
is used to document the persistent
schema. To construct an EntityDoc
, you'll use the Entity
constructor
and the (--^)
operator. Everything to the right of the (--^)
operator is a 'FieldDoc rec' for the given entity.
This type is a monad, and you can use do
notation to sequence the
documentation.
doc :: EntityDoc
doc = do
User --^ "Documentation for a User"
Dog --^ "Documentation for a Dog"
Since: 0.1.0.0
type FieldDoc s = FieldDoc' s () Source #
A FieldDoc
expression provides documentation for the given Entity
.
This type is a Monad
and you will want to use do
notation to create
this.
There are two ways to create FieldDoc
lines:
- String literals. These are collected and appended as documentation for the entity itself.
- The
(#)
operator, which accepts anEntityField
and the text documentation for that entity.
Since: 0.1.0.0
data SomeField rec where Source #
Wrap the result type of a EntityField
value so it can be stored in
homogenous containers.
Since: 0.1.0.0
Constructors
SomeField :: FC rec typ => EntityField rec typ -> SomeField rec |
Instances
(forall typ. Show (EntityField rec typ)) => Show (SomeField rec) Source # | We need this instance so we can store |
type FC rec typ = forall x. Show (EntityField rec x) Source #
Expand this constraint synonym to pack necessary constraints for packing
EntityField
values into SomeField
s.
newtype FieldDoc' rec a Source #
A monad for writing documentation on an entity's fields. Collects the
documentation into a Writer
.
Since: 0.1.0.0
Constructors
FD (Writer (EntityDocs rec) a) |
Instances
Monad (FieldDoc' rec) Source # | |
Functor (FieldDoc' rec) Source # | |
Applicative (FieldDoc' rec) Source # | |
Defined in Database.Persist.Documentation.Internal Methods pure :: a -> FieldDoc' rec a # (<*>) :: FieldDoc' rec (a -> b) -> FieldDoc' rec a -> FieldDoc' rec b # liftA2 :: (a -> b -> c) -> FieldDoc' rec a -> FieldDoc' rec b -> FieldDoc' rec c # (*>) :: FieldDoc' rec a -> FieldDoc' rec b -> FieldDoc' rec b # (<*) :: FieldDoc' rec a -> FieldDoc' rec b -> FieldDoc' rec a # | |
MonadWriter (EntityDocs rec) (FieldDoc' rec) Source # | |
Defined in Database.Persist.Documentation.Internal Methods writer :: (a, EntityDocs rec) -> FieldDoc' rec a # tell :: EntityDocs rec -> FieldDoc' rec () # listen :: FieldDoc' rec a -> FieldDoc' rec (a, EntityDocs rec) # pass :: FieldDoc' rec (a, EntityDocs rec -> EntityDocs rec) -> FieldDoc' rec a # | |
a ~ () => IsString (FieldDoc' s a) Source # | |
Defined in Database.Persist.Documentation.Internal Methods fromString :: String -> FieldDoc' s a # |
type family KnowResult a where ... Source #
Equations
KnowResult (i -> o) = KnowResult o | |
KnowResult a = a |
lowercaseFirstChar :: Text -> Text Source #
Arguments
:: forall a r. (KnowResult a ~ r, Typeable r, RC r) | |
=> a | A constructor for the |
-> FieldDoc r | A block that contains documentation for the |
-> EntityDoc |
Define documentation for an entity. The left-hand side takes the
Entity
constructor, and the right hand side takes a FieldDoc
expression that documents the entity and it's fields.
Example
x :: EntityDoc x = do User --^ do "This comment is for the entity User." UserName # "This comment is for a field.""
Since: 0.1.0.0
(#) :: FC rec typ => EntityField rec typ -> Text -> FieldDoc rec Source #
Write documentation for the given EntityField
.
Example
x :: EntityDoc x = do User --^ do "This comment is for the entity User." UserName # "This comment is for a field.""
Since: 0.1.0.0