diff --git a/app/Main.hs b/app/Main.hs index a004ba9b..0fb30b6b 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -29,6 +29,7 @@ import Config (configCodec, Config (..)) import Entry (path, Entry) import System.Environment (lookupEnv) import Data.Maybe (fromMaybe) +import Text.Interpolation.Nyan runBackendIO :: Sem '[BackendEffect, Error CofferError, Embed IO, Final IO ] a @@ -76,41 +77,50 @@ main = do VREntry entry -> pprint $ buildDirectory $ Dir.singleton entry VRField _ field -> pprint $ build $ field ^. E.value VRPathNotFound path -> pathNotFound path - VRDirectoryNoFieldMatch path fieldName -> printError $ - "There are no entries at path '" +| path |+ "' with the field '" +| fieldName |+ "'." - VREntryNoFieldMatch path fieldName -> printError $ - "The entry at '" +| path |+ "' does not have a field '" +| fieldName |+ "'." + VRDirectoryNoFieldMatch path fieldName -> printError [int|s| + There are no entries at path '#{path}' with the field '#{fieldName}'. + |] + + VREntryNoFieldMatch path fieldName -> printError [int|s| + The entry at '#{path}' does not have a field '#{fieldName}'. + |] SomeCommand cmd@(CmdCreate opts) -> do runCommand config cmd >>= \case - CRSuccess _ -> printSuccess $ "Entry created at '" +| coQPath opts |+ "'." + CRSuccess _ -> printSuccess [int|s|Entry created at '#{coQPath opts}'.|] CRCreateError error -> do let errorMsg = createErrorToBuilder error - printError $ unlinesF @_ @Builder $ "The entry cannot be created:" : "" : [errorMsg] + printError [int|s| + The entry cannot be created: + + #{errorMsg} + |] SomeCommand cmd@(CmdSetField opts) -> do let fieldName = sfoFieldName opts runCommand config cmd >>= \case SFREntryNotFound path -> entryNotFound path - SFRMissingFieldContents path -> printError $ unlinesF @_ @Builder - [ "The entry at '" +| path |+ "' does not yet have a field '" +| fieldName |+ "'." - , "In order to create a new field, please include the 'FIELDCONTENTS' argument." - ] + SFRMissingFieldContents path -> printError [int|s| + The entry at '#{path}' does not yet have a field '#{fieldName}'. + In order to create a new field, please include the 'FIELDCONTENTS' argument. + |] SFRSuccess entry -> do let field = entry ^?! E.fields . ix fieldName - printSuccess $ - "Set field '" +| fieldName |+ - "' (" +| (field ^. E.visibility) |+ - ") at '" +| entry ^. E.path |+ - "' to:\n" +| (field ^. E.value) |+ "" + printSuccess [int|s| + Set field '#{fieldName}' (#{field ^. E.visibility}) \ + at '#{entry ^. E.path}' to: + #{field ^. E.value} + |] SomeCommand cmd@(CmdDeleteField opts) -> do runCommand config cmd >>= \case DFREntryNotFound path -> entryNotFound path - DFRFieldNotFound fieldName -> printError $ - "Entry does not have a field with name '" +| fieldName |+ "'." - DFRSuccess _ -> printSuccess $ - "Deleted field '" +| dfoFieldName opts |+ "' from '" +| dfoQPath opts |+ "'." + DFRFieldNotFound fieldName -> printError [int|s| + Entry does not have a field with name '#{fieldName}'. + |] + DFRSuccess _ -> printSuccess [int|s| + Deleted field '#{dfoFieldName opts}' from '#{dfoQPath opts}'. + |] SomeCommand cmd@CmdFind{} -> do runCommand config cmd >>= \case @@ -123,13 +133,17 @@ main = do when (roDryRun opts) do pprint "These actions would be done:" forM_ copiedPaths \(from, to) -> - printSuccess $ "Renamed '" +| from |+ "' to '" +| to |+ "'." + printSuccess [int|s|Renamed '#{from}' to '#{to}'.|] CPRPathNotFound path -> pathNotFound path CPRMissingEntryName -> printError "The destination path is not a valid entry path. Please specify the new name of the entry." CPRCreateErrors errors -> do errorMsgs <- buildErrorMessages errors - printError $ unlinesF @_ @Builder $ "The following entries cannot be renamed:" : "" : errorMsgs + printError [int|s| + The following entries cannot be renamed: + + #{unlinesF errorMsgs} + |] SomeCommand cmd@(CmdCopy opts) -> do runCommand config cmd >>= \case @@ -137,38 +151,42 @@ main = do when (cpoDryRun opts) do pprint "These actions would be done:" forM_ copiedPaths \(from, to) -> - printSuccess $ "Copied '" +| from |+ "' to '" +| to |+ "'." + printSuccess [int|s|Copied '#{from}' to '#{to}'.|] CPRPathNotFound path -> pathNotFound path CPRMissingEntryName -> printError "The destination path is not a valid entry path. Please specify the new name of the entry." CPRCreateErrors errors -> do errorMsgs <- buildErrorMessages errors - printError $ unlinesF @_ @Builder $ "The following entries cannot be copied:" : "" : errorMsgs + printError [int|s| + The following entries cannot be copied: + + #{unlinesF errorMsgs} + |] SomeCommand cmd@(CmdDelete opts) -> do runCommand config cmd >>= \case DRPathNotFound path -> pathNotFound path - DRDirectoryFound path -> printError $ unlinesF @_ @Builder - [ "The path '" +| path |+ "' is a directory." - , "Use '--recursive' or '-r' to recursively delete all entries." - ] + DRDirectoryFound path -> printError [int|s| + The path '#{path}' is a directory. + Use '--recursive' or '-r' to recursively delete all entries. + |] DRSuccess paths -> do when (doDryRun opts) do pprint "These actions would be done:" forM_ paths \path -> - printSuccess $ "Deleted '" +| path |+ "'." + printSuccess [int|s|Deleted '#{path}'.|] SomeCommand cmd@(CmdTag opts) -> do runCommand config cmd >>= \case TREntryNotFound path -> entryNotFound path TRSuccess _ -> if toDelete opts - then printSuccess $ "Removed tag '" +| toTagName opts |+ "' from '" +| toQPath opts |+ "'." - else printSuccess $ "Added tag '" +| toTagName opts |+ "' to '" +| toQPath opts |+ "'." - TRTagNotFound tag -> printError $ - "Entry does not have the tag '" +| tag |+ "'." - TRDuplicateTag tag -> printError $ - "Entry already has the tag '" +| tag |+ "'." + then printSuccess [int|s|Removed tag '#{toTagName opts}' from '#{toQPath opts}'.|] + else printSuccess [int|s|Added tag '#{toTagName opts}' to '#{toQPath opts}'.|] + TRTagNotFound tag -> printError + [int|s|Entry does not have the tag '#{tag}'.|] + TRDuplicateTag tag -> printError + [int|s|Entry already has the tag '#{tag}'.|] where -- | Pretty-print a message. pprint :: Member (Embed IO) r => Builder -> Sem r () @@ -183,20 +201,20 @@ main = do printError msg = embed $ die $ "[ERROR] " <> fmt msg entryNotFound :: Member (Embed IO) r => EntryPath -> Sem r () - entryNotFound path = printError $ "Entry not found at '" +| path |+ "'." + entryNotFound path = printError [int|s|Entry not found at '#{path}'.|] pathNotFound :: Member (Embed IO) r => Path -> Sem r () - pathNotFound path = printError $ "Entry or directory not found at '" +| path |+ "'." + pathNotFound path = printError [int|s|Entry or directory not found at '#{path}'.|] createErrorToBuilder :: CreateError -> Builder createErrorToBuilder = \case - CEEntryAlreadyExists entryTo -> unlinesF @_ @Builder - [ "An entry already exists at '" +| entryTo ^. path |+ "'." - , "Use '--force' or '-f' to overwrite existing entries." - ] - CEDestinationIsDirectory entryTo -> "'" +| entryTo ^. path |+ "' is a directory." + CEEntryAlreadyExists entryTo -> [int|s| + An entry already exists at '#{entryTo ^. path}'. + Use '--force' or '-f' to overwrite existing entries. + |] + CEDestinationIsDirectory entryTo -> [int|s|'#{entryTo ^. path}' is a directory.|] CEParentDirectoryIsEntry (_, clashed) -> - "Attempted to create the directory '" +| clashed |+ "' but an entry exists at that path." + [int|s|Attempted to create the directory '#{clashed}' but an entry exists at that path.|] getEntryFromCreateError :: CreateError -> Entry getEntryFromCreateError = \case @@ -208,6 +226,6 @@ main = do buildErrorMessages errors = do forM errors \(from, err) -> do let entryTo = getEntryFromCreateError err - let header = "'" +| from |+ "' to '" +| entryTo ^. path |+ "':" + let header = [int|s|'#{from}' to '#{entryTo ^. path}':|] let errorMsg = createErrorToBuilder err pure $ unlinesF @_ @Builder $ header : [indentF 2 errorMsg] diff --git a/coffer.cabal b/coffer.cabal index 5fa92c39..e9abb693 100644 --- a/coffer.cabal +++ b/coffer.cabal @@ -179,6 +179,7 @@ executable coffer , coffer , fmt , lens + , nyan-interpolation , optparse-applicative , polysemy , text diff --git a/package.yaml b/package.yaml index 63c29204..764223d1 100644 --- a/package.yaml +++ b/package.yaml @@ -120,6 +120,7 @@ executables: - coffer - fmt - lens + - nyan-interpolation - optparse-applicative - polysemy - text diff --git a/stack.yaml b/stack.yaml index 734e7142..6c34eead 100644 --- a/stack.yaml +++ b/stack.yaml @@ -18,6 +18,8 @@ extra-deps: - generic-lens-core-2.2.0.0@sha256:b6b69e992f15fa80001de737f41f2123059011a1163d6c8941ce2e3ab44f8c03,2913 - hashable-1.3.5.0@sha256:47d1232d9788bb909cfbd80618de18dcdfb925609593e202912bd5841db138c1,4193 - lens-5.1@sha256:eb01fc4b1cfbad0e94c497eaf7b9f0e9b6c3dc7645c8b4597da7dc9d579f8500,14519 +- nyan-interpolation-0.9@sha256:8cf238be4c04746e4e9eabb34001c990c23e5837a19eb8652c584e57e92ecb41,3797 +- nyan-interpolation-core-0.9.0.1@sha256:1bda0e90d2045eb18c905f905082f4098829c1bdcbc4012663686a1c503b4ded,4067 - polysemy-1.7.1.0@sha256:3ead7a332abd70b202920ed3bf2e36866de163f821e643adfdcc9d39867b8033,5977 - time-compat-1.9.6.1@sha256:42d8f2e08e965e1718917d54ad69e1d06bd4b87d66c41dc7410f59313dba4ed1,5033 - tomland-1.3.3.1@sha256:83a8fd26a97164100541f7b26aa40ffdc6f230b21e94cbb3eae1fb7093c4356e,8924 diff --git a/stack.yaml.lock b/stack.yaml.lock index 4d72cfb2..de4d1fda 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -32,6 +32,20 @@ packages: sha256: 6236dbada87c86dfc74c3260acc674145b2773b354ac040c65abc54740452e07 original: hackage: lens-5.1@sha256:eb01fc4b1cfbad0e94c497eaf7b9f0e9b6c3dc7645c8b4597da7dc9d579f8500,14519 +- completed: + hackage: nyan-interpolation-0.9@sha256:8cf238be4c04746e4e9eabb34001c990c23e5837a19eb8652c584e57e92ecb41,3797 + pantry-tree: + size: 661 + sha256: 1ba3d0b9c1dd65cd6c8a3e10dc31261c70366d5822281176b84617b6c7b7bbc1 + original: + hackage: nyan-interpolation-0.9@sha256:8cf238be4c04746e4e9eabb34001c990c23e5837a19eb8652c584e57e92ecb41,3797 +- completed: + hackage: nyan-interpolation-core-0.9.0.1@sha256:1bda0e90d2045eb18c905f905082f4098829c1bdcbc4012663686a1c503b4ded,4067 + pantry-tree: + size: 1463 + sha256: 2a1a8d8b66746a246b3c0a4cd07daa6b961c9911676d30bc308a8a2682353b2b + original: + hackage: nyan-interpolation-core-0.9.0.1@sha256:1bda0e90d2045eb18c905f905082f4098829c1bdcbc4012663686a1c503b4ded,4067 - completed: hackage: polysemy-1.7.1.0@sha256:3ead7a332abd70b202920ed3bf2e36866de163f821e643adfdcc9d39867b8033,5977 pantry-tree: