fixup! fixup! fixup! fixup! [#39] String interpolation in coffer ou…

…tput messages

app/Main.hs

@@ -7,28 +7,27 @@ module Main where
 import Backend
 import Backend.Commands as Commands
 import Backend.Interpreter
-import Control.Lens
-import Control.Monad (forM_, when)
-import Data.Text (pack)
-import Data.Text.IO qualified as TIO
-import Fmt
-import Options.Applicative (execParser)
-import Polysemy
-import Polysemy.Error (Error, errorToIOFinal)
-import System.Exit (die, exitFailure)
-import Toml qualified
-
 import CLI.Parser
 import CLI.PrettyPrint
 import CLI.Types
 import Coffer.Directory qualified as Dir
 import Coffer.Path (EntryPath, Path, QualifiedPath(qpPath))
 import Config (Config(..), configCodec)
+import Control.Lens
+import Control.Monad (forM_, when)
 import Data.Maybe (fromMaybe)
+import Data.Text (pack)
+import Data.Text.IO qualified as TIO
 import Entry qualified as E
 import Error
+import Fmt
+import Options.Applicative (execParser)
+import Polysemy
+import Polysemy.Error (Error, errorToIOFinal)
 import System.Environment (lookupEnv)
+import System.Exit (die, exitFailure)
 import Text.Interpolation.Nyan
+import Toml qualified
 
 runBackendIO
   :: Sem '[BackendEffect, Error CofferError, Embed IO, Final IO ] a

coffer.cabal

@@ -106,6 +106,7 @@ library
     , lens-aeson
     , megaparsec
     , mtl
+    , nyan-interpolation
     , optparse-applicative
     , polysemy
     , servant

lib/Backend/Vault/Kv.hs

@@ -31,7 +31,7 @@ import Data.Time (UTCTime)
 import Entry (Entry, Field, FieldContents(FieldContents), FieldName, FieldVisibility)
 import Entry qualified as E
 import Error (BackendError, CofferError(..))
-import Fmt (Buildable(build), Builder, indentF, unlinesF, (+|), (|+))
+import Fmt (Buildable(build))
 import GHC.Generics (Generic)
 import Network.HTTP.Client (defaultManagerSettings, newManager)
 import Network.HTTP.Client.TLS (tlsManagerSettings)
@@ -42,6 +42,7 @@ import Servant.Client
   (BaseUrl(BaseUrl), ClientEnv, ClientError(..), Scheme(Http, Https), mkClientEnv, parseBaseUrl,
   showBaseUrl)
 import Servant.Client.Core.Response (responseStatusCode)
+import Text.Interpolation.Nyan
 import Toml (TomlCodec, (.=))
 import Toml qualified
 
@@ -64,41 +65,41 @@ data VaultError
 instance Buildable VaultError where
   build = \case
     ServantError (FailureResponse request response) ->
-      unlinesF @_ @Builder
-        [ "Request:"
-        , indentF 2 ((build . show) request)
-        , "failed with response:"
-        , indentF 2 ((build . show) response)
-        ]
+      [int|s|
+        Request:
+          #{show request}
+        failed with response:
+          #{show response}
+      |]
     ServantError (DecodeFailure body response) ->
-      unlinesF @_ @Builder
-        [ "The body could not be decoded at the expected type."
-        , "Body: " <> build body
-        , "Response:"
-        , indentF 2 ((build . show) response)
-        ]
+      [int|s|
+        The body could not be decoded at the expected type.
+        Body: #{body}
+        Response:
+          #{show response}
+      |]
     ServantError (UnsupportedContentType mediatype response) ->
-      unlinesF @_ @Builder
-        [ "The content-type '" <> (build . show) mediatype <> "' of the response is not supported."
-        , "Response:"
-        , indentF 2 ((build . show) response)
-        ]
+      [int|s|
+        The content-type '#{show mediatype}' of the response is not supported.
+        Response:
+          #{show response}
+      |]
     ServantError (InvalidContentTypeHeader response) ->
-      unlinesF @_ @Builder
-        [ "The content-type header is invalid."
-        , "Response:"
-        , indentF 2 ((build . show) response)
-        ]
+      [int|s|
+        The content-type header is invalid.
+        Response:
+          #{show response}
+      |]
     ServantError (ConnectionError exception) ->
-      unlinesF @_ @Builder
-        [ "Connection error. No response was received."
-        , (build . show) exception
-        ]
+      [int|s|
+        Connection error. No response was received.
+        #{show exception}
+      |]
     FieldMetadataNotFound entryPath fieldName ->
-      "Could not find coffer metadata for field '" +| fieldName
-        |+ "' at '" +| entryPath |+ "'"
+      [int|s|Could not find coffer metadata for field \
+      '#{fieldName}' at '#{entryPath}'|]
     CofferSpecialsNotFound entryPath ->
-      "Could not find key '#$coffer' in the kv entry at '" +| entryPath |+ "'."
+      [int|s|Could not find key '#$coffer' in the kv entry at '#{entryPath}'.|]
     BadCofferSpecialsError err -> build err
 
 instance BackendError VaultError

lib/CLI/Parser.hs

@@ -35,6 +35,7 @@ import Entry
 import Fmt (pretty)
 import Options.Applicative
 import Options.Applicative.Help.Pretty qualified as Pretty
+import Text.Interpolation.Nyan
 import Text.Megaparsec (try)
 import Text.Megaparsec qualified as P
 import Text.Megaparsec.Char qualified as P
@@ -60,11 +61,11 @@ parser = Options
         [ long "config"
         , short 'c'
         , metavar "CONFIG"
-        , help $ unlines
-            [ "Specify config file path."
-            , "When this option is not set, the 'COFFER_CONFIG' environment variable will be used."
-            , "When neither is set, it will default to 'config.toml'."
-            ]
+        , help [int|s|
+            Specify config file path.
+            When this option is not set, the 'COFFER_CONFIG' environment variable will be used.
+            When neither is set, it will default to 'config.toml'.
+          |]
         ]
 
 commandParser :: Parser SomeCommand
@@ -401,25 +402,25 @@ readQualifiedPath = do
       [pathStr] -> do
         path <- readPath' pathStr
         pure $ QualifiedPath Nothing path
-      _ ->
-        Left $ unlines
-                [ "Invalid qualified path format: " <> show input <> "."
-                , show expectedQualifiedPathFormat
-                ]
+      _ -> Left [int|s|
+        Invalid qualified path format: #{show input}.
+        #{show expectedQualifiedPathFormat}
+      |]
 
 readFieldContents :: ReadM FieldContents
 readFieldContents = str <&> FieldContents
 
 readFieldInfo :: ReadM FieldInfo
 readFieldInfo = do
   eitherReader \input ->
-    P.parse (parseFieldInfo <* P.eof) "" (T.pack input) & first \err -> unlines
-      [ "Invalid field format: " <> show input <> "."
-      , "Expected format: 'fieldname=fieldcontents'."
-      , ""
-      , "Parser error:"
-      , P.errorBundlePretty err
-      ]
+    P.parse (parseFieldInfo <* P.eof) "" (T.pack input) & first \err ->
+      [int|s|
+        Invalid field format: #{show input}.
+        Expected format: 'fieldname=fieldcontents'.
+
+        Parser error:
+        #{P.errorBundlePretty err}
+      |]
 
 readSort :: ReadM (Sort, Direction)
 readSort = do
@@ -430,28 +431,28 @@ readSort = do
         case means of
           "name" -> pure (SortByEntryName, direction')
           "date" -> pure (SortByEntryDate, direction')
-          _ -> Left $ unlines
-            [ "Invalid sort: " <> show means <> "."
-            , "Choose one of: 'name', 'date'."
-            , ""
-            , show expectedSortFormat
-            ]
+          _ -> Left [int|s|
+            Invalid sort: #{show means}.
+            Choose one of: 'name', 'date'.
+
+            #{show expectedSortFormat}
+          |]
       [fieldName, means, direction] -> do
         fieldName' <- readFieldName' fieldName
         direction' <- readDirection direction
         case means of
           "contents" -> pure (SortByFieldContents fieldName', direction')
           "date" -> pure (SortByFieldDate fieldName', direction')
-          _ -> Left $ unlines
-            [ "Invalid sort: " <> show means <> "."
-            , "Choose one of: 'contents', 'date'."
-            , ""
-            , show expectedSortFormat
-            ]
-      _ -> Left $ unlines
-        [ "Invalid sort format: " <> show input <> "."
-        , show expectedSortFormat
-        ]
+          _ -> Left [int|s|
+            Invalid sort: #{show means}.
+            Choose one of: 'contents', 'date'.
+
+            #{show expectedSortFormat}
+          |]
+      _ -> Left [int|s|
+        Invalid sort format: #{show input}.
+        #{show expectedSortFormat}
+      |]
 
 expectedSortFormat :: Pretty.Doc
 expectedSortFormat = Pretty.vsep
@@ -474,13 +475,14 @@ readDirection =
 readFilter :: ReadM Filter
 readFilter = do
   eitherReader \input ->
-    P.parse (parseFilter <* P.eof) "" (T.pack input) & first \err -> unlines
-      [ "Invalid filter format: " <> show input <> "."
-      , show expectedFilterFormat
-      , ""
-      , "Parser error:"
-      , P.errorBundlePretty err
-      ]
+    P.parse (parseFilter <* P.eof) "" (T.pack input) & first \err ->
+      [int|s|
+        Invalid filter format: #{show input}.
+        #{show expectedFilterFormat}
+
+        Parser error:
+        #{P.errorBundlePretty err}
+      |]
 
 expectedQualifiedEntryPathFormat :: Pretty.Doc
 expectedQualifiedEntryPathFormat = Pretty.vsep
@@ -624,10 +626,10 @@ readSum sumDescription constructors input =
   case M.lookup input constructors of
     Just cons -> Right cons
     Nothing ->
-      Left $ unlines
-        [ "Invalid " <> sumDescription <> ": '" <> input <> "'."
-        , "Choose one of: " <> constructorNames <> "."
-        ]
+      Left [int|s|
+        Invalid #{sumDescription}: '#{input}'.
+        Choose one of: #{constructorNames}.
+      |]
   where
     constructorNames :: String
     constructorNames =

lib/Error.hs

@@ -12,7 +12,8 @@ import BackendName (BackendName)
 import Coffer.Path (EntryPath, Path)
 import Data.Text (Text)
 import Entry (BadEntryTag, BadFieldName)
-import Fmt (Buildable(build), Builder, pretty, unlinesF, (+|), (|+))
+import Fmt (Buildable(build))
+import Text.Interpolation.Nyan
 
 -- | GADT for coffer internal errors.
 -- It is backend-agnostic, so it doesn't know about specific backend errors.
@@ -35,36 +36,36 @@ data InternalCommandsError
 instance Buildable InternalCommandsError where
   build = \case
     InvalidEntry entry ->
-      unlinesF @_ @Builder
-        [ "Backend returned a secret that is not a valid\
-          \ entry or directory name."
-        , "Got: '" +| entry |+ "'."
-        ]
+      [int|s|
+        Backend returned a secret that is not a valid \
+        entry or directory name.
+        Got: '#{entry}'.
+      |]
     EntryPathDoesntHavePrefix entryPath path ->
-      unlinesF @_ @Builder
-        [ "Expected path: '" <> pretty entryPath <> "'"
-        , "To have the prefix: '" <> pretty path <> "'"
-        ]
+      [int|s|
+        Expected path: '#{entryPath}'
+        To have the prefix: '#{path}'
+      |]
 
 instance Buildable CofferError where
   build = \case
     BackendError err ->
-      unlinesF @_ @Builder
-        [ "Internal backend error:"
-        , build err
-        ]
+      [int|s|
+        Internal backend error:
+        #{err}
+      |]
     InternalCommandsError err ->
-      unlinesF @_ @Builder
-        [ "Internal error:"
-        , build err
-        ]
+      [int|s|
+        Internal error:
+        #{err}
+      |]
     BackendNotFound backendName ->
-      "Backend with name '" <> build backendName <> "' not found."
+      [int|s|Backend with name '#{backendName}' not found.|]
     BadFieldNameError err -> build err
     BadMasterFieldName name err ->
-      unlinesF @_ @Builder
-        [ "Attempted to create new field name from '" +| name |+ "'"
-        , ""
-        , build err
-        ]
+      [int|s|
+        Attempted to create new field name from '#{name}'
+
+        #{err}
+      |]
     BadEntryTagError err -> build err

package.yaml

@@ -101,6 +101,7 @@ library:
     - lens-aeson
     - megaparsec
     - mtl
+    - nyan-interpolation
     - optparse-applicative
     - polysemy
     - servant