Further conversions to Text in Docs modules

examples/docs/src/DocComments.purs

@@ -0,0 +1,11 @@
+module DocComments where
+
+-- | This declaration has a code block:
+-- |
+-- |     example == 0
+-- |
+-- | Here we are really testing that the leading whitespace is not stripped, as
+-- | this ensures that we don't accidentally change code blocks into normal
+-- | paragraphs.
+example :: Int
+example = 0

psc-docs/Main.hs

@@ -9,6 +9,7 @@ import Control.Category ((>>>))
 import Control.Monad.Writer
 import Data.Text (Text)
 import qualified Data.Text as T
+import qualified Data.Text.IO as T
 import Data.Function (on)
 import Data.List
 import Data.Maybe (fromMaybe)
@@ -22,7 +23,7 @@ import qualified Language.PureScript as P
 import qualified Paths_purescript as Paths
 import System.Exit (exitFailure)
 import System.IO (hPutStrLn, hPrint, hSetEncoding, stderr, stdout, utf8)
-import System.IO.UTF8 (readUTF8FileT)
+import System.IO.UTF8 (readUTF8FileT, writeUTF8FileT)
 import System.Directory (createDirectoryIfMissing)
 import System.FilePath (takeDirectory)
 import System.FilePath.Glob (glob)
@@ -65,11 +66,11 @@ docgen (PSCDocsOptions fmt inputGlob output) = do
 
       case output of
         EverythingToStdOut ->
