From f1764a07bbe9c858f23c9e361a05d2a9dd50df81 Mon Sep 17 00:00:00 2001 From: patritzenfeld Date: Fri, 13 Feb 2026 11:15:11 +0100 Subject: [PATCH 1/6] eliminate MonadWriteFile in favour of MonadCache --- app/check-cds.hs | 5 +++-- app/enterASTaskDemo.hs | 2 +- app/findAuxiliaryPetriNodesTaskDemo.hs | 2 +- app/matchAdTaskDemo.hs | 2 +- app/selectASTaskDemo.hs | 2 +- legacy-app/instance2pic.hs | 9 +++++---- src/Modelling/ActivityDiagram/EnterAS.hs | 4 ++-- .../ActivityDiagram/FindAuxiliaryPetriNodes.hs | 4 ++-- src/Modelling/ActivityDiagram/MatchAd.hs | 4 ++-- src/Modelling/ActivityDiagram/MatchPetri.hs | 2 -- .../ActivityDiagram/PlantUMLConverter.hs | 15 +++++---------- src/Modelling/ActivityDiagram/SelectAS.hs | 4 ++-- src/Modelling/ActivityDiagram/SelectPetri.hs | 3 --- src/Modelling/CdOd/Output.hs | 13 ++++++------- test/Modelling/CdOd/OutputSpec.hs | 12 ++++++------ 15 files changed, 37 insertions(+), 46 deletions(-) diff --git a/app/check-cds.hs b/app/check-cds.hs index 8715ab59a..e3355191f 100644 --- a/app/check-cds.hs +++ b/app/check-cds.hs @@ -6,7 +6,7 @@ import qualified Language.Alloy.Call as Alloy (getInstances) import Capabilities.Diagrams.IO () import Capabilities.Graphviz.IO () -import Capabilities.WriteFile.IO () +import Capabilities.Cache.IO () import Modelling.CdOd.CD2Alloy.Transform ( LinguisticReuse (None), Parts (..), @@ -240,7 +240,8 @@ drawCdAndOdsFor is c cds cmd = do Nothing Back True - (c ++ '-' : shorten cmd ++ "-od" ++ show i ++ ".svg") + "./" + (c ++ '-' : shorten cmd ++ "-od" ++ show i) drawCd' :: AnyCd -> Int -> IO String drawCd' cd i = do renderedCd <- drawCd defaultCdDrawSettings mempty cd diff --git a/app/enterASTaskDemo.hs b/app/enterASTaskDemo.hs index f38c14035..59ff0ed5d 100644 --- a/app/enterASTaskDemo.hs +++ b/app/enterASTaskDemo.hs @@ -2,7 +2,7 @@ module Main (main) where import Capabilities.Alloy.IO () import Capabilities.PlantUml.IO () -import Capabilities.WriteFile.IO () +import Capabilities.Cache.IO () import Modelling.ActivityDiagram.EnterAS ( defaultEnterASConfig, enterAS, diff --git a/app/findAuxiliaryPetriNodesTaskDemo.hs b/app/findAuxiliaryPetriNodesTaskDemo.hs index 275f01400..ae4440203 100644 --- a/app/findAuxiliaryPetriNodesTaskDemo.hs +++ b/app/findAuxiliaryPetriNodesTaskDemo.hs @@ -2,7 +2,7 @@ module Main (main) where import Capabilities.Alloy.IO () import Capabilities.PlantUml.IO () -import Capabilities.WriteFile.IO () +import Capabilities.Cache.IO () import Modelling.ActivityDiagram.FindAuxiliaryPetriNodes ( defaultFindAuxiliaryPetriNodesConfig, findAuxiliaryPetriNodes, diff --git a/app/matchAdTaskDemo.hs b/app/matchAdTaskDemo.hs index 54b3a5444..e3f69f06d 100644 --- a/app/matchAdTaskDemo.hs +++ b/app/matchAdTaskDemo.hs @@ -2,7 +2,7 @@ module Main (main) where import Capabilities.Alloy.IO () import Capabilities.PlantUml.IO () -import Capabilities.WriteFile.IO () +import Capabilities.Cache.IO () import Modelling.ActivityDiagram.MatchAd ( defaultMatchAdConfig, matchAd, diff --git a/app/selectASTaskDemo.hs b/app/selectASTaskDemo.hs index 0c88a66d2..7017827ee 100644 --- a/app/selectASTaskDemo.hs +++ b/app/selectASTaskDemo.hs @@ -2,7 +2,7 @@ module Main (main) where import Capabilities.Alloy.IO () import Capabilities.PlantUml.IO () -import Capabilities.WriteFile.IO () +import Capabilities.Cache.IO () import Modelling.ActivityDiagram.SelectAS ( defaultSelectASConfig, selectAS, diff --git a/legacy-app/instance2pic.hs b/legacy-app/instance2pic.hs index bb54cd486..c831ef2ea 100644 --- a/legacy-app/instance2pic.hs +++ b/legacy-app/instance2pic.hs @@ -3,7 +3,7 @@ import qualified Data.ByteString.Char8 as BS (pack) import Capabilities.Diagrams.IO () import Capabilities.Graphviz.IO () -import Capabilities.WriteFile.IO () +import Capabilities.Cache.IO () import Modelling.CdOd.Output (drawOdFromInstance) import Control.Monad (void) @@ -29,8 +29,8 @@ main = do ++ "is not supported, only SVG is supported" _ -> error "zu viele Parameter" -drawOd :: [String] -> FilePath -> String -> IO () -drawOd possibleLinks file contents = flip evalRandT (mkStdGen 0) $ do +drawOd :: [String] -> String -> String -> IO () +drawOd possibleLinks filePrefix contents = flip evalRandT (mkStdGen 0) $ do i <- lift $ parseInstance $ BS.pack contents output <- drawOdFromInstance i @@ -39,5 +39,6 @@ drawOd possibleLinks file contents = flip evalRandT (mkStdGen 0) $ do (Just $ 1 % 3) NoDir False - (file ++ ".svg") + "./" + filePrefix lift . putStrLn $ "Output written to " ++ output diff --git a/src/Modelling/ActivityDiagram/EnterAS.hs b/src/Modelling/ActivityDiagram/EnterAS.hs index a0b5cd146..539c2d307 100644 --- a/src/Modelling/ActivityDiagram/EnterAS.hs +++ b/src/Modelling/ActivityDiagram/EnterAS.hs @@ -29,7 +29,7 @@ import Autolib.Reader (Reader) import Autolib.ToDoc (ToDoc) import Capabilities.Alloy (MonadAlloy, getInstances) import Capabilities.PlantUml (MonadPlantUml) -import Capabilities.WriteFile (MonadWriteFile) +import Capabilities.Cache (MonadCache) import Modelling.ActivityDiagram.ActionSequences ( generateActionSequencesWithPetri, netAndMap, @@ -205,7 +205,7 @@ enterActionSequence petri = EnterASSolution {sampleSolution = head $ generateActionSequencesWithPetri petri Nothing} enterASTask - :: (MonadPlantUml m, MonadWriteFile m, OutputCapable m) + :: (MonadPlantUml m, MonadCache m, OutputCapable m) => FilePath -> EnterASInstance -> LangM m diff --git a/src/Modelling/ActivityDiagram/FindAuxiliaryPetriNodes.hs b/src/Modelling/ActivityDiagram/FindAuxiliaryPetriNodes.hs index ad14938fb..f00230180 100644 --- a/src/Modelling/ActivityDiagram/FindAuxiliaryPetriNodes.hs +++ b/src/Modelling/ActivityDiagram/FindAuxiliaryPetriNodes.hs @@ -39,7 +39,7 @@ import Autolib.Reader (Reader) import Autolib.ToDoc (ToDoc) import Capabilities.Alloy (MonadAlloy, getInstances) import Capabilities.PlantUml (MonadPlantUml) -import Capabilities.WriteFile (MonadWriteFile) +import Capabilities.Cache (MonadCache) import Modelling.ActivityDiagram.Alloy ( adConfigToAlloy, modulePetriNet, @@ -216,7 +216,7 @@ findAuxiliaryPetriNodesSolution' petri = FindAuxiliaryPetriNodesSolution { auxiliaryTransitionsCount = M.size $ M.filter isTransitionNode auxiliaryPetriNodeMap findAuxiliaryPetriNodesTask - :: (MonadPlantUml m, MonadWriteFile m, OutputCapable m) + :: (MonadPlantUml m, MonadCache m, OutputCapable m) => FilePath -> FindAuxiliaryPetriNodesInstance -> LangM m diff --git a/src/Modelling/ActivityDiagram/MatchAd.hs b/src/Modelling/ActivityDiagram/MatchAd.hs index 3ecff7ae4..fd747af53 100644 --- a/src/Modelling/ActivityDiagram/MatchAd.hs +++ b/src/Modelling/ActivityDiagram/MatchAd.hs @@ -26,7 +26,7 @@ import qualified Data.Map as M (fromList, keys) import Capabilities.Alloy (MonadAlloy, getInstances) import Capabilities.PlantUml (MonadPlantUml) -import Capabilities.WriteFile (MonadWriteFile) +import Capabilities.Cache (MonadCache) import Modelling.ActivityDiagram.Alloy (adConfigToAlloy) import Modelling.ActivityDiagram.Config ( AdConfig (..), @@ -180,7 +180,7 @@ matchAdSolution task = } matchAdTask - :: (MonadPlantUml m, MonadWriteFile m, OutputCapable m) + :: (MonadPlantUml m, MonadCache m, OutputCapable m) => FilePath -> MatchAdInstance -> LangM m diff --git a/src/Modelling/ActivityDiagram/MatchPetri.hs b/src/Modelling/ActivityDiagram/MatchPetri.hs index 781e907a7..9dc85badd 100644 --- a/src/Modelling/ActivityDiagram/MatchPetri.hs +++ b/src/Modelling/ActivityDiagram/MatchPetri.hs @@ -43,7 +43,6 @@ import Capabilities.Cache (MonadCache) import Capabilities.Diagrams (MonadDiagrams) import Capabilities.Graphviz (MonadGraphviz) import Capabilities.PlantUml (MonadPlantUml) -import Capabilities.WriteFile (MonadWriteFile) import Modelling.ActivityDiagram.Alloy (adConfigToAlloy, modulePetriNet) import Modelling.ActivityDiagram.Datatype ( UMLActivityDiagram(..), @@ -326,7 +325,6 @@ matchPetriTask MonadGraphviz m, MonadPlantUml m, MonadThrow m, - MonadWriteFile m, OutputCapable m ) => FilePath diff --git a/src/Modelling/ActivityDiagram/PlantUMLConverter.hs b/src/Modelling/ActivityDiagram/PlantUMLConverter.hs index febaccc14..54f690c1f 100644 --- a/src/Modelling/ActivityDiagram/PlantUMLConverter.hs +++ b/src/Modelling/ActivityDiagram/PlantUMLConverter.hs @@ -13,14 +13,14 @@ module Modelling.ActivityDiagram.PlantUMLConverter ( import Data.ByteString (ByteString) import Data.List ( delete, intercalate, intersect, union ) -import Data.String.Interpolate ( i, __i ) +import Data.String.Interpolate ( __i ) import GHC.Generics (Generic) import Autolib.Hash (Hashable) import Autolib.Reader (Reader) import Autolib.ToDoc (ToDoc) import Capabilities.PlantUml (MonadPlantUml (drawPlantUmlSvg)) -import Capabilities.WriteFile (MonadWriteFile (writeToFile)) +import Capabilities.Cache (MonadCache, cache) import Modelling.ActivityDiagram.Datatype ( AdNode (..), UMLActivityDiagram(..), @@ -41,18 +41,13 @@ defaultPlantUmlConfig = PlantUmlConfig { } drawAdToFile - :: (MonadPlantUml m, MonadWriteFile m) + :: (MonadPlantUml m, MonadCache m) => FilePath -> PlantUmlConfig -> UMLActivityDiagram -> m FilePath -drawAdToFile path conf ad = do - renderedAd <- drawPlantUmlSvg $ convertToPlantUML' conf ad - writeToFile adFilename renderedAd - return adFilename - where - adFilename :: FilePath - adFilename = [i|#{path}Diagram.svg|] +drawAdToFile path conf ad = cache path ".svg" "ActivityDiagram-" (conf,ad) + $ drawPlantUmlSvg . uncurry convertToPlantUML' convertToPlantUML :: UMLActivityDiagram -> ByteString convertToPlantUML = convertToPlantUML' defaultPlantUmlConfig diff --git a/src/Modelling/ActivityDiagram/SelectAS.hs b/src/Modelling/ActivityDiagram/SelectAS.hs index f74e594a3..85bb5a80b 100644 --- a/src/Modelling/ActivityDiagram/SelectAS.hs +++ b/src/Modelling/ActivityDiagram/SelectAS.hs @@ -31,7 +31,7 @@ import Autolib.Reader (Reader) import Autolib.ToDoc (ToDoc) import Capabilities.Alloy (MonadAlloy, getInstances) import Capabilities.PlantUml (MonadPlantUml) -import Capabilities.WriteFile (MonadWriteFile) +import Capabilities.Cache (MonadCache) import Modelling.ActivityDiagram.ActionSequences ( generateActionSequencesWithPetri, generateActionSequenceWithPetriAndRepetition, @@ -286,7 +286,7 @@ asEditDistParams xs = Params } selectASTask - :: (MonadPlantUml m, MonadWriteFile m, OutputCapable m) + :: (MonadPlantUml m, MonadCache m, OutputCapable m) => FilePath -> SelectASInstance -> LangM m diff --git a/src/Modelling/ActivityDiagram/SelectPetri.hs b/src/Modelling/ActivityDiagram/SelectPetri.hs index 550f8844c..10111cb5a 100644 --- a/src/Modelling/ActivityDiagram/SelectPetri.hs +++ b/src/Modelling/ActivityDiagram/SelectPetri.hs @@ -35,7 +35,6 @@ import Capabilities.Cache (MonadCache) import Capabilities.Diagrams (MonadDiagrams) import Capabilities.Graphviz (MonadGraphviz) import Capabilities.PlantUml (MonadPlantUml) -import Capabilities.WriteFile (MonadWriteFile) import qualified Data.Map as M (empty, size, fromList, toList, keys, map, filter) import qualified Modelling.ActivityDiagram.Datatype as Ad (AdNode(label)) import qualified Modelling.ActivityDiagram.PetriNet as PK (PetriKey (label)) @@ -365,7 +364,6 @@ selectPetriTask MonadGraphviz m, MonadPlantUml m, MonadThrow m, - MonadWriteFile m, OutputCapable m ) => FilePath @@ -430,7 +428,6 @@ selectPetriEvaluation MonadGraphviz m, MonadPlantUml m, MonadThrow m, - MonadWriteFile m, OutputCapable m ) => FilePath diff --git a/src/Modelling/CdOd/Output.hs b/src/Modelling/CdOd/Output.hs index 62467a232..0d2d6357a 100644 --- a/src/Modelling/CdOd/Output.hs +++ b/src/Modelling/CdOd/Output.hs @@ -20,7 +20,6 @@ import Capabilities.Diagrams (MonadDiagrams (lin, renderDiagram)) import Capabilities.Graphviz ( MonadGraphviz (errorWithoutGraphviz, layoutGraph'), ) -import Capabilities.WriteFile (MonadWriteFile (writeToFile)) import Modelling.Auxiliary.Diagrams ( arrowheadDiamond, arrowheadFilledDiamond, @@ -355,7 +354,7 @@ Parses an Alloy object diagram instance, draws it and saves it to a file. (the path where it has been stored is returned) -} drawOdFromInstance - :: (MonadCatch m, MonadDiagrams m, MonadGraphviz m, MonadWriteFile m, RandomGen g) + :: (MonadCatch m, MonadDiagrams m, MonadGraphviz m, MonadCache m, RandomGen g) => AlloyInstance -- ^ the Alloy object diagram instance -> Maybe [String] @@ -371,7 +370,9 @@ drawOdFromInstance -> Bool -- ^ whether to print link names -> FilePath - -- ^ where to store the object diagram + -- ^ where to store the object diagram file + -> String + -- ^ the file name prefix -> RandT g m FilePath drawOdFromInstance alloyInstance @@ -381,13 +382,11 @@ drawOdFromInstance direction printNames path + prefix = do g <- lift $ alloyInstanceToOd possibleClassNames possibleLinkNames alloyInstance od <- anonymiseObjects (fromMaybe (1 % 3) anonymous) g - lift $ do - renderedOd <- drawOd od direction printNames - writeToFile path renderedOd - pure path + lift $ cache path ".svg" prefix od $ const $ drawOd od direction printNames cacheOd :: (MonadCache m, MonadDiagrams m, MonadGraphviz m, MonadThrow m) diff --git a/test/Modelling/CdOd/OutputSpec.hs b/test/Modelling/CdOd/OutputSpec.hs index 490544579..c47191e5a 100644 --- a/test/Modelling/CdOd/OutputSpec.hs +++ b/test/Modelling/CdOd/OutputSpec.hs @@ -13,18 +13,17 @@ import qualified Data.ByteString.Char8 as BS ( ) import Capabilities.Diagrams.IO () import Capabilities.Graphviz.IO () -import Capabilities.WriteFile.IO () +import Capabilities.Cache.IO () import Modelling.CdOd.Output (drawCd, drawOdFromInstance) import Modelling.CdOd.Types (defaultCdDrawSettings) import Modelling.Common (withUnitTestsUsingPath) -import Control.Monad (void) import Control.Monad.Except (runExceptT) import Control.Monad.Random (evalRandT) import Data.GraphViz (DirType (Forward)) import Test.Hspec (Spec) import Test.Similarity (Deviation (..), shouldReturnSimilar) -import System.IO.Extra (withTempFile) +import System.IO.Extra (withTempDir, withTempFile) import System.Random (mkStdGen) import Language.Alloy.Debug (parseInstance) @@ -47,10 +46,10 @@ spec = do renderedCd <- drawCd defaultCdDrawSettings mempty cd BS.writeFile file renderedCd BS.readFile file - drawOdInstance alloy = withTempFile $ \file -> do + drawOdInstance alloy = withTempDir $ \tempDir -> do Right alloyInstance <- runExceptT $ parseInstance (BS.pack alloy) let possibleLinks = map (: []) ['w'..'y'] - void $ flip evalRandT + file <- flip evalRandT (mkStdGen 0) $ drawOdFromInstance alloyInstance @@ -59,5 +58,6 @@ spec = do (Just 1) Forward True - file + tempDir + "OutputTest" BS.readFile file From 269bed928aed82a053f5f86a83a91d3dafc62a0b Mon Sep 17 00:00:00 2001 From: patritzenfeld Date: Fri, 13 Feb 2026 15:46:07 +0100 Subject: [PATCH 2/6] add dash after prefix for app file writes --- src/Modelling/CdOd/Output.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Modelling/CdOd/Output.hs b/src/Modelling/CdOd/Output.hs index 0d2d6357a..e6568bc6b 100644 --- a/src/Modelling/CdOd/Output.hs +++ b/src/Modelling/CdOd/Output.hs @@ -386,7 +386,7 @@ drawOdFromInstance = do g <- lift $ alloyInstanceToOd possibleClassNames possibleLinkNames alloyInstance od <- anonymiseObjects (fromMaybe (1 % 3) anonymous) g - lift $ cache path ".svg" prefix od $ const $ drawOd od direction printNames + lift $ cache path ".svg" (prefix ++ "-") od $ const $ drawOd od direction printNames cacheOd :: (MonadCache m, MonadDiagrams m, MonadGraphviz m, MonadThrow m) From 138ab361f7ca6358691ad767398fed5b120224bc Mon Sep 17 00:00:00 2001 From: patritzenfeld Date: Tue, 17 Feb 2026 10:29:35 +0100 Subject: [PATCH 3/6] inline drawOdFromIstance at 3 uses --- app/check-cds.hs | 30 +++++++++--------- legacy-app/instance2pic.hs | 36 ++++++++++------------ src/Modelling/CdOd/Output.hs | 51 +------------------------------ test/Modelling/CdOd/OutputSpec.hs | 37 ++++++++++------------ 4 files changed, 47 insertions(+), 107 deletions(-) diff --git a/app/check-cds.hs b/app/check-cds.hs index e3355191f..403d79fa8 100644 --- a/app/check-cds.hs +++ b/app/check-cds.hs @@ -6,7 +6,8 @@ import qualified Language.Alloy.Call as Alloy (getInstances) import Capabilities.Diagrams.IO () import Capabilities.Graphviz.IO () -import Capabilities.Cache.IO () +import Capabilities.WriteFile.IO () +import Modelling.CdOd.Auxiliary.Util (alloyInstanceToOd) import Modelling.CdOd.CD2Alloy.Transform ( LinguisticReuse (None), Parts (..), @@ -15,7 +16,7 @@ import Modelling.CdOd.CD2Alloy.Transform ( mergeParts, transform, ) -import Modelling.CdOd.Output (drawCd, drawOdFromInstance) +import Modelling.CdOd.Output (drawCd, drawOd) import Modelling.CdOd.Types ( AnyCd, Cd, @@ -24,14 +25,14 @@ import Modelling.CdOd.Types ( ObjectConfig (objectLimits), ObjectProperties (..), Relationship (..), + anonymiseObjects, defaultCdDrawSettings, fromClassDiagram, maxFiveObjects, relationshipName, ) -import Control.Monad.Random (RandT, RandomGen, evalRandT, getStdGen) -import Control.Monad.Trans.Class (MonadTrans (lift)) +import Control.Monad.Random (RandomGen, evalRandT, getStdGen) import Data.Foldable (toList) import Data.GraphViz (DirType (..)) import Data.Maybe (mapMaybe) @@ -228,20 +229,17 @@ drawCdAndOdsFor is c cds cmd = do ods <- Alloy.getInstances is parts' g <- getStdGen let possibleLinks = toList allRelationshipNames - flip evalRandT g $ - mapM_ (\(od, i) -> drawOd possibleLinks od i >>= lift . putStrLn) + mapM_ (\(od, i) -> drawOdToFile possibleLinks od i g >>= putStrLn) $ zip (maybe id (take . fromInteger) is ods) [1..] where - drawOd :: RandomGen g => [String] -> AlloyInstance -> Int -> RandT g IO FilePath - drawOd allRelationshipNames od i = drawOdFromInstance - od - Nothing - allRelationshipNames - Nothing - Back - True - "./" - (c ++ '-' : shorten cmd ++ "-od" ++ show i) + drawOdToFile :: RandomGen g => [String] -> AlloyInstance -> Int -> g -> IO FilePath + drawOdToFile allRelationshipNames inst i g = do + od <- alloyInstanceToOd Nothing allRelationshipNames inst + od' <- flip evalRandT g $ anonymiseObjects (1 % 3) od + renderedOd <- drawOd od' Back True + let path = c ++ '-' : shorten cmd ++ "-od" ++ show i ++ ".svg" + BS.writeFile path renderedOd + pure path drawCd' :: AnyCd -> Int -> IO String drawCd' cd i = do renderedCd <- drawCd defaultCdDrawSettings mempty cd diff --git a/legacy-app/instance2pic.hs b/legacy-app/instance2pic.hs index c831ef2ea..613e0283d 100644 --- a/legacy-app/instance2pic.hs +++ b/legacy-app/instance2pic.hs @@ -1,14 +1,14 @@ module Main (main) where -import qualified Data.ByteString.Char8 as BS (pack) +import qualified Data.ByteString.Char8 as BS (pack, writeFile) import Capabilities.Diagrams.IO () import Capabilities.Graphviz.IO () -import Capabilities.Cache.IO () -import Modelling.CdOd.Output (drawOdFromInstance) +import Modelling.CdOd.Auxiliary.Util (alloyInstanceToOd) +import Modelling.CdOd.Output (drawOd) +import Modelling.CdOd.Types (anonymiseObjects) import Control.Monad (void) import Control.Monad.Random (evalRandT, mkStdGen) -import Control.Monad.Trans.Class (MonadTrans (lift)) import Data.Char (toUpper) import Data.GraphViz (DirType (NoDir)) import Data.Ratio ((%)) @@ -21,24 +21,20 @@ main = do args <- getArgs void $ case args of [] -> error "possible links required (first parameter)" - [xs] -> getContents >>= drawOd (read xs) "output" - [xs, file] -> readFile file >>= drawOd (read xs) file + [xs] -> getContents >>= drawOdToFile (read xs) "output" + [xs, file] -> readFile file >>= drawOdToFile (read xs) file [xs, file, format] - | map toUpper format == "SVG" -> readFile file >>= drawOd (read xs) file + | map toUpper format == "SVG" -> readFile file >>= drawOdToFile (read xs) file | otherwise -> error $ "format " ++ format ++ "is not supported, only SVG is supported" _ -> error "zu viele Parameter" -drawOd :: [String] -> String -> String -> IO () -drawOd possibleLinks filePrefix contents = flip evalRandT (mkStdGen 0) $ do - i <- lift $ parseInstance $ BS.pack contents - output <- drawOdFromInstance - i - Nothing - possibleLinks - (Just $ 1 % 3) - NoDir - False - "./" - filePrefix - lift . putStrLn $ "Output written to " ++ output +drawOdToFile :: [String] -> FilePath -> String -> IO () +drawOdToFile possibleLinks file contents = do + i <- parseInstance (BS.pack contents) + od <- alloyInstanceToOd Nothing possibleLinks i + od' <- flip evalRandT (mkStdGen 0) $ anonymiseObjects (1 % 3) od + renderedOd <- drawOd od' NoDir False + let filename = file ++ ".svg" + BS.writeFile filename renderedOd + putStrLn $ "Output written to " ++ filename diff --git a/src/Modelling/CdOd/Output.hs b/src/Modelling/CdOd/Output.hs index e6568bc6b..7a1d8bc29 100644 --- a/src/Modelling/CdOd/Output.hs +++ b/src/Modelling/CdOd/Output.hs @@ -4,7 +4,6 @@ module Modelling.CdOd.Output ( cacheCd, cacheOd, drawCd, - drawOdFromInstance, drawOd, ) where @@ -32,7 +31,6 @@ import Modelling.Auxiliary.Diagrams ( veeArrow, ) import Modelling.CdOd.Auxiliary.Util ( - alloyInstanceToOd, emptyArr, underlinedLabel, ) @@ -49,19 +47,13 @@ import Modelling.CdOd.Types ( Od, OmittedDefaultMultiplicities (..), Relationship (..), - anonymiseObjects, calculateThickAnyRelationships, rangeWithDefault, ) import Control.Lens ((.~)) import Control.Monad (guard) -import Control.Monad.Catch (MonadCatch, MonadThrow) -import Control.Monad.Random ( - RandT, - RandomGen, - ) -import Control.Monad.Trans (MonadTrans(lift)) +import Control.Monad.Catch (MonadThrow) import Data.Bifunctor (Bifunctor (second)) import Data.ByteString (ByteString) import Data.Digest.Pure.SHA (sha1, showDigest) @@ -87,7 +79,6 @@ import Data.GraphViz.Attributes.Complete (Attribute (..), DPoint (..), Label) import Data.Function ((&)) import Data.List (elemIndex) import Data.Maybe (fromJust, fromMaybe, maybeToList) -import Data.Ratio ((%)) import Data.Tuple.Extra (both) import Diagrams.Align (center) import Diagrams.Angle ((@@), cosA, deg, halfTurn) @@ -119,7 +110,6 @@ import Diagrams.TwoD.Arrowheads (lineTail) import Diagrams.TwoD.Attributes (fc, lc) import Diagrams.Util ((#), with) import Graphics.SVGFonts.ReadFont (PreparedFont) -import Language.Alloy.Call (AlloyInstance) relationshipArrow :: CdDrawSettings @@ -349,45 +339,6 @@ drawClass font l (P p) = translate p # lineWidth 0.6 # svgClass "label" -{-| -Parses an Alloy object diagram instance, draws it and saves it to a file. -(the path where it has been stored is returned) --} -drawOdFromInstance - :: (MonadCatch m, MonadDiagrams m, MonadGraphviz m, MonadCache m, RandomGen g) - => AlloyInstance - -- ^ the Alloy object diagram instance - -> Maybe [String] - -- ^ all possible object names, for @ExtendsAnd FieldPlacement@ - -- - -- see 'alloyInstanceToOd' for more details. - -> [String] - -- ^ possible link names - -> Maybe Rational - -- ^ ratio of anonymous objects - -> DirType - -- ^ direction of links - -> Bool - -- ^ whether to print link names - -> FilePath - -- ^ where to store the object diagram file - -> String - -- ^ the file name prefix - -> RandT g m FilePath -drawOdFromInstance - alloyInstance - possibleClassNames - possibleLinkNames - anonymous - direction - printNames - path - prefix - = do - g <- lift $ alloyInstanceToOd possibleClassNames possibleLinkNames alloyInstance - od <- anonymiseObjects (fromMaybe (1 % 3) anonymous) g - lift $ cache path ".svg" (prefix ++ "-") od $ const $ drawOd od direction printNames - cacheOd :: (MonadCache m, MonadDiagrams m, MonadGraphviz m, MonadThrow m) => Od diff --git a/test/Modelling/CdOd/OutputSpec.hs b/test/Modelling/CdOd/OutputSpec.hs index c47191e5a..a505616db 100644 --- a/test/Modelling/CdOd/OutputSpec.hs +++ b/test/Modelling/CdOd/OutputSpec.hs @@ -13,9 +13,12 @@ import qualified Data.ByteString.Char8 as BS ( ) import Capabilities.Diagrams.IO () import Capabilities.Graphviz.IO () -import Capabilities.Cache.IO () -import Modelling.CdOd.Output (drawCd, drawOdFromInstance) -import Modelling.CdOd.Types (defaultCdDrawSettings) +import Modelling.CdOd.Auxiliary.Util (alloyInstanceToOd) +import Modelling.CdOd.Output (drawCd, drawOd) +import Modelling.CdOd.Types ( + anonymiseObjects, + defaultCdDrawSettings, + ) import Modelling.Common (withUnitTestsUsingPath) import Control.Monad.Except (runExceptT) @@ -23,7 +26,7 @@ import Control.Monad.Random (evalRandT) import Data.GraphViz (DirType (Forward)) import Test.Hspec (Spec) import Test.Similarity (Deviation (..), shouldReturnSimilar) -import System.IO.Extra (withTempDir, withTempFile) +import System.IO.Extra (withTempFile) import System.Random (mkStdGen) import Language.Alloy.Debug (parseInstance) @@ -40,24 +43,16 @@ spec = do Deviation {absoluteDeviation = 20, relativeDeviation = 0.2} draws what = "draws roughly the expected " ++ what ++ " diagram" dir = "test/unit/Modelling/CdOd/Output" - drawCdInstance alloy = withTempFile $ \file -> do + drawCdInstance alloy = do Right alloyInstance <- runExceptT $ parseInstance (BS.pack alloy) Right cd <- return $ instanceClassDiagram <$> fromInstance alloyInstance - renderedCd <- drawCd defaultCdDrawSettings mempty cd - BS.writeFile file renderedCd - BS.readFile file - drawOdInstance alloy = withTempDir $ \tempDir -> do + fileCreationWith $ drawCd defaultCdDrawSettings mempty cd + drawOdInstance alloy = do Right alloyInstance <- runExceptT $ parseInstance (BS.pack alloy) let possibleLinks = map (: []) ['w'..'y'] - file <- flip evalRandT - (mkStdGen 0) - $ drawOdFromInstance - alloyInstance - Nothing - possibleLinks - (Just 1) - Forward - True - tempDir - "OutputTest" - BS.readFile file + fileCreationWith $ do + od <- alloyInstanceToOd Nothing possibleLinks alloyInstance + od' <- evalRandT (anonymiseObjects 1 od) $ mkStdGen 0 + drawOd od' Forward True + fileCreationWith action = withTempFile $ \file -> + action >>= BS.writeFile file >> BS.readFile file From 844d5d970ce9b90e791ae4ce4c1b93a4266e2ae6 Mon Sep 17 00:00:00 2001 From: patritzenfeld Date: Tue, 17 Feb 2026 14:53:30 +0100 Subject: [PATCH 4/6] remove superfluous WriteFile.IO imports --- README.md | 2 +- app/check-cds.hs | 1 - app/matchPetriTaskDemo.hs | 1 - app/selectPetriTaskDemo.hs | 1 - legacy-app/cd2pic.hs | 1 - 5 files changed, 1 insertion(+), 5 deletions(-) diff --git a/README.md b/README.md index 0e150002c..25f5071bb 100644 --- a/README.md +++ b/README.md @@ -36,7 +36,7 @@ stack ghci --stack-yaml=stack-examples.yaml --package=autotool-capabilities-io- ``` ```haskell -:m + Capabilities.Alloy.IO Capabilities.Cache.IO Capabilities.Diagrams.IO Capabilities.Graphviz.IO Capabilities.LatexSvg.IO Capabilities.PlantUml.IO Capabilities.WriteFile.IO +:m + Capabilities.Alloy.IO Capabilities.Cache.IO Capabilities.Diagrams.IO Capabilities.Graphviz.IO Capabilities.LatexSvg.IO Capabilities.PlantUml.IO :m + Control.OutputCapable.Blocks Control.OutputCapable.Blocks.Generic inst <- nameCdErrorGenerate defaultNameCdErrorConfig 0 0 runLangMReport (return ()) (>>) (nameCdErrorTask True "/tmp/" inst) >>= \(Just (), x) -> (x English :: IO ()) diff --git a/app/check-cds.hs b/app/check-cds.hs index 403d79fa8..71822ed79 100644 --- a/app/check-cds.hs +++ b/app/check-cds.hs @@ -6,7 +6,6 @@ import qualified Language.Alloy.Call as Alloy (getInstances) import Capabilities.Diagrams.IO () import Capabilities.Graphviz.IO () -import Capabilities.WriteFile.IO () import Modelling.CdOd.Auxiliary.Util (alloyInstanceToOd) import Modelling.CdOd.CD2Alloy.Transform ( LinguisticReuse (None), diff --git a/app/matchPetriTaskDemo.hs b/app/matchPetriTaskDemo.hs index 19c96951c..e7af5f747 100644 --- a/app/matchPetriTaskDemo.hs +++ b/app/matchPetriTaskDemo.hs @@ -5,7 +5,6 @@ import Capabilities.Cache.IO () import Capabilities.Diagrams.IO () import Capabilities.Graphviz.IO () import Capabilities.PlantUml.IO () -import Capabilities.WriteFile.IO () import Modelling.ActivityDiagram.MatchPetri ( defaultMatchPetriConfig, matchPetri, diff --git a/app/selectPetriTaskDemo.hs b/app/selectPetriTaskDemo.hs index 106b269cd..bb6d68698 100644 --- a/app/selectPetriTaskDemo.hs +++ b/app/selectPetriTaskDemo.hs @@ -5,7 +5,6 @@ import Capabilities.Cache.IO () import Capabilities.Diagrams.IO () import Capabilities.Graphviz.IO () import Capabilities.PlantUml.IO () -import Capabilities.WriteFile.IO () import Modelling.ActivityDiagram.SelectPetri ( defaultSelectPetriConfig, selectPetri, diff --git a/legacy-app/cd2pic.hs b/legacy-app/cd2pic.hs index 8ddee1a68..fb8f5d79d 100644 --- a/legacy-app/cd2pic.hs +++ b/legacy-app/cd2pic.hs @@ -4,7 +4,6 @@ import qualified Data.ByteString as BS (writeFile) import Capabilities.Diagrams.IO () import Capabilities.Graphviz.IO () -import Capabilities.WriteFile.IO () import Modelling.CdOd.Auxiliary.Lexer (lexer) import Modelling.CdOd.Auxiliary.Parser (parser) import Modelling.CdOd.Output From 7c2681820adde11ea2d3f9d98ff7243088fd5219 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Janis=20Voigtl=C3=A4nder?= Date: Wed, 18 Mar 2026 13:33:10 +0100 Subject: [PATCH 5/6] Update drawOd function call to use Nothing --- test/Modelling/CdOd/OutputSpec.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/Modelling/CdOd/OutputSpec.hs b/test/Modelling/CdOd/OutputSpec.hs index 10d06acff..b658f1860 100644 --- a/test/Modelling/CdOd/OutputSpec.hs +++ b/test/Modelling/CdOd/OutputSpec.hs @@ -53,6 +53,6 @@ spec = do fileCreationWith $ do od <- alloyInstanceToOd Nothing possibleLinks alloyInstance od' <- evalRandT (anonymiseObjects 1 od) $ mkStdGen 0 - drawOd od' Forward True + drawOd od' Nothing Forward True fileCreationWith action = withTempFile $ \file -> action >>= BS.writeFile file >> BS.readFile file From 1c63101e269649264b497819d24da6741fea2fcb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Janis=20Voigtl=C3=A4nder?= Date: Wed, 18 Mar 2026 14:10:51 +0100 Subject: [PATCH 6/6] add new parameter in apps --- app/check-cds.hs | 2 +- legacy-app/instance2pic.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/app/check-cds.hs b/app/check-cds.hs index 8794b0fdb..f4675684a 100644 --- a/app/check-cds.hs +++ b/app/check-cds.hs @@ -235,7 +235,7 @@ drawCdAndOdsFor is c cds cmd = do drawOdToFile allRelationshipNames inst i g = do od <- alloyInstanceToOd Nothing allRelationshipNames inst od' <- flip evalRandT g $ anonymiseObjects (1 % 3) od - renderedOd <- drawOd od' Back True + renderedOd <- drawOd od' Nothing Back True let path = c ++ '-' : shorten cmd ++ "-od" ++ show i ++ ".svg" BS.writeFile path renderedOd pure path diff --git a/legacy-app/instance2pic.hs b/legacy-app/instance2pic.hs index 613e0283d..5b6f6988b 100644 --- a/legacy-app/instance2pic.hs +++ b/legacy-app/instance2pic.hs @@ -34,7 +34,7 @@ drawOdToFile possibleLinks file contents = do i <- parseInstance (BS.pack contents) od <- alloyInstanceToOd Nothing possibleLinks i od' <- flip evalRandT (mkStdGen 0) $ anonymiseObjects (1 % 3) od - renderedOd <- drawOd od' NoDir False + renderedOd <- drawOd od' Nothing NoDir False let filename = file ++ ".svg" BS.writeFile filename renderedOd putStrLn $ "Output written to " ++ filename