From a28a0f7640e44582868f48f72fc76dce1c5b3f9a Mon Sep 17 00:00:00 2001 From: Adrian Sieber Date: Sat, 23 Nov 2024 14:46:58 +0000 Subject: [PATCH] Format all code with Fourmolu --- Setup.hs | 2 + makefile | 5 ++ source/Correct.hs | 35 +++++++---- source/Home.hs | 9 ++- source/Lib.hs | 61 +++++++++++--------- source/Rename.hs | 125 ++++++++++++++++++++++++---------------- source/Types.hs | 2 +- source/Utils.hs | 63 ++++++++++---------- test/Spec.hs | 144 +++++++++++++++++++++++++++------------------- 9 files changed, 263 insertions(+), 183 deletions(-) diff --git a/Setup.hs b/Setup.hs index 9a994af..902b387 100755 --- a/Setup.hs +++ b/Setup.hs @@ -1,2 +1,4 @@ import Distribution.Simple + + main = defaultMain diff --git a/makefile b/makefile index 7bccf21..78cf458 100644 --- a/makefile +++ b/makefile @@ -3,6 +3,11 @@ help: makefile @tail -n +4 makefile | grep ".PHONY" +.PHONY: test +test: + stack test + + Perspec.app: ~/.local/bin/perspec imagemagick platypus \ --name Perspec \ diff --git a/source/Correct.hs b/source/Correct.hs index 0a91395..f3f8a70 100644 --- a/source/Correct.hs +++ b/source/Correct.hs @@ -1,33 +1,45 @@ -{-# language ApplicativeDo #-} -{-# language RecordWildCards #-} -{-# language NamedFieldPuns #-} -{-# language DataKinds #-} - module Correct where -import Protolude as P +import Protolude as P ( + Double, + Fractional ((/)), + Num (abs, negate, (*)), + RealFrac (round), + fromMaybe, + (.), + ) -- hip -import Graphics.Image hiding ((!)) +import Graphics.Image (Ix2 ((:.)), Sz (Sz), Sz2) -- hmatrix import Numeric.LinearAlgebra (linearSolve, linearSolveSVD, (!), (><)) -- lens -import Control.Lens hiding (transform) +import Control.Lens ((^.)) -- linear -import Linear +import Linear ( + Additive ((^+^), (^-^)), + M33, + R1 (_x), + R2 (_y), + R3 (_z), + R4 (_w), + V2 (..), + V3 (V3), + V4 (..), + ) determineSize :: V4 (V2 Double) -> Sz2 -determineSize (V4 c1 c2 c3 c4) = Sz ((round height) :. (round width)) +determineSize (V4 c1 c2 c3 c4) = Sz (round height :. round width) where diagonalA = c3 ^-^ c1 diagonalB = c4 ^-^ c2 V2 width height = (abs diagonalA ^+^ abs diagonalB) / 2 - +{- FOURMOLU_DISABLE -} -- /* Calculates coefficients of perspective transformation -- * which maps (xi,yi) to (ui,vi), (i=1,2,3,4): -- * @@ -81,3 +93,4 @@ calculatePerspectiveTransform s d = (V3 (m ! 0 ! 0) (m ! 1 ! 0) (m ! 2 ! 0)) (V3 (m ! 3 ! 0) (m ! 4 ! 0) (m ! 5 ! 0)) (V3 (m ! 6 ! 0) (m ! 7 ! 0) 1) +{- FOURMOLU_ENABLE -} diff --git a/source/Home.hs b/source/Home.hs index 7e79c1f..e24c915 100644 --- a/source/Home.hs +++ b/source/Home.hs @@ -11,16 +11,16 @@ import Protolude ( putText, ) -import Data.Text qualified as T import Brillo.Interface.IO.Game as Gl ( Event (..), Key (MouseButton), KeyState (Down), MouseButton (LeftButton), ) +import Data.Text qualified as T import TinyFileDialogs (openFileDialog) -import Types (AppState(..), View(..)) +import Types (AppState (..), View (..)) import Utils (isInRect, loadFileIntoState) @@ -50,10 +50,9 @@ handleMsg msg appState = case selectedFiles of Just [filePath] -> do - stateWithFile <- loadFileIntoState - appState{ currentView = ImageView } + loadFileIntoState + appState{currentView = ImageView} (T.unpack filePath) - pure stateWithFile Just _files -> do putText "Selecting several files is not supported yet!" -- TODO diff --git a/source/Lib.hs b/source/Lib.hs index 6873182..d631058 100755 --- a/source/Lib.hs +++ b/source/Lib.hs @@ -6,16 +6,16 @@ import Protolude ( Applicative (pure), Bool (..), Double, - Either(Left, Right), + Either (Left, Right), Eq ((==)), FilePath, Float, Floating (sqrt), Fractional ((/)), Functor (fmap), - Int, IO, IOException, + Int, Maybe (Just, Nothing), Monoid (mempty), Num ((*), (+), (-)), @@ -46,16 +46,9 @@ import Protolude ( ) import Protolude qualified as P -import Codec.BMP (parseBMP) -import Data.Aeson qualified as Aeson -import Data.ByteString.Lazy qualified as BL -import Data.FileEmbed (embedFile) -import Data.List as DL (elemIndex, minimum) -import Data.Text qualified as T -import Data.Text.Encoding qualified as TSE import Brillo ( Display (InWindow), - Picture ( Line, Pictures, Scale, ThickArc, ThickCircle, Translate ), + Picture (Line, Pictures, Scale, ThickArc, ThickCircle, Translate), Point, bitmapOfBMP, black, @@ -76,10 +69,17 @@ import Brillo.Interface.IO.Game as Gl ( SpecialKey (KeyEnter, KeyEsc), playIO, ) +import Codec.BMP (parseBMP) +import Data.Aeson qualified as Aeson +import Data.ByteString.Lazy qualified as BL +import Data.FileEmbed (embedFile) +import Data.List as DL (elemIndex, minimum) +import Data.Text qualified as T +import Data.Text.Encoding qualified as TSE import Home (handleHomeEvent) import System.Directory (getCurrentDirectory) import System.Environment (setEnv) -import System.FilePath ( replaceExtension, (), ) +import System.FilePath (replaceExtension, ()) import System.Info (os) import System.Process (callProcess, readProcessWithExitCode, spawnProcess) @@ -117,10 +117,14 @@ import Types ( initialState, ) import Utils ( - getWordSprite, calcInitWindowPos, + calcInitWindowPos, + calculateSizes, + getCorners, + getWordSprite, loadFileIntoState, - scalePoints, originTopLeft, getCorners, calculateSizes - ) + originTopLeft, + scalePoints, + ) -- | This is replaced with valid licenses during CI build @@ -233,9 +237,10 @@ appStateToWindow screenSize appState = do case appState.currentView of HomeView -> do - InWindow "Perspec - Select a file" appSize + InWindow + "Perspec - Select a file" + appSize (calcInitWindowPos screenSize appSize) - ImageView -> do case appState.inputPath of Nothing -> InWindow "SHOULD NOT BE POSSIBLE" (100, 100) (0, 0) @@ -249,7 +254,6 @@ appStateToWindow screenSize appState = do ) appSize (calcInitWindowPos screenSize appSize) - BannerView -> InWindow "Perspec - Banner" (800, 600) (10, 10) @@ -273,7 +277,6 @@ startApp appState = do makePicture handleEvent stepWorld - (_, _) -> do playIO (appStateToWindow screenSize appState) @@ -623,8 +626,10 @@ submitSelection appState exportMode = do exportMode if appState.transformApp == ImageMagick - then putText $ "Arguments for convert command:\n" - <> T.unlines convertArgs + then + putText $ + "Arguments for convert command:\n" + <> T.unlines convertArgs else putText $ "Write file to " <> show appState.outputPath correctAndWrite @@ -636,7 +641,6 @@ submitSelection appState exportMode = do convertArgs exitSuccess - (_, _) -> do P.die "Input path and output path must be set before submitting" @@ -819,7 +823,7 @@ correctAndWrite transformApp inPath outPath ((bl, _), (tl, _), (tr, _), (br, _)) argsNorm = ("magick" : args) <&> T.unpack successMessage = "✅ Successfully saved converted image at " - <> fixOutputPath exportMode outPath + <> fixOutputPath exportMode outPath -- TODO: Add CLI flag to switch between them case conversionMode of @@ -891,16 +895,17 @@ correctAndWrite transformApp inPath outPath ((bl, _), (tl, _), (tr, _), (br, _)) pure () + loadAndStart :: Config -> Maybe FilePath -> IO () -loadAndStart config filePathMb= do +loadAndStart config filePathMb = do let isRegistered = True -- (config&licenseKey) `elem` licenses stateDraft = - initialState - { transformApp = config.transformAppFlag - , isRegistered = isRegistered - , bannerIsVisible = not isRegistered - } + initialState + { transformApp = config.transformAppFlag + , isRegistered = isRegistered + , bannerIsVisible = not isRegistered + } case filePathMb of Nothing -> startApp stateDraft diff --git a/source/Rename.hs b/source/Rename.hs index 44c64bf..342ce1b 100644 --- a/source/Rename.hs +++ b/source/Rename.hs @@ -1,12 +1,35 @@ -module Rename where +{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} + +{-# HLINT ignore "Use list comprehension" #-} -import Protolude as P +module Rename where -import Algorithms.NaturalSort as NaturalSort +import Protolude as P ( + Bits ((.|.)), + Foldable (elem, length, null), + Int, + Maybe (..), + Num ((*), (+), (-)), + Ord ((<)), + Semigroup ((<>)), + Text, + filter, + fromMaybe, + isJust, + isNothing, + show, + sortBy, + zipWith, + ($), + (&), + (<&>), + ) + +import Algorithms.NaturalSort (compare) import Data.Text (pack, unpack) import System.FilePath (takeExtension) -import Types +import Types (RenameMode (..), SortOrder (..)) mapWithIndex :: Int -> RenameMode -> SortOrder -> (a -> Int -> b) -> [a] -> [b] @@ -15,10 +38,8 @@ mapWithIndex startNum renameMode sortOrder function elements = realStartNum = case (renameMode, sortOrder) of (Sequential, _) -> startNum - (Even, Ascending) -> ((startNum - 1) .|. 1) + 1 (Even, Descending) -> ((startNum + 1) .|. 1) - 1 - (Odd, Ascending) -> startNum .|. 1 (Odd, Descending) -> (startNum - 1) .|. 1 @@ -32,7 +53,7 @@ mapWithIndex startNum renameMode sortOrder function elements = (Odd, Descending) -> realStartNum - 2 mappings = - zipWith function elements [realStartNum, nextNum..] + zipWith function elements [realStartNum, nextNum ..] in mappings @@ -46,55 +67,63 @@ getRenamingBatches getRenamingBatches startNumberMb renameMode sortOrder files = let filesSorted :: [Text] - filesSorted = files - <&> unpack - & sortBy NaturalSort.compare - <&> pack + filesSorted = + files + <&> unpack + & sortBy Algorithms.NaturalSort.compare + <&> pack startNumber :: Int startNumber = case (startNumberMb, sortOrder, renameMode) of - (Just val, _, _) -> val - ( _, Ascending, _) -> 0 - ( _, Descending, Sequential) -> length files - 1 - ( _, Descending, Even) -> (length files * 2) - 2 - ( _, Descending, Odd) -> (length files * 2) - 1 + (Just val, _, _) -> val + (_, Ascending, _) -> 0 + (_, Descending, Sequential) -> length files - 1 + (_, Descending, Even) -> (length files * 2) - 2 + (_, Descending, Odd) -> (length files * 2) - 1 renamings :: [(Text, Text)] - renamings = filesSorted - & mapWithIndex startNumber renameMode sortOrder (\file index -> - ( file - , (if index < 0 then "_todo_" else "") - <> show index - <> (pack $ takeExtension $ unpack file) - ) - ) - - renamingsWithTemp :: [(Text, Maybe Text, Text)] - renamingsWithTemp = renamings - <&> (\(file, target) -> + renamings = + filesSorted + & mapWithIndex + startNumber + renameMode + sortOrder + ( \file index -> ( file - , if target `elem` files - then Just $ "_perspec_temp_" <> target - else Nothing - , target + , (if index < 0 then "_todo_" else "") + <> show index + <> pack (takeExtension $ unpack file) ) ) - renamingsBatch1 = renamingsWithTemp - <&> (\(file, tempTargetMb, target) -> - if tempTargetMb == Nothing - then (file, target) - else (file, fromMaybe "" tempTargetMb) - ) - - renamingsBatch2 = renamingsWithTemp - & filter (\(_, tempTargetMb, _) -> tempTargetMb /= Nothing) - <&> (\(_, tempTargetMb, target) -> (fromMaybe "" tempTargetMb, target)) - + renamingsWithTemp :: [(Text, Maybe Text, Text)] + renamingsWithTemp = + renamings + <&> ( \(file, target) -> + ( file + , if target `elem` files + then Just $ "_perspec_temp_" <> target + else Nothing + , target + ) + ) + + renamingsBatch1 = + renamingsWithTemp + <&> ( \(file, tempTargetMb, target) -> + if P.isNothing tempTargetMb + then (file, target) + else (file, fromMaybe "" tempTargetMb) + ) + + renamingsBatch2 = + renamingsWithTemp + & filter (\(_, tempTargetMb, _) -> P.isJust tempTargetMb) + <&> (\(_, tempTargetMb, target) -> (fromMaybe "" tempTargetMb, target)) in - [renamingsBatch1] <> ( - if null renamingsBatch2 - then [] - else [renamingsBatch2] - ) + [renamingsBatch1] + <> ( if null renamingsBatch2 + then [] + else [renamingsBatch2] + ) diff --git a/source/Types.hs b/source/Types.hs index efe46bd..75dbb63 100644 --- a/source/Types.hs +++ b/source/Types.hs @@ -17,6 +17,7 @@ import Protolude as P ( ($), ) +import Brillo (Picture (Blank), Point) import Data.Aeson ( FromJSON (parseJSON), withObject, @@ -25,7 +26,6 @@ import Data.Aeson ( (.:), (.:?), ) -import Brillo (Picture (Blank), Point) data Config = Config diff --git a/source/Utils.hs b/source/Utils.hs index b7e0794..3bee60b 100644 --- a/source/Utils.hs +++ b/source/Utils.hs @@ -1,57 +1,59 @@ +{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} + +{-# HLINT ignore "Use maybe" #-} module Utils where import Protolude ( Bool (..), ByteString, + Either (..), + FilePath, Float, + IO, + Int, Maybe (Just, Nothing), Monad ((>>=)), Monoid (mempty), Text, - Int, - Either(..), - IO, - FilePath, const, - fromIntegral, - swap, either, + fmap, + fromIntegral, fromMaybe, - (&&), - (<=), - (+), min, + pure, + putText, + round, + show, + swap, + ($), + (&), + (&&), (*), - fmap, + (+), (-), - round, (/), + (<&>), + (<=), (<>), (>=), - putText, - pure, - show, - (<&>), - ($), - (&) ) import Protolude qualified as P -import Codec.Picture.Metadata (Keys (Exif), Metadatas, lookup) -import Codec.Picture.Metadata.Exif (ExifData (ExifShort), ExifTag (..)) -import Data.Text qualified as T -import Codec.Picture (decodePng) -import Data.FileEmbed (embedFile) import Brillo ( - Picture (Bitmap, BitmapSection), + BitmapData (bitmapSize), + Picture (Bitmap, BitmapSection, Rotate), Point, Rectangle (Rectangle, rectPos, rectSize), - BitmapData (bitmapSize), Picture ( Rotate), ) import Brillo.Juicy (fromDynamicImage, loadJuicyWithMetadata) -import System.FilePath ( replaceBaseName, takeBaseName, ) -import Types (AppState(..), View(..)) -import System.FilePath (takeExtension) +import Codec.Picture (decodePng) +import Codec.Picture.Metadata (Keys (Exif), Metadatas, lookup) +import Codec.Picture.Metadata.Exif (ExifData (ExifShort), ExifTag (..)) +import Data.FileEmbed (embedFile) +import Data.Text qualified as T +import System.FilePath (replaceBaseName, takeBaseName, takeExtension) +import Types (AppState (..), View (..)) wordsSprite :: ByteString @@ -115,7 +117,6 @@ calcInitWindowPos (screenWidth, screenHeight) (appWidth, appHeight) = do (round initialX, round initialY) - -- | Transform from origin in center to origin in top left originTopLeft :: Int -> Int -> [Point] -> [Point] originTopLeft width height = @@ -126,6 +127,7 @@ originTopLeft width height = ) ) + scalePoints :: Float -> [Point] -> [Point] scalePoints scaleFac = fmap $ \(x, y) -> (x / scaleFac, y / scaleFac) @@ -166,7 +168,6 @@ calculateSizes appState = } - imgOrientToRot :: ExifData -> Float imgOrientToRot = \case ExifShort 6 -> -90 @@ -209,6 +210,7 @@ loadImage filePath = do Just (picture, metadata) -> pure $ Right (picture, metadata) + loadFileIntoState :: AppState -> FilePath -> IO AppState loadFileIntoState appState filePath = do pictureMetadataEither <- loadImage filePath @@ -237,7 +239,7 @@ loadFileIntoState appState filePath = do , imgHeightOrig = imgHgt , rotation = rotation , image = Rotate (-rotation) picture - , inputPath = Just $ filePath + , inputPath = Just filePath , outputPath = Just $ getOutPath filePath } @@ -247,7 +249,6 @@ loadFileIntoState appState filePath = do "with a rotation of " <> show rotation <> " degrees." pure stateWithSizes - Right _ -> do putText $ "Error: Loaded file is not a Bitmap image. " diff --git a/test/Spec.hs b/test/Spec.hs index adbd6dd..b84d325 100755 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,13 +1,30 @@ -import Test.Hspec - -import Protolude +import Test.Hspec ( + describe, + expectationFailure, + hspec, + it, + pendingWith, + shouldBe, + shouldContain, + ) + +import Protolude ( + Either (Right), + IO, + Maybe (Just, Nothing), + show, + ($), + ) import Brillo.Data.Bitmap (bitmapSize) -import Brillo.Data.Picture (Picture(Bitmap)) +import Brillo.Data.Picture (Picture (Bitmap)) -import Lib -import Rename -import Types +import Rename (getRenamingBatches) +import Types ( + RenameMode (Even, Odd, Sequential), + SortOrder (Ascending, Descending), + ) +import Utils (loadImage) main :: IO () @@ -18,8 +35,8 @@ main = hspec $ do pictureMetadataEither <- loadImage "images/doc_rotated.jpg" case pictureMetadataEither of - Right ((Bitmap bitmapData), metadata) -> do - bitmapSize bitmapData `shouldBe` (880 , 1500) + Right (Bitmap bitmapData, metadata) -> do + bitmapSize bitmapData `shouldBe` (880, 1500) -- Does not provide an Eq instance => Misuse show let metadataText = show metadata @@ -27,38 +44,38 @@ main = hspec $ do metadataText `shouldContain` "TagOrientation :=> ExifShort 6" metadataText `shouldContain` "(TagUnknown 40962) :=> ExifLong 880" metadataText `shouldContain` "(TagUnknown 40963) :=> ExifLong 1500" - _ -> expectationFailure "File should have been loaded" it "Applies EXIF rotation to PNGs" $ do pictureMetadataEither <- loadImage "images/rotated.png" case pictureMetadataEither of - Right ((Bitmap bitmapData), {- metadata -} _) -> do - bitmapSize bitmapData `shouldBe` (1800,1280) + Right (Bitmap bitmapData {- metadata -}, _) -> do + bitmapSize bitmapData `shouldBe` (1800, 1280) pendingWith "Needs to be implemented upstream in Juicy.Pixels first" - -- https://github.com/Twinside/Juicy.Pixels/issues/204 - -- or in hsexif: https://github.com/emmanueltouzery/hsexif/issues/19 + -- https://github.com/Twinside/Juicy.Pixels/issues/204 + -- or in hsexif: https://github.com/emmanueltouzery/hsexif/issues/19 _ -> expectationFailure "File should have been loaded" - describe "Rename" $ do it "renames files according to natural sort and avoids collisions" $ do let files = ["1.txt", "10.txt", "2.txt"] batches = - [ [ ("1.txt","0.txt") + [ + [ ("1.txt", "0.txt") , ("2.txt", "_perspec_temp_1.txt") - , ("10.txt","_perspec_temp_2.txt") + , ("10.txt", "_perspec_temp_2.txt") ] - , [ ("_perspec_temp_1.txt", "1.txt") - , ("_perspec_temp_2.txt","2.txt") + , + [ ("_perspec_temp_1.txt", "1.txt") + , ("_perspec_temp_2.txt", "2.txt") ] ] - (getRenamingBatches Nothing Sequential Ascending files) + getRenamingBatches Nothing Sequential Ascending files `shouldBe` batches describe "Renaming files in descending order" $ do @@ -66,126 +83,135 @@ main = hspec $ do let files = ["1.txt", "10.txt", "2.txt"] batches = - [ [ ("1.txt","_perspec_temp_2.txt") + [ + [ ("1.txt", "_perspec_temp_2.txt") , ("2.txt", "_perspec_temp_1.txt") - , ("10.txt","0.txt") + , ("10.txt", "0.txt") ] - , [ ("_perspec_temp_2.txt","2.txt") + , + [ ("_perspec_temp_2.txt", "2.txt") , ("_perspec_temp_1.txt", "1.txt") ] ] - (getRenamingBatches Nothing Sequential Descending files) + getRenamingBatches Nothing Sequential Descending files `shouldBe` batches it "allows explicitly setting first page number" $ do let files = ["1.txt", "10.txt", "2.txt"] batches = - [ [ ("1.txt","_perspec_temp_2.txt") + [ + [ ("1.txt", "_perspec_temp_2.txt") , ("2.txt", "_perspec_temp_1.txt") - , ("10.txt","0.txt") + , ("10.txt", "0.txt") ] - , [ ("_perspec_temp_2.txt","2.txt") + , + [ ("_perspec_temp_2.txt", "2.txt") , ("_perspec_temp_1.txt", "1.txt") ] ] - (getRenamingBatches (Just 2) Sequential Descending files) + getRenamingBatches (Just 2) Sequential Descending files `shouldBe` batches - describe "Renaming files with even page numbers" $ do let - files = ["a.txt", "c.txt", "e.txt"] - batchesStartingZero = - [ [ ("a.txt","0.txt") - , ("c.txt", "2.txt") - , ("e.txt","4.txt") - ] + files = ["a.txt", "c.txt", "e.txt"] + batchesStartingZero = + [ + [ ("a.txt", "0.txt") + , ("c.txt", "2.txt") + , ("e.txt", "4.txt") ] + ] it "automatically sets first page number" $ do - (getRenamingBatches Nothing Even Ascending files) + getRenamingBatches Nothing Even Ascending files `shouldBe` batchesStartingZero it "automatically sets first page number with descending order" $ do let numericFiles = ["8.txt", "10.txt", "9.txt"] batches = - [ [ ("8.txt","4.txt") + [ + [ ("8.txt", "4.txt") , ("9.txt", "2.txt") - , ("10.txt","0.txt") + , ("10.txt", "0.txt") ] ] - (getRenamingBatches Nothing Even Descending numericFiles) + getRenamingBatches Nothing Even Descending numericFiles `shouldBe` batches it "allows explicitly setting first page number" $ do - (getRenamingBatches (Just 0) Even Ascending files) + getRenamingBatches (Just 0) Even Ascending files `shouldBe` batchesStartingZero it "rounds to next even page number" $ do let batches = - [ [ ("a.txt","2.txt") + [ + [ ("a.txt", "2.txt") , ("c.txt", "4.txt") - , ("e.txt","6.txt") + , ("e.txt", "6.txt") ] ] - (getRenamingBatches (Just 1) Even Ascending files) + getRenamingBatches (Just 1) Even Ascending files `shouldBe` batches - describe "Renaming files with odd page numbers" $ do it "correctly sets first page number" $ do let files = ["b.txt", "d.txt", "f.txt"] batches = - [ [ ("b.txt","1.txt") + [ + [ ("b.txt", "1.txt") , ("d.txt", "3.txt") - , ("f.txt","5.txt") + , ("f.txt", "5.txt") ] ] - (getRenamingBatches Nothing Odd Ascending files) `shouldBe` batches - (getRenamingBatches (Just 0) Odd Ascending files) `shouldBe` batches - (getRenamingBatches (Just 1) Odd Ascending files) `shouldBe` batches + getRenamingBatches Nothing Odd Ascending files `shouldBe` batches + getRenamingBatches (Just 0) Odd Ascending files `shouldBe` batches + getRenamingBatches (Just 1) Odd Ascending files `shouldBe` batches it "works with descending order and automatically sets page number" $ do let files = ["8.txt", "10.txt", "9.txt"] batches = - [ [ ("8.txt","5.txt") + [ + [ ("8.txt", "5.txt") , ("9.txt", "3.txt") - , ("10.txt","1.txt") + , ("10.txt", "1.txt") ] ] - (getRenamingBatches Nothing Odd Descending files) `shouldBe` batches + getRenamingBatches Nothing Odd Descending files `shouldBe` batches it "works with descending order and explicit page number" $ do let files = ["8.txt", "10.txt", "9.txt"] batches = - [ [ ("8.txt","7.txt") + [ + [ ("8.txt", "7.txt") , ("9.txt", "5.txt") - , ("10.txt","3.txt") + , ("10.txt", "3.txt") ] ] - (getRenamingBatches (Just 7) Odd Descending files) `shouldBe` batches - (getRenamingBatches (Just 8) Odd Descending files) `shouldBe` batches + getRenamingBatches (Just 7) Odd Descending files `shouldBe` batches + getRenamingBatches (Just 8) Odd Descending files `shouldBe` batches it "prefixes pages with negative numbers with \"_todo_\"" $ do let files = ["8.txt", "10.txt", "9.txt"] batches = - [ [ ("8.txt","1.txt") + [ + [ ("8.txt", "1.txt") , ("9.txt", "_todo_-1.txt") - , ("10.txt","_todo_-3.txt") + , ("10.txt", "_todo_-3.txt") ] ] - (getRenamingBatches (Just 1) Odd Descending files) `shouldBe` batches + getRenamingBatches (Just 1) Odd Descending files `shouldBe` batches