-          putStrLn (D.runDocs (D.modulesAsMarkdown ms))
+          T.putStrLn (D.runDocs (D.modulesAsMarkdown ms))
         ToStdOut names -> do
           let (ms', missing) = takeByName ms names
           guardMissing missing
-          putStrLn (D.runDocs (D.modulesAsMarkdown ms'))
+          T.putStrLn (D.runDocs (D.modulesAsMarkdown ms'))
         ToFiles names -> do
           let (ms', missing) = takeByName' ms names
           guardMissing missing
@@ -78,7 +79,7 @@ docgen (PSCDocsOptions fmt inputGlob output) = do
           forM_ ms'' $ \grp -> do
             let fp = fst (head grp)
             createDirectoryIfMissing True (takeDirectory fp)
-            writeFile fp (D.runDocs (D.modulesAsMarkdown (map snd grp)))
+            writeUTF8FileT fp (D.runDocs (D.modulesAsMarkdown (map snd grp)))
 
   where
   guardMissing [] = return ()

psc-publish/Main.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedStrings #-}
 
 module Main where
 

src/Language/PureScript/Docs/AsMarkdown.hs

@@ -13,7 +13,9 @@ import Control.Monad.Error.Class (MonadError)
 import Control.Monad.Writer (Writer, tell, execWriter)
 
 import Data.Foldable (for_)
+import Data.Monoid ((<>))
 import Data.List (partition)
+import Data.Text (Text)
 import qualified Data.Text as T
 
 import Language.PureScript.Docs.RenderedCode
@@ -24,12 +26,12 @@ import qualified Language.PureScript.Docs.Render as Render
 
 -- |
 -- Take a list of modules and render them all in order, returning a single
--- Markdown-formatted String.
+-- Markdown-formatted Text.
 --
 renderModulesAsMarkdown ::
   (MonadError P.MultipleErrors m) =>
   [P.Module] ->
-  m String
+  m Text
 renderModulesAsMarkdown =
   fmap (runDocs . modulesAsMarkdown) . Convert.convertModules
 
@@ -38,13 +40,13 @@ modulesAsMarkdown = mapM_ moduleAsMarkdown
 
 moduleAsMarkdown :: Module -> Docs
 moduleAsMarkdown Module{..} = do
-  headerLevel 2 $ "Module " ++ T.unpack (P.runModuleName modName)
+  headerLevel 2 $ "Module " <> P.runModuleName modName
   spacer
   for_ modComments tell'
   mapM_ (declAsMarkdown modName) modDeclarations
   spacer
   for_ modReExports $ \(mn, decls) -> do
-    headerLevel 3 $ "Re-exported from " ++ T.unpack (P.runModuleName mn) ++ ":"
+    headerLevel 3 $ "Re-exported from " <> P.runModuleName mn <> ":"
     spacer
     mapM_ (declAsMarkdown mn) decls
 
@@ -71,7 +73,7 @@ declAsMarkdown mn decl@Declaration{..} = do
   isChildInstance (ChildInstance _ _) = True
   isChildInstance _ = False
 
-codeToString :: RenderedCode -> String
+codeToString :: RenderedCode -> Text
 codeToString = outputWith elemAsMarkdown
   where
   elemAsMarkdown (Syntax x)  = x
@@ -95,14 +97,14 @@ codeToString = outputWith elemAsMarkdown
 --     P.Infixr -> "right-associative"
 --     P.Infix  -> "non-associative"
 
-childToString :: First -> ChildDeclaration -> String
+childToString :: First -> ChildDeclaration -> Text
 childToString f decl@ChildDeclaration{..} =
   case cdeclInfo of
     ChildDataConstructor _ ->
       let c = if f == First then "=" else "|"
-      in  "  " ++ c ++ " " ++ str
+      in  "  " <> c <> " " <> str
     ChildTypeClassMember _ ->
-      "  " ++ str
+      "  " <> str
     ChildInstance _ _ ->
       str
   where
@@ -113,25 +115,25 @@ data First
   | NotFirst
   deriving (Show, Eq, Ord)
 
-type Docs = Writer [String] ()
+type Docs = Writer [Text] ()
 
-runDocs :: Docs -> String
-runDocs = unlines . execWriter
+runDocs :: Docs -> Text
+runDocs = T.unlines . execWriter
 
-tell' :: String -> Docs
+tell' :: Text -> Docs
 tell' = tell . (:[])
 
 spacer :: Docs
 spacer = tell' ""
 
-headerLevel :: Int -> String -> Docs
-headerLevel level hdr = tell' (replicate level '#' ++ ' ' : hdr)
+headerLevel :: Int -> Text -> Docs
+headerLevel level hdr = tell' (T.replicate level "#" <> " " <> hdr)
 
 fencedBlock :: Docs -> Docs
 fencedBlock inner = do
   tell' "``` purescript"
   inner
   tell' "```"
 
-ticks :: String -> String
-ticks = ("`" ++) . (++ "`")
+ticks :: Text -> Text
+ticks = ("`" <>) . (<> "`")

src/Language/PureScript/Docs/Convert.hs

@@ -16,7 +16,7 @@ import Control.Monad.Error.Class (MonadError)
 import Control.Monad.State (runStateT)
 import Control.Monad.Writer.Strict (runWriterT)
 import qualified Data.Map as Map
-import qualified Data.Text as T
+import Data.Text (Text)
 
 import Language.PureScript.Docs.Convert.ReExports (updateReExports)
 import Language.PureScript.Docs.Convert.Single (convertSingleModule, collectBookmarks)
@@ -167,9 +167,9 @@ insertValueTypes env m =
   err msg =
     P.internalError ("Docs.Convert.insertValueTypes: " ++ msg)
 
-runParser :: P.TokenParser a -> String -> Either String a
+runParser :: P.TokenParser a -> Text -> Either String a
 runParser p s = either (Left . show) Right $ do
-  ts <- P.lex "" (T.pack s)
+  ts <- P.lex "" s
   P.runTokenParser "" (p <* eof) ts
 
 -- |

src/Language/PureScript/Docs/Convert/ReExports.hs

@@ -4,7 +4,7 @@ module Language.PureScript.Docs.Convert.ReExports
 
 import Prelude.Compat
 
-import Control.Arrow ((&&&), first, second)
+import Control.Arrow ((&&&), second)
 import Control.Monad
 import Control.Monad.Reader.Class (MonadReader, ask)
 import Control.Monad.State.Class (MonadState, gets, modify)
@@ -16,6 +16,7 @@ import Data.Map (Map)
 import Data.Maybe (mapMaybe)
 import Data.Monoid ((<>))
 import qualified Data.Map as Map
+import Data.Text (Text)
 import qualified Data.Text as T
 
 import Language.PureScript.Docs.Types
@@ -184,12 +185,12 @@ lookupValueDeclaration ::
    MonadReader P.ModuleName m) =>
   P.ModuleName ->
   P.Ident ->
-  m (P.ModuleName, [Either (String, P.Constraint, ChildDeclaration) Declaration])
+  m (P.ModuleName, [Either (Text, P.Constraint, ChildDeclaration) Declaration])
 lookupValueDeclaration importedFrom ident = do
   decls <- lookupModuleDeclarations "lookupValueDeclaration" importedFrom
   let
     rs =
-      filter (\d -> declTitle d == T.unpack (P.showIdent ident)
+      filter (\d -> declTitle d == P.showIdent ident
                     && (isValue d || isValueAlias d)) decls
     errOther other =
       internalErrorInModule
@@ -215,7 +216,7 @@ lookupValueDeclaration importedFrom ident = do
                     (declChildren d))
 
         matchesIdent cdecl =
-          cdeclTitle cdecl == T.unpack (P.showIdent ident)
+          cdeclTitle cdecl == P.showIdent ident
 
         matchesAndIsTypeClassMember =
           uncurry (&&) . (matchesIdent &&& isTypeClassMember)
@@ -239,7 +240,7 @@ lookupValueOpDeclaration
   -> m (P.ModuleName, [Declaration])
 lookupValueOpDeclaration importedFrom op = do
   decls <- lookupModuleDeclarations "lookupValueOpDeclaration" importedFrom
-  case filter (\d -> declTitle d == T.unpack (P.showOp op) && isValueAlias d) decls of
+  case filter (\d -> declTitle d == P.showOp op && isValueAlias d) decls of
     [d] ->
       pure (importedFrom, [d])
     other ->
@@ -259,7 +260,7 @@ lookupTypeDeclaration ::
 lookupTypeDeclaration importedFrom ty = do
   decls <- lookupModuleDeclarations "lookupTypeDeclaration" importedFrom
   let
-    ds = filter (\d -> declTitle d == T.unpack (P.runProperName ty) && isType d) decls
+    ds = filter (\d -> declTitle d == P.runProperName ty && isType d) decls
   case ds of
     [d] ->
       pure (importedFrom, [d])
@@ -275,7 +276,7 @@ lookupTypeOpDeclaration
 lookupTypeOpDeclaration importedFrom tyOp = do
   decls <- lookupModuleDeclarations "lookupTypeOpDeclaration" importedFrom
   let
-    ds = filter (\d -> declTitle d == ("type " ++ T.unpack (P.showOp tyOp)) && isTypeAlias d) decls
+    ds = filter (\d -> declTitle d == ("type " <> P.showOp tyOp) && isTypeAlias d) decls
   case ds of
     [d] ->
       pure (importedFrom, [d])
@@ -291,7 +292,7 @@ lookupTypeClassDeclaration
 lookupTypeClassDeclaration importedFrom tyClass = do
   decls <- lookupModuleDeclarations "lookupTypeClassDeclaration" importedFrom
   let
-    ds = filter (\d -> declTitle d == T.unpack (P.runProperName tyClass)
+    ds = filter (\d -> declTitle d == P.runProperName tyClass
                        && isTypeClass d)
                 decls
   case ds of
@@ -324,7 +325,7 @@ lookupModuleDeclarations definedIn moduleName = do
 
 handleTypeClassMembers ::
   (MonadReader P.ModuleName m) =>
-  Map P.ModuleName [Either (String, P.Constraint, ChildDeclaration) Declaration] ->
+  Map P.ModuleName [Either (Text, P.Constraint, ChildDeclaration) Declaration] ->
   Map P.ModuleName [Declaration] ->
   m (Map P.ModuleName [Declaration], Map P.ModuleName [Declaration])
 handleTypeClassMembers valsAndMembers typeClasses =
@@ -339,7 +340,7 @@ handleTypeClassMembers valsAndMembers typeClasses =
       |> fmap splitMap
 
 valsAndMembersToEnv ::
-  [Either (String, P.Constraint, ChildDeclaration) Declaration] -> TypeClassEnv
+  [Either (Text, P.Constraint, ChildDeclaration) Declaration] -> TypeClassEnv
 valsAndMembersToEnv xs =
   let (envUnhandledMembers, envValues) = partitionEithers xs
       envTypeClasses = []
@@ -360,11 +361,11 @@ typeClassesToEnv classes =
 --
 data TypeClassEnv = TypeClassEnv
   { -- |
-    -- Type class members which have not yet been dealt with. The String is the
+    -- Type class members which have not yet been dealt with. The Text is the
     -- name of the type class they belong to, and the constraint is used to
     -- make sure that they have the correct type if they get promoted.
     --
-    envUnhandledMembers :: [(String, P.Constraint, ChildDeclaration)]
+    envUnhandledMembers :: [(Text, P.Constraint, ChildDeclaration)]
     -- |
     -- A list of normal value declarations. Type class members will be added to
     -- this list if their parent type class is not available.
@@ -428,7 +429,7 @@ handleEnv TypeClassEnv{..} =
       _ ->
         internalErrorInModule
           ("handleEnv: Bad child declaration passed to promoteChild: "
-          ++ cdeclTitle)
+          ++ T.unpack cdeclTitle)
 
   addConstraint constraint =
     P.quantify . P.moveQuantifiersToFront . P.ConstrainedType [constraint]
@@ -448,7 +449,7 @@ filterDataConstructors
   -> Map P.ModuleName [Declaration]
   -> Map P.ModuleName [Declaration]
 filterDataConstructors =
-  filterExportedChildren isDataConstructor (T.unpack . P.runProperName)
+  filterExportedChildren isDataConstructor P.runProperName
 
 -- |
 -- Given a list of exported type class member names, remove any data
@@ -460,12 +461,12 @@ filterTypeClassMembers
   -> Map P.ModuleName [Declaration]
   -> Map P.ModuleName [Declaration]
 filterTypeClassMembers =
-  filterExportedChildren isTypeClassMember (T.unpack . P.showIdent)
+  filterExportedChildren isTypeClassMember P.showIdent
 
 filterExportedChildren
   :: (Functor f)
   => (ChildDeclaration -> Bool)
-  -> (name -> String)
+  -> (name -> Text)
   -> [name]
   -> f [Declaration]
   -> f [Declaration]
@@ -504,7 +505,7 @@ typeClassConstraintFor :: Declaration -> Maybe P.Constraint
 typeClassConstraintFor Declaration{..} =
   case declInfo of
     TypeClassDeclaration tyArgs _ _ ->
-      Just (P.Constraint (P.Qualified Nothing (P.ProperName (T.pack declTitle))) (mkConstraint (map (first T.pack) tyArgs)) Nothing)
+      Just (P.Constraint (P.Qualified Nothing (P.ProperName declTitle)) (mkConstraint tyArgs) Nothing)
     _ ->
       Nothing
   where