Skip to content

Commit

Permalink
fix issue #1516
Browse files Browse the repository at this point in the history
  • Loading branch information
hanjoosten committed Oct 20, 2024
1 parent 8a74427 commit 85966f4
Show file tree
Hide file tree
Showing 4 changed files with 36 additions and 9 deletions.
16 changes: 10 additions & 6 deletions src/Ampersand/Commands/Documentation.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
11 changes: 10 additions & 1 deletion src/Ampersand/Graphic/Graphics.hs
Original file line number Diff line number Diff line change
@@ -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)
Expand Down Expand Up @@ -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
Expand Down
7 changes: 6 additions & 1 deletion src/Ampersand/Misc/HasClasses.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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.
Expand All @@ -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)
]
Expand Down
11 changes: 10 additions & 1 deletion src/Ampersand/Options/DocOptsParser.hs
Original file line number Diff line number Diff line change
Expand Up @@ -19,6 +19,7 @@ docOptsParser =
DocOpts
<$> blackWhiteP
<*> chaptersP
<*> datamodelOnlyP
<*> genGraphicsP
<*> genTextP
<*> fSpecFormatP
Expand Down Expand Up @@ -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."
)
Expand Down Expand Up @@ -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
Expand Down

0 comments on commit 85966f4

Please sign in to comment.