Skip to content

Commit

Permalink
feature: add multiple actions per files
Browse files Browse the repository at this point in the history
  • Loading branch information
@blackheaven
blackheaven committed Mar 7, 2024
1 parent a47e52b commit c54d7e0
Show file tree
Hide file tree
Showing 2 changed files with 43 additions and 30 deletions.
12 changes: 7 additions & 5 deletions src/Librarian.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -26,9 +26,11 @@ where

import Control.Exception (catch)
import Control.Monad
import Data.Foldable (Foldable (toList))
import Data.Functor (($>), (<&>))
import qualified Data.Map.Strict as Map
import Data.Maybe (catMaybes, mapMaybe)
import Data.Sequence (Seq)
import Data.String (IsString)
import Dhall (FromDhall)
import GHC.Generics (Generic)
Expand Down Expand Up @@ -64,15 +66,15 @@ data Action

instance FromDhall Action

type CollectedFiles = Map.Map FilePath Rule
type CollectedFiles = Map.Map FilePath (Seq Rule)

fetchRulesOn :: FilePath -> [Rule] -> IO CollectedFiles
fetchRulesOn root rules = do
matches <- globDir (compile . matchPattern . match <$> rules) root
let distributeRule :: [FilePath] -> Rule -> [(FilePath, Rule)]
distributeRule fs r = map (\f -> (f, r)) fs
let distributeRule :: [FilePath] -> Rule -> [(FilePath, Seq Rule)]
distributeRule fs r = map (\f -> (f, [r])) fs
files <- mapM (filterM doesFileExist) matches
return $ Map.unions $ map Map.fromList $ zipWith distributeRule files rules
return $ Map.unionsWith (<>) $ map Map.fromList $ zipWith distributeRule files rules

data ResolvedAction
= ResolvedMove {original :: FilePath, new :: FilePath, rule :: Rule}
Expand All @@ -81,7 +83,7 @@ data ResolvedAction
deriving stock (Eq, Show, Generic)

