diff --git a/src/random-dfa/Main.hs b/src/random-dfa/Main.hs
index 9e914572f97a2cf30da99c3d10b6000105946014..8cd706c6f2bf5d3252f4d731673fa0fa1483a703 100644
--- a/src/random-dfa/Main.hs
+++ b/src/random-dfa/Main.hs
@@ -1,7 +1,11 @@
+{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TemplateHaskell #-}
 module Main (main) where
 
 import           Control.Applicative
+import           Control.Monad                  ( forM_ )
+import           Data.Maybe                     ( listToMaybe )
+import qualified Data.List.NonEmpty            as NE
 
 import qualified Data.Text.Lazy.IO             as TL
 import qualified Data.Text.Lazy.Builder        as Build
@@ -44,9 +48,8 @@ instance Show OutputFormat where
 data Options = Options
   { _optStates :: Int
   , _optLetters :: Int
-  , _optFile :: Maybe FilePath
-  , _optOutputFormat :: OutputFormat
-  }
+  , _optOutputs :: [(OutputFormat, Maybe (NE.NonEmpty Char))]
+  } deriving (Show)
 makeLensesWith abbreviatedFields ''Options
 
 
@@ -61,22 +64,13 @@ options =
           OptParse.auto
           (OptParse.metavar "M" <> OptParse.help "Size of the alphabet")
         )
-    <*> optional
-          (OptParse.strArgument
-            (OptParse.metavar "OUTPUT_FILE" <> OptParse.help
-              "Name of the file where the output should be written."
+    <*> some
+          (OptParse.argument
+            readOutput
+            (  OptParse.metavar "FORMAT:[OUTPUT_FILE]..."
+            <> OptParse.help "FORMAT can be 'dot', 'ma' or 'valmari'"
             )
           )
-    <*> (OptParse.option
-          readFormat
-          (  OptParse.long "output-format"
-          <> OptParse.metavar "FORMAT"
-          <> OptParse.value MA
-          <> OptParse.help
-               "Syntax used for the output. Posible values are 'ma', 'valmari' or 'dot'."
-          <> OptParse.showDefault
-          )
-        )
 
 
 readFormat :: OptParse.ReadM OutputFormat
@@ -87,6 +81,18 @@ readFormat = OptParse.maybeReader $ \case
   _     -> Nothing
 
 
+readOutput :: OptParse.ReadM (OutputFormat, Maybe (NE.NonEmpty Char))
+readOutput = OptParse.eitherReader $ \s -> case span (/= sep) s of
+  ([]    , _ ) -> Left "a"
+  (_     , []) -> Left "b"
+  (format, _ : file) -> (, NE.nonEmpty file) <$> case format of
+    "ma"  -> Right MA
+    "dot" -> Right Dot
+    "valmari" -> Right Valmari
+    _     -> Left "c"
+  where sep = ':'
+
+
 main :: IO ()
 main = do
   opts <- OptParse.execParser
@@ -97,16 +103,17 @@ main = do
       )
     )
 
-  let builder = case opts ^. outputFormat of
-        MA      -> coalgB
-        Dot     -> dotB
-        Valmari -> valmariB
-
   dfa <- randomDFA (opts ^. states) (opts ^. letters)
 
-  let text = Build.toLazyText (builder dfa)
-  case opts ^. file of
-    Nothing       -> TL.putStr text
-    Just filename -> TL.writeFile filename text
+  forM_ (opts ^. outputs) $ \(outputFormat, outputFile) -> do
+    let builder = case outputFormat of
+          MA      -> coalgB
+          Dot     -> dotB
+          Valmari -> valmariB
+
+    let text = Build.toLazyText (builder dfa)
+    case outputFile of
+      Nothing       -> TL.putStr text
+      Just filename -> TL.writeFile (NE.toList filename) text
 
-  return ()
+    return ()