Skip to content

eliminate MonadWriteFile in favour of MonadCache #600

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
patritzenfeld wants to merge 8 commits into
base: dev
Choose a base branch
from
Open

eliminate MonadWriteFile in favour of MonadCache #600

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
8 commits
Select commit Hold shift + click to select a range
f1764a0
eliminate MonadWriteFile in favour of MonadCache
patritzenfeld Feb 13, 2026
269bed9
add dash after prefix for app file writes
patritzenfeld Feb 13, 2026
138ab36
inline drawOdFromIstance at 3 uses
patritzenfeld Feb 17, 2026
844d5d9
remove superfluous WriteFile.IO imports
patritzenfeld Feb 17, 2026
a11a4cb
Merge branch 'dev' into swap-ad-filewrite
jvoigtlaender Mar 18, 2026
7c26818
Update drawOd function call to use Nothing
jvoigtlaender Mar 18, 2026
1c63101
add new parameter in apps
jvoigtlaender Mar 18, 2026
099c9a9
Merge branch 'dev' into swap-ad-filewrite
jvoigtlaender Jun 3, 2026
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion README.md
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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 ())
Expand Down
28 changes: 13 additions & 15 deletions app/check-cds.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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 Modelling.CdOd.Auxiliary.Util (alloyInstanceToOd)
import Modelling.CdOd.CD2Alloy.Transform (
LinguisticReuse (None),
Parts (..),
Expand All @@ -15,7 +15,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,
Expand All @@ -24,14 +24,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)
Expand Down Expand Up @@ -228,19 +228,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 ++ ".svg")
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' Nothing 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 Nothing cd
Expand Down
2 changes: 1 addition & 1 deletion app/enterASTaskDemo.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand Down
2 changes: 1 addition & 1 deletion app/findAuxiliaryPetriNodesTaskDemo.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand Down
2 changes: 1 addition & 1 deletion app/matchAdTaskDemo.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand Down
1 change: 0 additions & 1 deletion app/matchPetriTaskDemo.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand Down
2 changes: 1 addition & 1 deletion app/selectASTaskDemo.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand Down
1 change: 0 additions & 1 deletion app/selectPetriTaskDemo.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand Down
1 change: 0 additions & 1 deletion legacy-app/cd2pic.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
35 changes: 16 additions & 19 deletions legacy-app/instance2pic.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -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.WriteFile.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 ((%))
Expand All @@ -21,23 +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] -> FilePath -> String -> IO ()
drawOd possibleLinks file contents = flip evalRandT (mkStdGen 0) $ do
i <- lift $ parseInstance $ BS.pack contents
output <- drawOdFromInstance
i
Nothing
possibleLinks
(Just $ 1 % 3)
NoDir
False
(file ++ ".svg")
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' Nothing NoDir False
let filename = file ++ ".svg"
BS.writeFile filename renderedOd
putStrLn $ "Output written to " ++ filename
4 changes: 2 additions & 2 deletions src/Modelling/ActivityDiagram/EnterAS.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand Down Expand Up @@ -215,7 +215,7 @@ enterActionSequence petri =
EnterASSolution {sampleSolution = head $ generateActionSequencesWithPetri petri Nothing}

enterASTask
:: (MonadPlantUml m, MonadWriteFile m, OutputCapable m)
:: (MonadPlantUml m, MonadCache m, OutputCapable m)
=> Bool
-> FilePath
-> EnterASInstance
Expand Down
4 changes: 2 additions & 2 deletions src/Modelling/ActivityDiagram/FindAuxiliaryPetriNodes.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand Down Expand Up @@ -213,7 +213,7 @@ findAuxiliaryPetriNodesSolution' petri = FindAuxiliaryPetriNodesSolution {
auxiliaryTransitionsCount = M.size $ M.filter isTransitionNode auxiliaryPetriNodeMap

findAuxiliaryPetriNodesTask
:: (MonadPlantUml m, MonadWriteFile m, OutputCapable m)
:: (MonadPlantUml m, MonadCache m, OutputCapable m)
=> Bool
-> FilePath
-> FindAuxiliaryPetriNodesInstance
Expand Down
4 changes: 2 additions & 2 deletions src/Modelling/ActivityDiagram/MatchAd.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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 (..),
Expand Down Expand Up @@ -177,7 +177,7 @@ matchAdSolution task =
}