planActions :: CollectedFiles -> [ResolvedAction]
planActions = concatMap (take 1 . uncurry planAction) . Map.toList
planActions = concatMap (take 1 . uncurry planAction) . concatMap (traverse toList) . Map.toList
where
planAction :: FilePath -> Rule -> [ResolvedAction]
planAction p rule = mapMaybe go $ actions rule
Expand Down
61 changes: 36 additions & 25 deletions test/LibrarianSpec.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -26,58 +26,64 @@ spec = do
`shouldReturn` mempty
it "Text files only should match only all rule" $
withFiles ["in/sub/0.txt", "in/1.txt"] (fetchRulesOn "." moveRules)
`shouldReturn` Map.fromList [("./in/sub/0.txt", moveRule1Any), ("./in/1.txt", moveRule1Any)]
it "Text/images files should match by priority" $
`shouldReturn` Map.fromList [("./in/sub/0.txt", [moveRule1Any]), ("./in/1.txt", [moveRule1Any])]
it "Text/images files should match twice" $
withFiles ["in/sub/0.jpg", "in/1.txt"] (fetchRulesOn "." moveRules)
`shouldReturn` Map.fromList [("./in/sub/0.jpg", moveRule0Jpg), ("./in/1.txt", moveRule1Any)]
`shouldReturn` Map.fromList [("./in/sub/0.jpg", [moveRule0Jpg, moveRule1Any]), ("./in/1.txt", [moveRule1Any])]
describe "copy" $ do
it "Empty target directory should be empty" $
withFiles [] (fetchRulesOn "." copyRules)
`shouldReturn` mempty
it "Text files only should match only all rule" $
withFiles ["in/sub/0.txt", "in/1.txt"] (fetchRulesOn "." copyRules)
`shouldReturn` Map.fromList [("./in/sub/0.txt", copyRule1Any), ("./in/1.txt", copyRule1Any)]
it "Text/images files should match by priority" $
`shouldReturn` Map.fromList [("./in/sub/0.txt", [copyRule1Any]), ("./in/1.txt", [copyRule1Any])]
it "Text/images files should match twice" $
withFiles ["in/sub/0.jpg", "in/1.txt"] (fetchRulesOn "." copyRules)
`shouldReturn` Map.fromList [("./in/sub/0.jpg", copyRule0Jpg), ("./in/1.txt", copyRule1Any)]
`shouldReturn` Map.fromList [("./in/sub/0.jpg", [copyRule0Jpg, copyRule1Any]), ("./in/1.txt", [copyRule1Any])]
describe "remove" $ do
it "Empty target directory should be empty" $
withFiles [] (fetchRulesOn "." removeRules)
`shouldReturn` mempty
it "Text files only should match only all rule" $
withFiles ["in/sub/0.txt", "in/1.txt"] (fetchRulesOn "." removeRules)
`shouldReturn` Map.fromList [("./in/sub/0.txt", removeRule1Any), ("./in/1.txt", removeRule1Any)]
it "Text/images files should match by priority" $
`shouldReturn` Map.fromList [("./in/sub/0.txt", [removeRule1Any]), ("./in/1.txt", [removeRule1Any])]
it "Text/images files should match twice" $
withFiles ["in/sub/0.jpg", "in/1.txt"] (fetchRulesOn "." removeRules)
`shouldReturn` Map.fromList [("./in/sub/0.jpg", removeRule0Jpg), ("./in/1.txt", removeRule1Any)]
`shouldReturn` Map.fromList [("./in/sub/0.jpg", [removeRule0Jpg, removeRule1Any]), ("./in/1.txt", [removeRule1Any])]
describe "planActions" $ do
describe "move" $ do
it "Images should be moved, texts should have their extension changed" $
planActions (Map.fromList [("./in/sub/0.jpg", moveRule0Jpg), ("./in/1.txt", moveRule1Any)])
planActions (Map.fromList [("./in/sub/0.jpg", [moveRule0Jpg]), ("./in/1.txt", [moveRule1Any])])
`shouldBe` [ ResolvedMove "./in/1.txt" "./in/1.TXT" moveRule1Any,
ResolvedMove "./in/sub/0.jpg" "out/pics/0.jpg" moveRule0Jpg
]
it "Non-matching action should be nothing" $
planActions (Map.fromList [("./in/1.png", moveRule1Any)])
planActions (Map.fromList [("./in/1.png", [moveRule1Any])])
`shouldBe` []
describe "copy" $ do
it "Images should be copyd, texts should have their extension changed" $
planActions (Map.fromList [("./in/sub/0.jpg", copyRule0Jpg), ("./in/1.txt", copyRule1Any)])
planActions (Map.fromList [("./in/sub/0.jpg", [copyRule0Jpg]), ("./in/1.txt", [copyRule1Any])])
`shouldBe` [ ResolvedCopy "./in/1.txt" "./in/1.TXT" copyRule1Any,
ResolvedCopy "./in/sub/0.jpg" "out/pics/0.jpg" copyRule0Jpg
]
it "Non-matching action should be nothing" $
planActions (Map.fromList [("./in/1.png", copyRule1Any)])
planActions (Map.fromList [("./in/1.png", [copyRule1Any])])
`shouldBe` []
describe "remove" $ do
it "Images should be removed, texts should have their extension changed" $
planActions (Map.fromList [("./in/sub/0.jpg", removeRule0Jpg), ("./in/1.txt", removeRule1Any)])
it "Images should be removed" $
planActions (Map.fromList [("./in/sub/0.jpg", [removeRule0Jpg]), ("./in/1.txt", [removeRule1Any])])
`shouldBe` [ ResolvedRemove "./in/1.txt" removeRule1Any,
ResolvedRemove "./in/sub/0.jpg" removeRule0Jpg
]
it "Non-matching action should be nothing" $
planActions (Map.fromList [("./in/1.png", removeRule1Any)])
planActions (Map.fromList [("./in/1.png", [removeRule1Any])])
`shouldBe` []
describe "mixed" $ do
it "Images should be copied and removed, texts should have their extension changed" $
planActions (Map.fromList [("./in/sub/0.jpg", [copyRule0Jpg, removeRule0Jpg])])
`shouldBe` [ ResolvedCopy "./in/sub/0.jpg" "out/pics/0.jpg" copyRule0Jpg,
ResolvedRemove "./in/sub/0.jpg" removeRule0Jpg
]
describe "runPlan" $ do
describe "move" $ do
let moveAll = fetchRulesOn "." [moveAllTxtRule] >>= runPlan . planActions
Expand Down Expand Up @@ -109,6 +115,11 @@ spec = do
it "Should keep the non-matching file" $
withFiles ["in/0.txt", "in/sub/0.txt", "in/0.jpg"] (removeAll >> listFiles)
`shouldReturn` ["./in/0.jpg"]
describe "mixed" $ do
let mixed = fetchRulesOn "." [copyAllTxtRule, removeAllTxtRule] >>= runPlan . planActions
it "Should copy and delete" $
withFiles ["in/0.txt"] (mixed >> listFiles)
`shouldReturn` ["./out/0.txt"]

