diff --git a/.gitignore b/.gitignore index 31f7a94..3e6e0c9 100644 --- a/.gitignore +++ b/.gitignore @@ -5,6 +5,7 @@ !flake.lock !package.yaml !app/Main.hs +!doc/man/*.scd !src/CAStore/Command.hs !src/CAStore/Command/Autocomplete.hs !src/CAStore/Command/Type.hs diff --git a/doc/man/ca-store.1.scd b/doc/man/ca-store.1.scd new file mode 100644 index 0000000..4f210b8 --- /dev/null +++ b/doc/man/ca-store.1.scd @@ -0,0 +1,73 @@ +ca-store(1) + +# NAME + +ca-store - A simple content-addressable store with tagging support + +# SYNOPSIS + +*ca-store* [opts] store [command..] + +# OPTIONS + +## File commands + +*file* *add* [file..] + Adds the given files to the store and returns the ids of these files, + one per line. The ids will be returned in the same order that the files + are given on the command line. This command is idempotent. + + +*file* *remove* [id..] + Remove the files from the store. This command is permanent, so it is + recommended to make a backup of the file. Also consider making a copy + of its tags as well with the *tag* *show* command. + +*file* *verify* [id..] + Recalculate the ids of every id given to ensure they still match. Any + corrupted file will have its id printed to standard output. + +## Tag commands + +*tag* *add* id tag [tag..] + Add all of the given tags to the file referenced by 'id'. + +*tag* *remove* id tag [tag..] + Remove all the given tags from the file referenced by 'id'. No error + will be raised if you attempt to remove a non-existent tag. + +*tag* *show* id + Show all tags assigned to the file referenced by 'id'. No error will + be raised if you attempt to reference a non-existent file. + +*tag* *super* *add* supertag [subtag..] + Declare the first tag to be a supertag to all other given tags. A + supertag is a tag that is automatically implied by any of its subtags. + + A supertag cannot be a subtag of any of its subtags. *ca-store* will + silently ignore any attempt to make an infinite cycle of tags. + +*tag* *super* *remove* supertag [subtag..] + Remove the supertag relationship between the supertag and its subtags. + + If you wish for certain files to keep their supertags and not others, + manually add the supertag with the *tag* *add* command before running + *tag* *super* *remove*. + +*tag* *super* *show* supertag + Show all subtags of the given supertag. If the given tag isn't a + supertag then nothing will be displayed. + +*tag* *sub* *add* subtag [supertag..] + Declare the first tag to be a subtag to all other given tags. A subtag + is a tag that automatically implies any supertags. + + A subtag cannot be a supertag of any of its supertags. *ca-store* will + silently ignore any attempt to make an infinite cycle of tags. + +*tag* *sub* *remove* subtag [supertag..] + Remove the subtag relationship between the subtag and its supertags. + +*tag* *sub* *show* subtag + Show all supertags of the given subtag. If the given tag isn't a + subtag then nothing will be displayed. diff --git a/flake.nix b/flake.nix index 1d9afac..a91e448 100644 --- a/flake.nix +++ b/flake.nix @@ -17,11 +17,26 @@ ); overlays.default = final: prev: { - ca-store = final.haskellPackages.developPackage { + ca-store = prev.symlinkJoin { + pname = "ca-store"; + version = final.ca-store-bin.version; + paths = [ final.ca-store-bin final.ca-store-man ]; + }; + ca-store-bin = prev.haskellPackages.developPackage { root = ./.; name = "ca-store"; withHoogle = false; }; + ca-store-man = prev.stdenv.mkDerivation { + pname = "ca-store-man"; + version = "0.0.1"; + src = ./.; + nativeBuildInputs = [ final.scdoc final.installShellFiles ]; + buildCommand = '' + scdoc < "$src/doc/man/ca-store.1.scd" > ./ca-store.1 + installManPage ./ca-store.1 + ''; + }; }; }; } diff --git a/package.yaml b/package.yaml index 4a266ad..30f6112 100644 --- a/package.yaml +++ b/package.yaml @@ -57,7 +57,6 @@ library: - CAStore.Program.IO.Text - CAStore.Program.Storage - CAStore.Type - - CAStore.Type.Text - Data.List.Extra executables: diff --git a/src/CAStore/Command.hs b/src/CAStore/Command.hs index 9e2ea2d..debf4a3 100644 --- a/src/CAStore/Command.hs +++ b/src/CAStore/Command.hs @@ -10,8 +10,8 @@ import CAStore.Program (Program, storeFile, unstoreFile, getFileLocation) import CAStore.Program.IO import CAStore.Program.IO.Text import CAStore.Program.Storage -import CAStore.Type.Text -import Control.Monad (forM_) +import CAStore.Type +import Control.Monad (forM_, filterM, (<=<)) import Control.Monad.IO.Class (liftIO) import System.Directory (doesFileExist) @@ -23,15 +23,10 @@ runCommand (FileAdd fs) = do runCommand (FileRemove ss) = unregisterFiles ss *> forM_ ss unstoreFile -runCommand (FileVerify ss) = forM_ ss $ \sid -> do - file <- getFileLocation sid - liftIO (doesFileExist file) >>= \case - True -> do - sid' <- generateId file - case sid == sid' of - True -> msg $ MsgArb $ show sid ++ " is valid." - False -> err $ ErrArb $ show sid ++ " has been corrupted." - False -> err $ ErrArb $ show sid ++ " does not exist in the store." +runCommand (FileVerify ss) + = mapM_ (err . ErrCorruptStoreId) + <=< filterM (fmap not . verifyFile) + $ ss runCommand (TagAdd sid ts) = do registerTags ts assignTags sid ts @@ -53,3 +48,11 @@ runCommand (TagSuperShow sup) = do showRelationSuper sup runCommand (TagSubShow sub) = do showRelationSub sub + +-- | Recalculate the store id of a file and check to see if it matches. +verifyFile :: StoreId -> Program Bool +verifyFile sid = do + file <- getFileLocation sid + liftIO (doesFileExist file) >>= \case + True -> ((==) sid) <$> generateId file + False -> pure True diff --git a/src/CAStore/Command/Autocomplete.hs b/src/CAStore/Command/Autocomplete.hs index a3d190b..5b6e735 100644 --- a/src/CAStore/Command/Autocomplete.hs +++ b/src/CAStore/Command/Autocomplete.hs @@ -7,7 +7,7 @@ where import CAStore.Program.Internal (Program(..), getArguments, getConnectionHandle) import CAStore.Program.IO.Text (msg) -import CAStore.Type.Text (Message(MsgArb)) +import CAStore.Type (Message(MsgArb)) import Control.Monad.IO.Class (liftIO) import Data.Foldable (for_) import Database.SQLite.Simple (Query, query_, fromOnly) diff --git a/src/CAStore/Program/IO/Text.hs b/src/CAStore/Program/IO/Text.hs index 6386de5..2247f48 100644 --- a/src/CAStore/Program/IO/Text.hs +++ b/src/CAStore/Program/IO/Text.hs @@ -6,7 +6,7 @@ module CAStore.Program.IO.Text where import CAStore.Program.Internal (Program(..)) -import CAStore.Type.Text +import CAStore.Type import Control.Monad.IO.Class (liftIO) import Data.Foldable1 (intercalate1) import Data.List.NonEmpty (NonEmpty(..)) @@ -21,6 +21,8 @@ err (ErrInvalidCommand []) = display $ "ERROR: No command specified" err (ErrInvalidCommand (x:xs)) = display $ "ERROR: Invalid command '" ++ intercalate1 " " (x :| xs) ++ "'" +err (ErrCorruptStoreId (StoreId x)) + = display x warn :: Warning -> Program () warn (WarnArb x) = display $ "WARN: " ++ x diff --git a/src/CAStore/Type.hs b/src/CAStore/Type.hs index 865b9c0..d9dc252 100644 --- a/src/CAStore/Type.hs +++ b/src/CAStore/Type.hs @@ -10,7 +10,6 @@ module CAStore.Type ) where -import CAStore.Type.Text import Database.SQLite.Simple.FromField (FromField, fromField) import Database.SQLite.Simple.ToField (ToField, toField) @@ -47,3 +46,14 @@ parseStoreLocation x = pure $ StoreShort x data OutputType = OutputId | OutputFilename deriving (Show) + +data Error + = ErrArb String + | ErrInvalidCommand [String] + | ErrCorruptStoreId StoreId + +data Warning + = WarnArb String + +data Message + = MsgArb String diff --git a/src/CAStore/Type/Text.hs b/src/CAStore/Type/Text.hs deleted file mode 100644 index d8ffee9..0000000 --- a/src/CAStore/Type/Text.hs +++ /dev/null @@ -1,16 +0,0 @@ -module CAStore.Type.Text - ( Error(..) - , Warning(..) - , Message(..) - ) -where - -data Error - = ErrArb String - | ErrInvalidCommand [String] - -data Warning - = WarnArb String - -data Message - = MsgArb String