Migrate to prettyprinter from deprecated ansi-wl-pprint (#279)

We replace the `text` function in most places in favour of just using the already-enabled `OverloadedStrings`, or with `pretty` when not using string literals.

Where the old instance `Pretty a => Pretty (Maybe a)` was relied upon, we replace `pretty` with `maybe mempty id` (then apply an HLint-suggested simplification), which is what we'd get from inlining a few definitions with the old library.

src/Database/Postgres/Temp/Internal.hs

@@ -19,10 +19,10 @@ import           Data.ByteString (ByteString)
 import qualified Data.Map.Strict as Map
 import qualified Database.PostgreSQL.Simple.Options as Client
 import           GHC.Generics
+import           Prettyprinter
 import           System.Exit (ExitCode(..))
 import           System.IO.Unsafe (unsafePerformIO)
 import           System.Process
-import           Text.PrettyPrint.ANSI.Leijen hiding ((<$>))
 import           System.Directory
 
 -- | Handle for holding temporary resources, the @postgres@ process handle
@@ -40,11 +40,11 @@ data DB = DB
 
 instance Pretty DB where
   pretty DB {..}
-    =  text "dbResources"
+    =  "dbResources"
     <> softline
     <> indent 2 (pretty dbResources)
     <> hardline
-    <> text "dbPostgresProcess"
+    <> "dbPostgresProcess"
     <> softline
     <> indent 2 (pretty dbPostgresProcess)
 

src/Database/Postgres/Temp/Internal/Config.hs

@@ -36,6 +36,7 @@ import           Data.Traversable
 import qualified Database.PostgreSQL.Simple.Options as Client
 import           GHC.Generics (Generic)
 import           Network.Socket.Free (getFreePort)
+import           Prettyprinter
 import           System.Directory
 import           System.Environment
 import           System.Exit (ExitCode(..))
@@ -44,7 +45,6 @@ import           System.IO.Error
 import           System.IO.Temp (createTempDirectory)
 import           System.IO.Unsafe (unsafePerformIO)
 import           System.Process
-import           Text.PrettyPrint.ANSI.Leijen hiding ((<$>))
 import           Control.Applicative
 
 {-|
@@ -90,7 +90,7 @@ getAccum = \case
 instance Monoid a => Monoid (Accum a) where
   mempty = DontCare
 
-prettyMap :: (Pretty a, Pretty b) => Map a b -> Doc
+prettyMap :: (Pretty a, Pretty b) => Map a b -> Doc ann
 prettyMap theMap =
   let xs = Map.toList theMap
   in vsep $ map (uncurry prettyKeyPair) xs
@@ -119,10 +119,10 @@ instance Monoid EnvironmentVariables where
 
 instance Pretty EnvironmentVariables where
   pretty EnvironmentVariables {..}
-    = text "inherit:"
+    = "inherit:"
         <+> pretty (getLast inherit)
     <> hardline
-    <> text "specific:"
+    <> "specific:"
     <> softline
     <> indent 2 (prettyMap specific)
 
@@ -168,15 +168,15 @@ instance Semigroup CommandLineArgs where
 
 instance Pretty CommandLineArgs where
   pretty p@CommandLineArgs {..}
-    = text "keyBased:"
+    = "keyBased:"
     <> softline
     <> indent 2 (prettyMap keyBased)
     <> hardline
-    <> text "indexBased:"
+    <> "indexBased:"
     <> softline
     <> indent 2 (prettyMap indexBased)
     <> hardline
-    <> text "completed:" <+> text (unwords (completeCommandLineArgs p))
+    <> "completed:" <+> pretty (unwords (completeCommandLineArgs p))
 
 -- Take values as long as the index is the successor of the
 -- last index.
@@ -222,24 +222,24 @@ data ProcessConfig = ProcessConfig
 
 instance Pretty ProcessConfig where
   pretty ProcessConfig {..}
-    = text "environmentVariables:"
+    = "environmentVariables:"
     <> softline
     <> indent 2 (pretty environmentVariables)
     <> hardline
-    <> text "commandLine:"
+    <> "commandLine:"
     <> softline
     <> indent 2 (pretty environmentVariables)
     <> hardline
-    <> text "stdIn:" <+>
-        pretty (prettyHandle <$> getLast stdIn)
+    <> "stdIn:" <+>
+        maybe mempty prettyHandle (getLast stdIn)
     <> hardline
-    <> text "stdOut:" <+>
-        pretty (prettyHandle <$> getLast stdOut)
+    <> "stdOut:" <+>
+        maybe mempty prettyHandle (getLast stdOut)
     <> hardline
-    <> text "stdErr:" <+>
-        pretty (prettyHandle <$> getLast stdErr)
+    <> "stdErr:" <+>
+        maybe mempty prettyHandle (getLast stdErr)
     <> hardline
-    <> text "createGroup:" <+>
+    <> "createGroup:" <+>
         pretty (getAny createGroup)
 
 
@@ -327,8 +327,8 @@ toFilePath = \case
 
 instance Pretty CompleteDirectoryType where
   pretty = \case
-    CPermanent x -> text "CPermanent" <+> pretty x
-    CTemporary x -> text "CTemporary" <+> pretty x
+    CPermanent x -> "CPermanent" <+> pretty x
+    CTemporary x -> "CTemporary" <+> pretty x
 
 makePermanent :: CompleteDirectoryType -> CompleteDirectoryType
 makePermanent = \case
@@ -349,8 +349,8 @@ data DirectoryType
 
 instance Pretty DirectoryType where
   pretty = \case
-    Permanent x -> text "Permanent" <+> pretty x
-    Temporary   -> text "Temporary"
+    Permanent x -> "Permanent" <+> pretty x
+    Temporary   -> "Temporary"
 
 -- | Takes the last 'Permanent' value.
 instance Semigroup DirectoryType where
@@ -546,46 +546,46 @@ data Config = Config
 
 instance Pretty Config where
   pretty Config {..}
-    =  text "socketDirectory:"
+    =  "socketDirectory:"
     <> softline
     <> pretty socketDirectory
     <> hardline
-    <> text "dataDirectory:"
+    <> "dataDirectory:"
     <> softline
     <> pretty dataDirectory
     <> hardline
-    <> text "port:" <+> pretty (getLast port)
+    <> "port:" <+> pretty (getLast port)
     <> hardline
-    <> text "temporaryDirectory:"
+    <> "temporaryDirectory:"
     <> softline
     <> pretty (getLast temporaryDirectory)
     <> hardline
-    <> text "initDbCache:" <+> pretty (getLast initDbCache)
+    <> "initDbCache:" <+> pretty (getLast initDbCache)
     <> hardline
-    <> text "initDbConfig:"
+    <> "initDbConfig:"
     <> softline
     <> indent 2 (pretty $ getAccum initDbConfig)
     <> hardline
-    <> text "initDbConfig:"
+    <> "initDbConfig:"
     <> softline
     <> indent 2 (pretty $ getAccum createDbConfig)
-    <> text "copyConfig:"
+    <> "copyConfig:"
     <> softline
     <> indent 2 (pretty (getLast copyConfig))
     <> hardline
-    <> text "postgresConfig:"
+    <> "postgresConfig:"
     <> softline
     <> indent 2 (pretty postgresConfig)
     <> hardline
-    <> text "connectionOptions:"
+    <> "connectionOptions:"
     <> softline
     <> indent 2 (prettyOptions connectionOptions)
     <> hardline
-    <> text "postgresConfigFile:"
+    <> "postgresConfigFile:"
     <> softline
-    <> indent 2 (vsep $ map (\(x, y) -> text x <> "=" <> text y) postgresConfigFile)
+    <> indent 2 (vsep $ map (\(x, y) -> pretty x <> "=" <> pretty y) postgresConfigFile)
     <> hardline
-    <> text "connectionTimeout:" <+> pretty (getLast connectionTimeout)
+    <> "connectionTimeout:" <+> pretty (getLast connectionTimeout)
 
 socketDirectoryToConfig :: FilePath -> [(String, String)]
 socketDirectoryToConfig dir =
@@ -613,15 +613,15 @@ data CopyDirectoryCommand = CopyDirectoryCommand
 
 instance Pretty CopyDirectoryCommand where
   pretty CopyDirectoryCommand {..}
-    =  text "sourceDirectory:"
+    =  "sourceDirectory:"
     <> softline
-    <> indent 2 (text sourceDirectory)
+    <> indent 2 (pretty sourceDirectory)
     <> hardline
-    <> text "destinationDirectory:"
+    <> "destinationDirectory:"
     <> softline
     <> indent 2 (pretty destinationDirectory)
     <> hardline
-    <> text "useCopyOnWrite:"
+    <> "useCopyOnWrite:"
     <+> pretty useCopyOnWrite
 
 completeCopyDirectory
@@ -847,14 +847,14 @@ data Resources = Resources
 
 instance Pretty Resources where
   pretty Resources {..}
-    =   text "resourcePlan:"
+    =   "resourcePlan:"
     <>  softline
     <>  indent 2 (pretty resourcesPlan)
     <>  hardline
-    <>  text "resourcesSocket:"
+    <>  "resourcesSocket:"
     <+> pretty resourcesSocketDirectory
     <>  hardline
-    <>  text "resourcesDataDir:"
+    <>  "resourcesDataDir:"
     <+> pretty resourcesDataDir
 
 -- | Make the 'resourcesDataDir' 'CPermanent' so it will not

src/Database/Postgres/Temp/Internal/Core.hs

@@ -13,9 +13,11 @@ import           Control.Monad
 import qualified Data.ByteString.Char8 as BSC
 import           Data.Foldable (for_)
 import           Data.IORef
+import           Data.Maybe
 import           Data.Typeable
 import qualified Database.PostgreSQL.Simple as PG
 import qualified Database.PostgreSQL.Simple.Options as Client
+import           Prettyprinter
 import           System.Directory
 import           System.Exit (ExitCode(..))
 import           System.IO
@@ -24,7 +26,6 @@ import           System.Posix.Signals (sigINT, sigQUIT, signalProcess)
 import           System.Process
 import           System.Process.Internals
 import           System.Timeout
-import           Text.PrettyPrint.ANSI.Leijen hiding ((<$>))
 
 -- | Internal events for debugging
 --
@@ -152,32 +153,32 @@ data CompleteProcessConfig = CompleteProcessConfig
   -- ^ Whether or not to create new process group
   }
 
-prettyHandle :: Handle -> Doc
-prettyHandle _ = text "HANDLE"
+prettyHandle :: Handle -> Doc ann
+prettyHandle _ = "HANDLE"
 
-prettyKeyPair ::(Pretty a, Pretty b) => a -> b -> Doc
-prettyKeyPair k v = pretty k <> text ": " <> pretty v
+prettyKeyPair ::(Pretty a, Pretty b) => a -> b -> Doc ann
+prettyKeyPair k v = pretty k <> ": " <> pretty v
 
 instance Pretty CompleteProcessConfig where
   pretty CompleteProcessConfig {..}
-    =  text "completeProcessConfigEnvVars:"
+    =  "completeProcessConfigEnvVars:"
     <> softline
     <> indent 2 (vsep (map (uncurry prettyKeyPair) completeProcessConfigEnvVars))
     <> hardline
-    <> text "completeProcessConfigCmdLine:"
+    <> "completeProcessConfigCmdLine:"
     <> softline
-    <> text (unwords completeProcessConfigCmdLine)
+    <> pretty (unwords completeProcessConfigCmdLine)
     <> hardline
-    <> text "completeProcessConfigStdIn:"
+    <> "completeProcessConfigStdIn:"
     <+> prettyHandle completeProcessConfigStdIn
     <> hardline
-    <> text "completeProcessConfigStdOut:"
+    <> "completeProcessConfigStdOut:"
     <+> prettyHandle completeProcessConfigStdOut
     <> hardline
-    <> text "completeProcessConfigStdErr:"
+    <> "completeProcessConfigStdErr:"
     <+> prettyHandle completeProcessConfigStdErr
     <> hardline
-    <> text "completeProcessConfigCreateGroup:"
+    <> "completeProcessConfigCreateGroup:"
     <> softline
     <> pretty completeProcessConfigCreateGroup
 
@@ -240,15 +241,15 @@ data CompletePostgresPlan = CompletePostgresPlan
 
 instance Pretty CompletePostgresPlan where
   pretty CompletePostgresPlan {..}
-    =  text "completePostgresPlanProcessConfig:"
+    =  "completePostgresPlanProcessConfig:"
     <> softline
     <> indent 2 (pretty completePostgresPlanProcessConfig)
     <> hardline
-    <> text "completePostgresPlanClientOptions:"
+    <> "completePostgresPlanClientOptions:"
     <+> prettyOptions completePostgresPlanClientOptions
 
-prettyOptions :: Client.Options -> Doc
-prettyOptions = text . BSC.unpack . Client.toConnectionString
+prettyOptions :: Client.Options -> Doc ann
+prettyOptions = pretty . BSC.unpack . Client.toConnectionString
 
 -- | The output of calling 'startPostgresProcess'.
 data PostgresProcess = PostgresProcess
@@ -260,7 +261,7 @@ data PostgresProcess = PostgresProcess
 
 instance Pretty PostgresProcess where
   pretty PostgresProcess {..}
-    =   text "postgresProcessClientOptions:"
+    =   "postgresProcessClientOptions:"
     <+> prettyOptions postgresProcessClientOptions
 
 -- | Stop the @postgres@ process after attempting to terminate all the
@@ -327,15 +328,15 @@ data CompleteCopyDirectoryCommand = CompleteCopyDirectoryCommand
 
 instance Pretty CompleteCopyDirectoryCommand where
   pretty CompleteCopyDirectoryCommand {..}
-    =  text "copyDirectoryCommandSrc:"
+    =  "copyDirectoryCommandSrc:"
     <> softline
-    <> indent 2 (text copyDirectoryCommandSrc)
+    <> indent 2 (pretty copyDirectoryCommandSrc)
     <> hardline
-    <> text "copyDirectoryCommandDst:"
+    <> "copyDirectoryCommandDst:"
     <> softline
-    <> indent 2 (text copyDirectoryCommandDst)
+    <> indent 2 (pretty copyDirectoryCommandDst)
     <> hardline
-    <> text "copyDirectoryCommandCow:"
+    <> "copyDirectoryCommandCow:"
     <+> pretty copyDirectoryCommandCow
 
 executeCopyDirectoryCommand :: CompleteCopyDirectoryCommand -> IO ()
@@ -365,15 +366,15 @@ data InitDbCachePlan = InitDbCachePlan
 
 instance Pretty InitDbCachePlan where
   pretty InitDbCachePlan {..}
-    =   text "cachePlanDataDirectory:"
+    =   "cachePlanDataDirectory:"
     <>  softline
     <>  indent 2 (pretty cachePlanDataDirectory)
     <>  hardline
-    <>  text "cachePlanInitDb:"
+    <>  "cachePlanInitDb:"
     <>  softline
     <>  indent 2 (pretty cachePlanInitDb)
     <>  hardline
-    <>  text "cachePlanCopy:"
+    <>  "cachePlanCopy:"
     <>  softline
     <>  indent 2 (pretty cachePlanCopy)
 
@@ -413,32 +414,32 @@ data Plan = Plan
   , completePlanConnectionTimeout :: Int
   }
 