-- * Utils

Expand Down Expand Up @@ -137,23 +148,23 @@ moveRules = [moveRule0Jpg, moveRule1Any]
moveRule0Jpg :: Rule
moveRule0Jpg =
Rule
{ name = "Image files",
{ name = "Image files (move)",
match = "**/*.jpg",
actions = [Move "^.*/([^\\/]+)$" "out/pics/\\1"]
}

moveRule1Any :: Rule
moveRule1Any =
Rule
{ name = "All files",
{ name = "All files (move)",
match = "**/*",
actions = [Move "pdf$" "PDF", Move "txt$" "TXT", Move "txt$" "TxT"]
}

moveAllTxtRule :: Rule
moveAllTxtRule =
Rule
{ name = "Text files",
{ name = "Text files (move)",
match = "**/*.txt",
actions = [Move "^.*/([^\\/]+)$" "out/\\1"]
}
Expand All @@ -166,23 +177,23 @@ copyRules = [copyRule0Jpg, copyRule1Any]
copyRule0Jpg :: Rule
copyRule0Jpg =
Rule
{ name = "Image files",
{ name = "Image files (copy)",
match = "**/*.jpg",
actions = [Copy "^.*/([^\\/]+)$" "out/pics/\\1"]
}

copyRule1Any :: Rule
copyRule1Any =
Rule
{ name = "All files",
{ name = "All files (copy)",
match = "**/*",
actions = [Copy "pdf$" "PDF", Copy "txt$" "TXT", Copy "txt$" "TxT"]
}

copyAllTxtRule :: Rule
copyAllTxtRule =
Rule
{ name = "Text files",
{ name = "Text files (copy)",
match = "**/*.txt",
actions = [Copy "^.*/([^\\/]+)$" "out/\\1"]
}
Expand All @@ -195,23 +206,23 @@ removeRules = [removeRule0Jpg, removeRule1Any]
removeRule0Jpg :: Rule
removeRule0Jpg =
Rule
{ name = "Image files",
{ name = "Image files (remove)",
match = "**/*.jpg",
actions = [Remove "^.*/([^\\/]+)$"]
}

removeRule1Any :: Rule
removeRule1Any =
Rule
{ name = "All files",
{ name = "All files (remove)",
match = "**/*",
actions = [Remove "pdf$", Remove "txt$", Remove "txt$"]
}

removeAllTxtRule :: Rule
removeAllTxtRule =
Rule
{ name = "Text files",
{ name = "Text files (remove)",
match = "**/*.txt",
actions = [Remove "^.*/([^\\/]+)$"]
}

0 comments on commit c54d7e0

Please sign in to comment.