matchAdTask
:: (MonadPlantUml m, MonadWriteFile m, OutputCapable m)
:: (MonadPlantUml m, MonadCache m, OutputCapable m)
=> Bool
-> FilePath
-> MatchAdInstance
Expand Down
2 changes: 0 additions & 2 deletions src/Modelling/ActivityDiagram/MatchPetri.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -44,7 +44,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(..),
Expand Down Expand Up @@ -346,7 +345,6 @@ matchPetriTask
MonadGraphviz m,
MonadPlantUml m,
MonadThrow m,
MonadWriteFile m,
OutputCapable m
)
=> Bool
Expand Down
15 changes: 5 additions & 10 deletions src/Modelling/ActivityDiagram/PlantUMLConverter.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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(..),
Expand All @@ -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'

@jvoigtlaender jvoigtlaender Feb 17, 2026

Copy link
Copy Markdown
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Die bereits vorhandenen cache-Nutzungen hier im Repo sind alle irgendwelche fancyeren Verwendungen. Also zum Beispiel mit Kodierung von Aufgabentypen in die Dateinamen:

modelling-tasks/src/Modelling/PetriNet/Diagram.hs

Lines 95 to 98 in 992b725

prefix =
"petri-"
++ petriType
++ nodeType
und/oder weiteren Bestandteilen, sowohl dort als auch etwa in

modelling-tasks/src/Modelling/CdOd/Output.hs

Lines 193 to 196 in 992b725

ext = short printNavigations
++ short printNames
++ showDigest (sha1 . LBS.fromString $ show marking)
++ ".svg"

Mir ist nicht klar, was davon essentiell, nice to have, oder vielleicht sogar unidiomatisch ist (fmidue/autotool-capabilities#29), und schon gar nicht, ob das Konsequenzen dafür hat, wie der Aufruf hier aussehen sollte.

@patritzenfeld patritzenfeld Feb 19, 2026

Copy link
Copy Markdown
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Da bin ich mir auch nicht sicher. Fürs Caching wird ein SHA256 Hash verwendet, es sollte also extrem unwahrscheinlich sein, dass eine Kollision auftritt, auch wenn diese Informationen stattdessen mitgehasht werden.
Diese Teile dem Dateinamen hinzuzufügen hilft vielleicht dabei, die erstellten Dateien später besser einer bestimmten Aufgabe zuordnen zu können, wenn mal etwas debugt werden muss?

@jvoigtlaender jvoigtlaender Feb 19, 2026

Copy link
Copy Markdown
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Es gab mal eine lange verwandte Diskussion ab hier: https://git.uni-due.de/fmi/autotool-dev/-/commit/cab9de03013d848ed5628e7744faa6c78465bbb3#note_209675


convertToPlantUML :: UMLActivityDiagram -> ByteString
convertToPlantUML = convertToPlantUML' defaultPlantUmlConfig
Expand Down
4 changes: 2 additions & 2 deletions src/Modelling/ActivityDiagram/SelectAS.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand Down Expand Up @@ -287,7 +287,7 @@ asEditDistParams xs = Params
}

selectASTask
:: (MonadPlantUml m, MonadWriteFile m, OutputCapable m)
:: (MonadPlantUml m, MonadCache m, OutputCapable m)
=> Bool
-> FilePath
-> SelectASInstance
Expand Down
3 changes: 0 additions & 3 deletions src/Modelling/ActivityDiagram/SelectPetri.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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))
Expand Down Expand Up @@ -368,7 +367,6 @@ selectPetriTask
MonadGraphviz m,
MonadPlantUml m,
MonadThrow m,
MonadWriteFile m,
OutputCapable m
)
=> Bool
Expand Down Expand Up @@ -444,7 +442,6 @@ selectPetriEvaluation
MonadGraphviz m,
MonadPlantUml m,
MonadThrow m,
MonadWriteFile m,
OutputCapable m
)
=> FilePath
Expand Down
Loading
Loading