-eitherPretty :: (Pretty a, Pretty b) => Either a b -> Doc
+eitherPretty :: (Pretty a, Pretty b) => Either a b -> Doc ann
 eitherPretty = either pretty pretty
 
 instance Pretty Plan where
   pretty Plan {..}
-    =   text "completePlanInitDb:"
+    =   "completePlanInitDb:"
     <>  softline
-    <>  indent 2 (pretty $ fmap eitherPretty completePlanInitDb)
+    <>  indent 2 (fromMaybe mempty $ fmap eitherPretty completePlanInitDb)
     <>  hardline
-    <>  text "completePlanCopy:"
+    <>  "completePlanCopy:"
     <>  softline
     <>  indent 2 (pretty completePlanCopy)
     <>  hardline
-    <>  text "completePlanCreateDb:"
+    <>  "completePlanCreateDb:"
     <>  softline
     <>  indent 2 (pretty completePlanCreateDb)
     <>  hardline
-    <>  text "completePlanPostgres:"
+    <>  "completePlanPostgres:"
     <>  softline
     <>  indent 2 (pretty completePlanPostgres)
     <>  hardline
-    <>  text "completePlanConfig:"
+    <>  "completePlanConfig:"
     <>  softline
     <>  indent 2 (pretty completePlanConfig)
     <>  hardline
-    <>  text "completePlanDataDirectory:"
+    <>  "completePlanDataDirectory:"
     <+> pretty completePlanDataDirectory
 
 -- | 'startPlan' optionally calls @initdb@, optionally calls @createdb@ and

tmp-postgres.cabal

@@ -40,7 +40,6 @@ library
     , ViewPatterns
   build-depends: base >= 4.6 && < 5
                , base64-bytestring
-               , ansi-wl-pprint
                , async
                , bytestring
                , containers
@@ -51,6 +50,7 @@ library
                , port-utils
                , postgres-options >= 0.2.0.0
                , postgresql-simple
+               , prettyprinter
                , process >= 1.2.0.0
                , stm
                , temporary