diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,9 @@ # Revision history for persistent-documentation +## 0.1.0.1 + +* Document use of the `mkEntityDefList` to expose the `[EntityDef]` generated by the Persistent QuasiQuoter instead of using the QQ value directly. + ## 0.1.0.0 -- YYYY-mm-dd * First version. Released on an unsuspecting world. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,5 +1,9 @@ # persistent-documentation +![Hackage-Deps](https://img.shields.io/hackage-deps/v/persistent-documentation.svg) +[![Build Status](https://travis-ci.org/lumihq/persistent-documentation.svg?branch=master)](https://travis-ci.org/lumihq/persistent-documentation) + + This library provides a DSL for attaching documentation to persistent entities as well as rendering documentation. -For an example, check out [the test suite](https://github.com/lumihq/persistent-documentation/blob/master/test/DocumentationSpec.hs#L30-L38), and the [rendered example](test/example.md). +For an example, check out [the test suite](https://github.com/lumihq/persistent-documentation/blob/master/test/DocumentationSpec.hs#L30-L38), and the [rendered example](https://github.com/lumihq/persistent-documentation/blob/master/test/example.md). diff --git a/persistent-documentation.cabal b/persistent-documentation.cabal --- a/persistent-documentation.cabal +++ b/persistent-documentation.cabal @@ -1,7 +1,7 @@ cabal-version: >=1.10 name: persistent-documentation -version: 0.1.0.0 +version: 0.1.0.1 synopsis: Documentation DSL for persistent entities description: A convenient DSL that allows you to attach documentation to persistent database entities -- bug-reports: @@ -14,6 +14,10 @@ build-type: Simple extra-source-files: CHANGELOG.md, README.md +source-repository head + type: git + location: https://github.com/lumihq/persistent-documentation + library exposed-modules: Database.Persist.Documentation @@ -22,7 +26,7 @@ Data.SemiMap -- other-modules: build-depends: - base >= 4.9 && < 5.0 + base >= 4.12 && < 5.0 , containers , persistent >= 2.10 && < 3.0 , text @@ -47,8 +51,7 @@ , hspec-discover , persistent , persistent-documentation - , persistent-template >= 2.7 + , persistent-template >= 2.7.1 , text other-modules: DocumentationSpec - Entities diff --git a/src/Database/Persist/Documentation.hs b/src/Database/Persist/Documentation.hs --- a/src/Database/Persist/Documentation.hs +++ b/src/Database/Persist/Documentation.hs @@ -41,23 +41,21 @@ -- 'share' ['mkPersist' 'sqlSettings'] ['persistUpperCase'| -- User -- firstName Text.Text --- active Bool +-- 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. --- --- Due to GHC staging restrictions, we have to extract the QuasiQuoter (or --- file parser) into a separate module: +-- definition so we can document it. We'll use the 'mkEntityDefList' +-- function to expose it: -- -- @ --- module Entities where --- --- entityDefs :: ['EntityDef'] --- entityDefs = ['persistUpperCase'| +-- 'share' +-- [ 'mkPersist' 'sqlSettings' +-- , 'mkEntityDefList' "entityDefs" +-- ] ['persistUpperCase'| -- User -- firstName Text.Text -- active Bool @@ -65,16 +63,11 @@ -- |] -- @ -- --- Now, we'll import that value, and use it with the Template Haskell --- function. We also need to use 'deriveShowFields' to derive instances of --- 'Show' for the 'EntityField's that are generated. --- --- @ --- 'share' ['mkPersist' 'sqlSettings', 'deriveShowFields'] entityDefs --- @ --- --- That's all the setup we need to start writing documentation for our --- entites. +-- 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 -- @@ -83,7 +76,8 @@ -- -- @ -- docs :: ['EntityDef'] --- docs = 'document' entityDefs (pure ()) +-- docs = 'document' entityDefs $ do +-- pure () -- @ -- -- The 'EntityDoc' type is a monad, and we'll use @do@ notation to sequence @@ -92,11 +86,11 @@ -- @ -- docs :: ['EntityDef'] -- docs = 'document' entityDefs $ do --- User --^ do +-- User '--^' do -- pure () -- @ -- --- The '(--^)' operator mimics the Haddock comment syntax. We use the +-- 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. @@ -109,25 +103,25 @@ -- @ -- docs :: ['EntityDef'] -- docs = 'document' entityDefs $ do --- User --^ 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 '(#)' +-- We can also document the entity fields. We do this using the '#' -- operator. -- -- @ -- docs :: ['EntityDef'] -- docs = 'document' entityDefs $ do --- User --^ 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." +-- 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. @@ -157,20 +151,20 @@ ) where import Control.Monad.Writer -import qualified Data.Char as Char -import Data.Foldable (fold) -import Data.Map (Map) -import qualified Data.Map as Map +import qualified Data.Char as Char +import Data.Foldable (fold) +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.Text (Text) +import qualified Data.Text as Text import Data.Typeable -import Database.Persist.Sql hiding (insert) +import Database.Persist.Sql hiding (insert) import Language.Haskell.TH -import Data.StrMap -import Data.SemiMap -import Database.Persist.Documentation.Internal +import Data.SemiMap +import Data.StrMap +import Database.Persist.Documentation.Internal -- | This function accepts a list of 'EntityDef' and an 'EntityDoc' block, and -- substitutes the 'entityComments' and 'fieldComments' from the @@ -237,7 +231,7 @@ -- entityDefs = ['persistUpperCase'| -- User -- firstName Text.Text --- active Bool +-- active Bool -- deriving Show Eq Read Ord -- |] -- @ @@ -299,7 +293,7 @@ [ "# `" <> unDBName entityDB <> "`" , case mdocs of Just entityDocs -> "\n" <> entityDocs <> "\n" - Nothing -> "" + Nothing -> "" , "* Primary ID: `" <> unDBName (fieldDB entityId) <> "`" , "" ] @@ -308,16 +302,16 @@ renderEntities = Text.unlines - showType SqlString = "string" - showType SqlInt32 = "integer (32)" - showType SqlInt64 = "integer (64)" - showType SqlReal = "double" + showType SqlString = "string" + showType SqlInt32 = "integer (32)" + showType SqlInt64 = "integer (64)" + showType SqlReal = "double" showType SqlNumeric{} = "numeric" - showType SqlDay = "date" - showType SqlTime = "time" - showType SqlDayTime = "datetime" - showType SqlBlob = "blob" - showType SqlBool = "boolean" + showType SqlDay = "date" + showType SqlTime = "time" + showType SqlDayTime = "datetime" + showType SqlBlob = "blob" + showType SqlBool = "boolean" showType (SqlOther t) = t -- | Render the '[EntityDef]' into a Markdown table representation. See diff --git a/test/DocumentationSpec.hs b/test/DocumentationSpec.hs --- a/test/DocumentationSpec.hs +++ b/test/DocumentationSpec.hs @@ -11,6 +11,8 @@ module DocumentationSpec where +import Data.Proxy +import Control.Monad import qualified Data.Char as Char import qualified Data.Map as Map import qualified Data.Set as Set @@ -25,10 +27,23 @@ import Database.Persist.Documentation import Database.Persist.Documentation.Internal (alignFields, single, asHaskellNames) import Data.StrMap -import Entities -share [mkPersist sqlSettings, deriveShowFields] entityDefs +share [mkPersist sqlSettings, mkEntityDefList "entityDefs", deriveShowFields] [persistUpperCase| + User + firstName Text.Text + active Bool + deriving Show Eq Read Ord + Dog + Id Text.Text + toy Text.Text + + UserDog + dog DogId + user UserId + +|] + docs :: [EntityDef] docs = document entityDefs $ do User --^ do @@ -39,18 +54,37 @@ UserActive # "Whether or not the user is able to log in." UserId # "You can document the user's ID field." + UserDog --^ do + "Users can have many dogs, and dogs can have many users." + UserDogDog # "This should have type text." + spec :: Spec spec = do runIO $ Text.writeFile "test/example.md" $ render markdownTableRenderer docs + let (userDoc : dogDog : userDogDoc : _) = docs describe "Example Documentation" $ do it "has documentation for ID field" $ do - fieldComments (entityId (head docs)) + fieldComments (entityId userDoc) `shouldBe` Just "You can document the user's ID field." - it "has documentation for all fields" $ do - for_ docs $ \ed -> - for_ (entityFields ed) $ \f -> - fieldComments f `shouldSatisfy` isJust + it "has documentation for all User fields" $ do + for_ (entityFields userDoc) $ \f -> + fieldComments f `shouldSatisfy` isJust + + describe "UserDogDog" $ do + let (userDogDog : userDogUser : _) = entityFields userDogDoc + it "has documentation" $ do + fieldComments userDogDog + `shouldBe` + Just "This should have type text." + it "has the right SQL Type" $ do + fieldSqlType userDogDog + `shouldBe` + sqlType (Proxy :: Proxy DogId) + it "has the appropriate reference" $ do + fieldReference userDogDog + `shouldBe` + ForeignRef (HaskellName "Dog") (FTTypeCon (Just "Text") "Text") describe "FieldDef" $ do let diff --git a/test/Entities.hs b/test/Entities.hs deleted file mode 100644 --- a/test/Entities.hs +++ /dev/null @@ -1,33 +0,0 @@ -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE QuasiQuotes #-} - -module Entities where - -import qualified Data.Char as Char -import qualified Data.Map as Map -import qualified Data.Set as Set -import qualified Data.Text as Text -import Data.Maybe -import Data.Foldable -import Test.Hspec -import Database.Persist.Sql -import Database.Persist.TH - -import Database.Persist.Documentation - -entityDefs :: [EntityDef] -entityDefs = [persistUpperCase| - User - firstName Text.Text - active Bool - deriving Show Eq Read Ord -|] -