fixup! fixup! fixup! fixup! fixup! fixup! Implements split and merge …

…commands.
haskell-mafia · Apr 3, 2017 · 3684ce2 · 3684ce2
1 parent ba9b657
commit 3684ce2
Show file tree

Hide file tree

Showing 3 changed files with 38 additions and 44 deletions.
diff --git a/main/regiment.hs b/main/regiment.hs
@@ -34,8 +34,10 @@ main = do
         orDie renderRegimentIOError $
           regiment inn out sc f n nc sep m
       SplitCommand inn nc sc sep m f n tmp ->
-        orDie renderRegimentIOError $
-          splitToDir inn tmp sc f n nc sep m
+        orDie renderRegimentIOError $ do
+          createDirectory tmp
+          firstT RegimentIOParseError $
+            split inn tmp sc f n nc sep m
       MergeCommand out dirs ->
         orDie renderRegimentIOError $
           mergeDirs dirs out

diff --git a/src/Regiment/IO.hs b/src/Regiment/IO.hs
@@ -5,8 +5,9 @@ module Regiment.IO (
   , mergeDirs
   , regiment
   , renderRegimentIOError
-  , splitToDir
+  , split
   , open
+  , createDirectory
   ) where
 
 import           Control.Exception (SomeException)
@@ -87,20 +88,14 @@ split inn tmp sc f n nc sep m = do
       }
   toTempFiles inn tmp fmt sc m
 
-splitToDir ::
-     InputFile
-  -> TempDirectory
-  -> [SortColumn]
-  -> FormatKind
-  -> Newline
-  -> NumColumns
-  -> Separator
-  -> MemoryLimit
+mergeDirs ::
+     [TempDirectory]
+  -> Maybe OutputFile
   -> EitherT RegimentIOError IO ()
-splitToDir inn tmp sc f n nc sep m = do
-  createDirectory tmp
-  firstT RegimentIOParseError $
-    split inn tmp sc f n nc sep m
+mergeDirs dirs out = firstT RegimentIOMergeError $
+  mapEitherT R.runResourceT $ do
+    handles <- mapM openDir dirs
+    mapEitherT liftIO $ merge (concat handles) out
 
 merge ::
      [Handle]
@@ -114,15 +109,6 @@ merge handles out = mapEitherT R.runResourceT $ do
   mapEitherT liftIO $ runVanguardIO v out'
   liftIO $ hFlush out'
 
-mergeDirs ::
-     [TempDirectory]
-  -> Maybe OutputFile
-  -> EitherT RegimentIOError IO ()
-mergeDirs dirs out = firstT RegimentIOMergeError $
-  mapEitherT R.runResourceT $ do
-    handles <- mapM openDir dirs
-    mapEitherT liftIO $ merge (concat handles) out
-
 openDir :: MonadResource m => TempDirectory -> m [Handle]
 openDir (TempDirectory tmp) = do
   fs <- liftIO $ fmap (filter (flip notElem [".", ".."])) $ SD.getDirectoryContents tmp

diff --git a/test/Test/IO/Regiment/IO.hs b/test/Test/IO/Regiment/IO.hs
@@ -128,36 +128,42 @@ prop_regiment_split_merge =
     withTempDirectory "dist" "regiment-test." $ \tmp -> do
       chunkFiles <- mapM (writeToTmpFile tmp fmt) vrs
       inn <- writeToTmpFile tmp fmt $ concat vrs
-      success <- runEitherT $ regiment (InputFile inn)
-                                       (Just . OutputFile $ tmp </> "regiment-sorted")
-                                       sc
-                                       (formatKind fmt)
-                                       (formatNewline fmt)
-                                       (NumColumns (formatColumnCount fmt))
-                                       (formatSeparator fmt)
-                                       (MemoryLimit (1024 * 1024))
+      success <- runEitherT $
+        regiment (InputFile inn)
+                 (Just . OutputFile $ tmp </> "regiment-sorted")
+                 sc
+                 (formatKind fmt)
+                 (formatNewline fmt)
+                 (NumColumns (formatColumnCount fmt))
+                 (formatSeparator fmt)
+                 (MemoryLimit (1024 * 1024))
 
       case success of
         Left e ->
           return $ counterexample ("regiment errored out: " <> show e) False
         Right _ -> do
           splitSuccess <-
-            mapM (\nm -> runEitherT $
-                   splitToDir (InputFile nm)
-                              (TempDirectory $ tmp </> "splits" </> (takeBaseName nm))
-                              sc
-                              (formatKind fmt)
-                              (formatNewline fmt)
-                              (NumColumns (formatColumnCount fmt))
-                              (formatSeparator fmt)
-                              (MemoryLimit (1024 * 1024))) chunkFiles
+            mapM (\nm -> runEitherT $ do
+                   let tmpDir = TempDirectory $ tmp </> "splits" </> (takeBaseName nm)
+                   createDirectory tmpDir
+                   firstT RegimentIOParseError $
+                     split
+                      (InputFile nm)
+                      tmpDir
+                      sc
+                      (formatKind fmt)
+                      (formatNewline fmt)
+                      (NumColumns (formatColumnCount fmt))
+                      (formatSeparator fmt)
+                      (MemoryLimit (1024 * 1024))) chunkFiles
           case null $ lefts splitSuccess of
             False ->
               return $ counterexample ("split errored out " <> show splitSuccess) False
             True -> do
               mergeSuccess <-
-                runEitherT $ mergeDirs (fmap (\nm -> TempDirectory $ tmp </> "splits" </> (takeBaseName nm)) chunkFiles)
-                                       (Just . OutputFile $ tmp </> "regiment-split-merge")
+                runEitherT $
+                  mergeDirs (fmap (\nm -> TempDirectory $ tmp </> "splits" </> (takeBaseName nm)) chunkFiles)
+                            (Just . OutputFile $ tmp </> "regiment-split-merge")
               case mergeSuccess of
                 Left e ->
                   return $ counterexample ("merge errored out: " <> show e) False