Merge pull request #1517 from AmpersandTarski/feature/datamodel-only

fix issue #1516

ReleaseNotes.md

@@ -1,5 +1,9 @@
 # Release notes of Ampersand
 
+## v5.2.4
+
+- [Issue #1516](https://github.com/AmpersandTarski/Ampersand/issues/1516) It is now possible to only generate datamodel images using --datamodelOnly 
+
 ## v5.2.3 (17 october 2024)
 
 - [Issue #1482](https://github.com/AmpersandTarski/Ampersand/issues/1482) Fix technical debd from merging Ampersand 4 into Ampersand 5

ampersand.cabal

@@ -5,7 +5,7 @@ cabal-version: 2.0
 -- see: https://github.com/sol/hpack
 
 name:           ampersand
-version:        5.2.3
+version:        5.2.4
 synopsis:       Toolsuite for automated design of enterprise information systems.
 description:    You can define your business processes by means of rules, written in Relation Algebra.
 category:       Database Design

package.yaml

@@ -1,5 +1,5 @@
 name: ampersand
-version: 5.2.3
+version: 5.2.4
 author: Stef Joosten
 maintainer: [email protected]
 synopsis: Toolsuite for automated design of enterprise information systems.

src/Ampersand/Commands/Documentation.hs

@@ -25,9 +25,13 @@ doGenDocument fSpec = do
   let (thePandoc, thePictures) = fSpec2Pandoc env now fSpec
   -- First we need to output the pictures, because they should be present
   -- before the actual document is written
-  genGraphics <- view genGraphicsL
-  when (genGraphics && fspecFormat /= FPandoc)
-    $ mapM_ writePicture thePictures
-  genText <- view genTextL
-  when genText
-    $ writepandoc fSpec thePandoc
+  datamodelsOnly <- view genDatamodelOnlyL
+  if datamodelsOnly
+    then mapM_ writePicture $ filter isDatamodel thePictures
+    else do
+      genGraphics <- view genGraphicsL
+      when (genGraphics && fspecFormat /= FPandoc)
+        $ mapM_ writePicture thePictures
+      genText <- view genTextL
+      when genText
+        $ writepandoc fSpec thePandoc

src/Ampersand/Graphic/Graphics.hs

@@ -1,6 +1,6 @@
 {-# LANGUAGE FlexibleInstances #-}
 
-module Ampersand.Graphic.Graphics (makePicture, writePicture, Picture (..), PictureTyp (..), imagePathRelativeToDirOutput) where
+module Ampersand.Graphic.Graphics (makePicture, writePicture, Picture (..), PictureTyp (..), imagePathRelativeToDirOutput, isDatamodel) where
 
 import Ampersand.ADL1
 import Ampersand.Basics hiding (Label)
@@ -69,6 +69,15 @@ instance Named PictureTyp where -- for displaying a fatal error
                 Just np -> np
             )
 
+isDatamodel :: Picture -> Bool
+isDatamodel = isDatamodelType . pType
+
+isDatamodelType :: PictureTyp -> Bool
+isDatamodelType pt = case pt of
+  PTLogicalDM {} -> True
+  PTTechnicalDM {} -> True
+  _ -> False
+
 makePicture :: (HasOutputLanguage env) => env -> FSpec -> PictureTyp -> Picture
 makePicture env fSpec pr =
   case pr of

src/Ampersand/Misc/HasClasses.hs

@@ -179,6 +179,8 @@ class (HasOutputLanguage a) => HasDocumentOpts a where
   genGraphicsL = documentOptsL . lens xgenGraphics (\x y -> x {xgenGraphics = y})
   genTextL :: Lens' a Bool -- Generate text. Useful for generating text and graphics separately.
   genTextL = documentOptsL . lens xgenText (\x y -> x {xgenText = y})
+  genDatamodelOnlyL :: Lens' a Bool -- Generate only the datamodel images. This overrides genGraphicsL and genTextL
+  genDatamodelOnlyL = documentOptsL . lens xgenDatamodelImagesOnly (\x y -> x {xgenDatamodelImagesOnly = y})
 
 instance HasDocumentOpts DocOpts where
   documentOptsL = id
@@ -371,6 +373,8 @@ data DocOpts = DocOpts
     xblackWhite :: !Bool,
     -- | a list containing all chapters that are required to be in the generated documentation
     xchapters :: ![Chapter],
+    -- | Only generate datamodel images.
+    xgenDatamodelImagesOnly :: !Bool,
     -- | enable/disable generation of graphics. Used to generate text and graphics in separation.
     xgenGraphics :: !Bool,
     -- | enable/disable generation of text. Used to generate text and graphics in separation.
@@ -391,7 +395,8 @@ instance HasOptions DocOpts where
     [ ("--blackWhite", tshow $ xblackWhite opts)
     ]
       <> fmap chapters [minBound ..]
-      <> [ ("--[no-]graphics", tshow $ xgenGraphics opts),
+      <> [ ("--datamodelOnly", tshow $ xgenDatamodelImagesOnly opts),
+           ("--[no-]graphics", tshow $ xgenGraphics opts),
            ("--[no-]text", tshow $ xgenText opts),
            ("--format", tshow $ xfspecFormat opts)
          ]

src/Ampersand/Options/DocOptsParser.hs

@@ -19,6 +19,7 @@ docOptsParser =
   DocOpts
     <$> blackWhiteP
     <*> chaptersP
+    <*> datamodelOnlyP
     <*> genGraphicsP
     <*> genTextP
     <*> fSpecFormatP
@@ -87,6 +88,8 @@ docOptsParser =
         <$> strOption
           ( long "format"
               <> metavar "FORMAT"
+              <> value "docx"
+              <> showDefault
               <> completeWith (map (T.unpack . stripF) allFormats)
               <> help "The format in which the output is written."
           )
@@ -143,7 +146,13 @@ docOptsParser =
                   <> "black and white."
               )
         )
-
+    datamodelOnlyP :: Parser Bool
+    datamodelOnlyP =
+      switch
+        ( long "datamodelOnly"
+            <> help
+              "Only generate datamodel images. This implies --no-text"
+        )
     genLegalRefsP :: Parser Bool
     genLegalRefsP =
       boolFlags