[#39] String interpolation in coffer output messages

Problem: at this moment constructing some messages in `Main.hs` looks very convoluted (e.g. message in `set-field` command). Solution: used `nyan-interpolation` package in `Main.hs`.
serokell · Apr 5, 2022 · 2cee93c · 2cee93c
1 parent 0296786
commit 2cee93c
Show file tree

Hide file tree

Showing 5 changed files with 79 additions and 43 deletions.
diff --git 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,52 +133,60 @@ 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
           CPRSuccess copiedPaths -> 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
@@ -179,6 +179,7 @@ executable coffer
     , coffer
     , fmt
     , lens
+    , nyan-interpolation
     , optparse-applicative
     , polysemy
     , text

diff --git 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
@@ -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
@@ -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: