Cleaned up io a bit

hs/app/CommonOptions.hs

@@ -4,6 +4,8 @@ import Options.Applicative
 
 data CommonOptions = CommonOptions
   { extraChecks :: Bool
+  , verbose :: Bool
+  , moreOutput :: Bool
   , logDirectory :: FilePath
   , resultsDirectory :: FilePath
   }
@@ -13,5 +15,7 @@ commonOptionsParser :: Parser CommonOptions
 commonOptionsParser =
   CommonOptions
     <$> switch (long "extra-checks" <> help "Enable extra validation checks")
+    <*> switch (long "verbose" <> short 'v' <> help "More out to the terminal")
+    <*> switch (long "more-output" <> help "More output to files")
     <*> option str (long "log-directory" <> help "Directory for logging" <> showDefault <> value "log")
     <*> option str (long "results-directory" <> help "Directory for outputs" <> showDefault <> value "results")

hs/app/DecomposeOutput.hs

@@ -24,7 +24,8 @@ import Data.Text.IO qualified as T
 import Data.Text.Lazy.IO qualified as TL
 import Data.Tuple (swap)
 import Options.Applicative
-import System.FilePath ((</>))
+import System.FilePath (takeBaseName, (<.>), (</>))
+import System.IO (hFlush, stdout)
 
 data DecomposeOutputOptions = DecomposeOutputOptions
   { filename :: FilePath
@@ -40,8 +41,7 @@ decomposeOutputOptionsParser =
 
 mainDecomposeOutput :: DecomposeOutputOptions -> CommonOptions -> IO ()
 mainDecomposeOutput DecomposeOutputOptions{..} CommonOptions{..} = do
-  let
+  let report s = appendFile (logDirectory </> "hs-decompose-output.txt") (filename <> "\t" <> s <> "\n")
-    report s = appendFile (logDirectory </> "hs-decompose-output-hs.txt") (filename <> "\t" <> s <> "\n")
 
   -- READING INPUT
   ----------------
@@ -51,26 +51,29 @@ mainDecomposeOutput DecomposeOutputOptions{..} CommonOptions{..} = do
   -- PREPROCESSING
   ----------------
   let (outputFuns, reverseFuns) = preprocess machine
+  when verbose $ do
     printBasics outputFuns reverseFuns machine extraChecks
+    putStrLn ""
 
   -- MINIMISING EACH COMPONENT
   ----------------------------
   let mappedOutputFuns o = [(i, (o ==) . f) | (i, f) <- outputFuns]
       projections = [(o, refineFuns (mappedOutputFuns o) reverseFuns (states machine)) | o <- outputs machine]
 
-  putStrLn $ "\nComponents " <> show (length (outputs machine))
+  putStrLn $ show (length (outputs machine)) <> " components"
-  mapM_ (\(o, p) -> putStr "  " >> T.putStr o >> putStr " has size " >> print (numBlocks p)) projections
+  when verbose $ do
+    lazyListPrint . fmap (second numBlocks) $ projections
+    putStrLn ""
 
   -- REDUCING NUMBER OF COMPONENTS
   -- by checking which partitions are equivalent
   ----------------------------------------------
   let (equiv, uniqPartitions) = equivalenceClasses comparePartitions projections
 
-  putStrLn $ "\nRepresentatives " <> show (length uniqPartitions)
+  putStrLn $ "Representatives " <> show (length uniqPartitions)
-  print . fmap fst $ uniqPartitions
+  when verbose $ do
-
+    lazyListPrint . fmap fst $ uniqPartitions
-  -- putStrLn "\nEquivalences"
+    putStrLn ""
-  -- mapM_ (\(o2, o1) -> putStrLn $ "  " <> show o2 <> " == " <> show o1) (Map.assocs equiv)
 
   -- COMPUTING THE LATTICE OF COMPONENTS
   -- Then we compare each pair of partitions. We only keep the finest
@@ -81,8 +84,26 @@ mainDecomposeOutput DecomposeOutputOptions{..} CommonOptions{..} = do
     foo (a, b) = (numBlocks b, a)
     sortedTopMods = sortOn (negate . fst) . fmap foo $ topMods
 
-  putStrLn $ "\nTop modules " <> show (length topMods)
+  putStrLn $ "Top modules " <> show (length topMods)
-  mapM_ (\(b, o) -> putStr "  " >> T.putStr o >> putStr " has size " >> print b) sortedTopMods
+  when verbose $ do
+    lazyListPrint sortedTopMods
+    putStrLn ""
+
+  when moreOutput $ do
+    let outputFile = takeBaseName filename <> "_info" <.> "txt"
+    putStrLn $ "Writing more info to " <> outputFile
+    writeFile
+      (resultsDirectory </> takeBaseName filename <> "_info" <.> "txt")
+      ( "Representatives\n"
+          <> show (fmap fst uniqPartitions)
+          <> "\n\n"
+          <> "Equivalences\n"
+          <> show (Map.assocs equiv)
+          <> "\n\n"
+          <> "Top modules\n"
+          <> show sortedTopMods
+          <> "\n\n"
+      )
 
   -- HEURISTIC MERGING
   -- Then we try to combine paritions, so that we don't end up with
@@ -128,9 +149,9 @@ mainDecomposeOutput DecomposeOutputOptions{..} CommonOptions{..} = do
       when extraChecks (putStrLn $ "  Correct? " <> show (comparePartitions p partition))
       putStrLn $ "  Size = " <> show (numBlocks p)
 
-      do
+      when moreOutput $ do
         let
-          filename' = "partition_" <> show componentIdx <> ".dot"
+          filename' = takeBaseName filename <> "_partition_" <> show componentIdx <.> "txt"
           content = T.unlines . fmap T.unwords . toBlocks $ p
 
         putStrLn $ "  Output (partition) in file " <> filename'
@@ -151,7 +172,8 @@ mainDecomposeOutput DecomposeOutputOptions{..} CommonOptions{..} = do
           initialFirst = sortOn (\(s, _, _, _) -> s /= initialBlock) transitionsBlocks
 
           -- Convert to a file
-          filename1 = "component_" <> show componentIdx <> ".dot"
+          filenameBase = takeBaseName filename <> "_component_" <> show componentIdx
+          filename1 = filenameBase <.> "dot"
           content1 = toString . mealyToDot name $ initialFirst
 
           -- So far so good, `initialFirst` could serve as our output
@@ -162,7 +184,7 @@ mainDecomposeOutput DecomposeOutputOptions{..} CommonOptions{..} = do
           result = filter (\(_, i, _, _) -> i `Set.notMember` deadInputs) initialFirst
 
           -- Convert to a file
-          filename2 = "component_reduced_" <> show componentIdx <> ".dot"
+          filename2 = filenameBase <> "_reduced" <.> "dot"
           content2 = toString . mealyToDot name $ result
 
         putStrLn $ "  Output (reduced machine) in file " <> filename1
@@ -190,13 +212,16 @@ printBasics :: _ => _ -> _ -> MealyMachine _ _ _ -> Bool -> IO _
 printBasics outputFuns reverseFuns MealyMachine{..} extraChecksEnabled = do
   putStrLn $ (show . length $ states) <> " states, " <> (show . length $ inputs) <> " inputs and " <> (show . length $ outputs) <> " outputs"
   when extraChecksEnabled $ do
-    printPartition (refineFuns outputFuns reverseFuns states)
+    putStrLn $ "Number of states after minimisation: " <> show (numBlocks (refineFuns outputFuns reverseFuns states))
-    putStrLn ""
 
 -- | This functions inverts a map. In the new map the values are lists.
 converseRelation :: Ord b => Map.Map a b -> Map.Map b [a]
 converseRelation = Map.fromListWith (++) . fmap (second pure . swap) . Map.assocs
 
--- | Prints the number of blocks.
+lazyListPrint :: Show a => [a] -> IO ()
-printPartition :: Partition s -> IO ()
+lazyListPrint [] = putStrLn "[]"
-printPartition p = putStrLn $ "number of states = " <> show (numBlocks p)
+lazyListPrint [x] = putStrLn $ "[" <> show x <> "]"
+lazyListPrint (x : xs) = do
+  putStr ("[" <> show x) >> hFlush stdout
+  mapM_ (\x' -> putStr ("," <> show x') >> hFlush stdout) xs
+  putStrLn "]"