1c5a431 · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

Further conversions to Text in Docs modules (#2502)

* Further conversions to Text in Docs modules * Test leading whitespace is preserved in doc comments * Preserve leading whitespace in doc comments

commit1c5a43120ba9f24c22b6aae0b0869643782c5534 authorHarry Garrood <harry@garrood.me> dateSat 24 Dec 2016, 23:19 (10 years ago) parent1531559

17 files changed+308−298

compare with golang

unifiedsplit

examples/docs/src/DocComments.pursnew file+11

@@ -0,0 +1,11 @@

1+module DocComments where

3+-- | This declaration has a code block:

4+-- |

5+-- | example == 0

6+-- |

7+-- | Here we are really testing that the leading whitespace is not stripped, as

8+-- | this ensures that we don't accidentally change code blocks into normal

9+-- | paragraphs.

10+example :: Int

11+example = 0

psc-docs/Main.hs+5−4

@@ -9,6 +9,7 @@ import Control.Category ((>>>))

99import Control.Monad.Writer

1010import Data.Text (Text)

1111import qualified Data.Text as T

12+import qualified Data.Text.IO as T

1213import Data.Function (on)

1314import Data.List

1415import Data.Maybe (fromMaybe)

@@ -22,7 +23,7 @@ import qualified Language.PureScript as P

2223import qualified Paths_purescript as Paths

2324import System.Exit (exitFailure)

2425import System.IO (hPutStrLn, hPrint, hSetEncoding, stderr, stdout, utf8)

25−import System.IO.UTF8 (readUTF8FileT)

26+import System.IO.UTF8 (readUTF8FileT, writeUTF8FileT)

2627import System.Directory (createDirectoryIfMissing)

2728import System.FilePath (takeDirectory)

2829import System.FilePath.Glob (glob)

@@ -65,11 +66,11 @@ docgen (PSCDocsOptions fmt inputGlob output) = do

6566

6667 case output of

6768 EverythingToStdOut ->

68− putStrLn (D.runDocs (D.modulesAsMarkdown ms))

69+ T.putStrLn (D.runDocs (D.modulesAsMarkdown ms))

6970 ToStdOut names -> do

7071 let (ms', missing) = takeByName ms names

7172 guardMissing missing

72− putStrLn (D.runDocs (D.modulesAsMarkdown ms'))

73+ T.putStrLn (D.runDocs (D.modulesAsMarkdown ms'))

7374 ToFiles names -> do

7475 let (ms', missing) = takeByName' ms names

7576 guardMissing missing

@@ -78,7 +79,7 @@ docgen (PSCDocsOptions fmt inputGlob output) = do

7879 forM_ ms'' $ \grp -> do

7980 let fp = fst (head grp)

8081 createDirectoryIfMissing True (takeDirectory fp)

81− writeFile fp (D.runDocs (D.modulesAsMarkdown (map snd grp)))

82+ writeUTF8FileT fp (D.runDocs (D.modulesAsMarkdown (map snd grp)))

8283

8384 where

8485 guardMissing [] = return ()

psc-publish/Main.hs+1

@@ -1,3 +1,4 @@

1+{-# LANGUAGE OverloadedStrings #-}

23module Main where

src/Language/PureScript/Docs/AsMarkdown.hs+18−16

@@ -13,7 +13,9 @@ import Control.Monad.Error.Class (MonadError)

1313import Control.Monad.Writer (Writer, tell, execWriter)

1414

1515import Data.Foldable (for_)

16+import Data.Monoid ((<>))

1617import Data.List (partition)

18+import Data.Text (Text)

1719import qualified Data.Text as T

1820

1921import Language.PureScript.Docs.RenderedCode

@@ -24,12 +26,12 @@ import qualified Language.PureScript.Docs.Render as Render

2426

2527-- |

2628-- Take a list of modules and render them all in order, returning a single

27−-- Markdown-formatted String.

29+-- Markdown-formatted Text.

2830--

2931renderModulesAsMarkdown ::

3032 (MonadError P.MultipleErrors m) =>

3133 [P.Module] ->

32− m String

34+ m Text

3335renderModulesAsMarkdown =

3436 fmap (runDocs . modulesAsMarkdown) . Convert.convertModules

3537

@@ -38,13 +40,13 @@ modulesAsMarkdown = mapM_ moduleAsMarkdown

3840

3941moduleAsMarkdown :: Module -> Docs

4042moduleAsMarkdown Module{..} = do

41− headerLevel 2 $ "Module " ++ T.unpack (P.runModuleName modName)

43+ headerLevel 2 $ "Module " <> P.runModuleName modName

4244 spacer

4345 for_ modComments tell'

4446 mapM_ (declAsMarkdown modName) modDeclarations

4547 spacer

4648 for_ modReExports $ \(mn, decls) -> do

47− headerLevel 3 $ "Re-exported from " ++ T.unpack (P.runModuleName mn) ++ ":"

49+ headerLevel 3 $ "Re-exported from " <> P.runModuleName mn <> ":"

4850 spacer

4951 mapM_ (declAsMarkdown mn) decls

5052

@@ -71,7 +73,7 @@ declAsMarkdown mn decl@Declaration{..} = do

7173 isChildInstance (ChildInstance _ _) = True

7274 isChildInstance _ = False

7375

74−codeToString :: RenderedCode -> String

76+codeToString :: RenderedCode -> Text

7577codeToString = outputWith elemAsMarkdown

7678 where

7779 elemAsMarkdown (Syntax x) = x

@@ -95,14 +97,14 @@ codeToString = outputWith elemAsMarkdown

9597-- P.Infixr -> "right-associative"

9698-- P.Infix -> "non-associative"

9799

98−childToString :: First -> ChildDeclaration -> String

100+childToString :: First -> ChildDeclaration -> Text

99101childToString f decl@ChildDeclaration{..} =

100102 case cdeclInfo of

101103 ChildDataConstructor _ ->

102104 let c = if f == First then "=" else "|"

103− in " " ++ c ++ " " ++ str

105+ in " " <> c <> " " <> str

104106 ChildTypeClassMember _ ->

105− " " ++ str

107+ " " <> str

106108 ChildInstance _ _ ->

107109 str

108110 where

@@ -113,19 +115,19 @@ data First

113115 | NotFirst

114116 deriving (Show, Eq, Ord)

115117

116−type Docs = Writer [String] ()

118+type Docs = Writer [Text] ()

117119

118−runDocs :: Docs -> String

119−runDocs = unlines . execWriter

120+runDocs :: Docs -> Text

121+runDocs = T.unlines . execWriter

120122

121−tell' :: String -> Docs

123+tell' :: Text -> Docs

122124tell' = tell . (:[])

123125

124126spacer :: Docs

125127spacer = tell' ""

126128

127−headerLevel :: Int -> String -> Docs

128−headerLevel level hdr = tell' (replicate level '#' ++ ' ' : hdr)

129+headerLevel :: Int -> Text -> Docs

130+headerLevel level hdr = tell' (T.replicate level "#" <> " " <> hdr)

129131

130132fencedBlock :: Docs -> Docs

131133fencedBlock inner = do

@@ -133,5 +135,5 @@ fencedBlock inner = do

133135 inner

134136 tell' "```"

135137

136−ticks :: String -> String

137−ticks = ("`" ++) . (++ "`")

138+ticks :: Text -> Text

139+ticks = ("`" <>) . (<> "`")

src/Language/PureScript/Docs/Convert.hs+3−3

@@ -16,7 +16,7 @@ import Control.Monad.Error.Class (MonadError)

1616import Control.Monad.State (runStateT)

1717import Control.Monad.Writer.Strict (runWriterT)

1818import qualified Data.Map as Map

19−import qualified Data.Text as T

19+import Data.Text (Text)

2020

2121import Language.PureScript.Docs.Convert.ReExports (updateReExports)

2222import Language.PureScript.Docs.Convert.Single (convertSingleModule, collectBookmarks)

@@ -167,9 +167,9 @@ insertValueTypes env m =

167167 err msg =

168168 P.internalError ("Docs.Convert.insertValueTypes: " ++ msg)

169169

170−runParser :: P.TokenParser a -> String -> Either String a

170+runParser :: P.TokenParser a -> Text -> Either String a

171171runParser p s = either (Left . show) Right $ do

172− ts <- P.lex "" (T.pack s)

172+ ts <- P.lex "" s

173173 P.runTokenParser "" (p <* eof) ts

174174

175175-- |

src/Language/PureScript/Docs/Convert/ReExports.hs+18−17

@@ -4,7 +4,7 @@ module Language.PureScript.Docs.Convert.ReExports

55import Prelude.Compat

7−import Control.Arrow ((&&&), first, second)

7+import Control.Arrow ((&&&), second)

88import Control.Monad

99import Control.Monad.Reader.Class (MonadReader, ask)

1010import Control.Monad.State.Class (MonadState, gets, modify)

@@ -16,6 +16,7 @@ import Data.Map (Map)

1616import Data.Maybe (mapMaybe)

1717import Data.Monoid ((<>))

1818import qualified Data.Map as Map

19+import Data.Text (Text)

1920import qualified Data.Text as T

2021

2122import Language.PureScript.Docs.Types

@@ -184,12 +185,12 @@ lookupValueDeclaration ::

184185 MonadReader P.ModuleName m) =>

185186 P.ModuleName ->

186187 P.Ident ->

187− m (P.ModuleName, [Either (String, P.Constraint, ChildDeclaration) Declaration])

188+ m (P.ModuleName, [Either (Text, P.Constraint, ChildDeclaration) Declaration])

188189lookupValueDeclaration importedFrom ident = do

189190 decls <- lookupModuleDeclarations "lookupValueDeclaration" importedFrom

190191 let

191192 rs =

192− filter (\d -> declTitle d == T.unpack (P.showIdent ident)

193+ filter (\d -> declTitle d == P.showIdent ident

193194 && (isValue d || isValueAlias d)) decls

194195 errOther other =

195196 internalErrorInModule

@@ -215,7 +216,7 @@ lookupValueDeclaration importedFrom ident = do

215216 (declChildren d))

216217

217218 matchesIdent cdecl =

218− cdeclTitle cdecl == T.unpack (P.showIdent ident)

219+ cdeclTitle cdecl == P.showIdent ident

219220

220221 matchesAndIsTypeClassMember =

221222 uncurry (&&) . (matchesIdent &&& isTypeClassMember)

@@ -239,7 +240,7 @@ lookupValueOpDeclaration

239240 -> m (P.ModuleName, [Declaration])

240241lookupValueOpDeclaration importedFrom op = do

241242 decls <- lookupModuleDeclarations "lookupValueOpDeclaration" importedFrom

242− case filter (\d -> declTitle d == T.unpack (P.showOp op) && isValueAlias d) decls of

243+ case filter (\d -> declTitle d == P.showOp op && isValueAlias d) decls of

243244 [d] ->

244245 pure (importedFrom, [d])

245246 other ->

@@ -259,7 +260,7 @@ lookupTypeDeclaration ::

259260lookupTypeDeclaration importedFrom ty = do

260261 decls <- lookupModuleDeclarations "lookupTypeDeclaration" importedFrom

261262 let

262− ds = filter (\d -> declTitle d == T.unpack (P.runProperName ty) && isType d) decls

263+ ds = filter (\d -> declTitle d == P.runProperName ty && isType d) decls

263264 case ds of

264265 [d] ->

265266 pure (importedFrom, [d])

@@ -275,7 +276,7 @@ lookupTypeOpDeclaration

275276lookupTypeOpDeclaration importedFrom tyOp = do

276277 decls <- lookupModuleDeclarations "lookupTypeOpDeclaration" importedFrom

277278 let

278− ds = filter (\d -> declTitle d == ("type " ++ T.unpack (P.showOp tyOp)) && isTypeAlias d) decls

279+ ds = filter (\d -> declTitle d == ("type " <> P.showOp tyOp) && isTypeAlias d) decls

279280 case ds of

280281 [d] ->

281282 pure (importedFrom, [d])

@@ -291,7 +292,7 @@ lookupTypeClassDeclaration

291292lookupTypeClassDeclaration importedFrom tyClass = do

292293 decls <- lookupModuleDeclarations "lookupTypeClassDeclaration" importedFrom

293294 let

294− ds = filter (\d -> declTitle d == T.unpack (P.runProperName tyClass)

295+ ds = filter (\d -> declTitle d == P.runProperName tyClass

295296 && isTypeClass d)

296297 decls

297298 case ds of

@@ -324,7 +325,7 @@ lookupModuleDeclarations definedIn moduleName = do

324325

325326handleTypeClassMembers ::

326327 (MonadReader P.ModuleName m) =>

327− Map P.ModuleName [Either (String, P.Constraint, ChildDeclaration) Declaration] ->

328+ Map P.ModuleName [Either (Text, P.Constraint, ChildDeclaration) Declaration] ->

328329 Map P.ModuleName [Declaration] ->

329330 m (Map P.ModuleName [Declaration], Map P.ModuleName [Declaration])

330331handleTypeClassMembers valsAndMembers typeClasses =

@@ -339,7 +340,7 @@ handleTypeClassMembers valsAndMembers typeClasses =

339340 |> fmap splitMap

340341

341342valsAndMembersToEnv ::

342− [Either (String, P.Constraint, ChildDeclaration) Declaration] -> TypeClassEnv

343+ [Either (Text, P.Constraint, ChildDeclaration) Declaration] -> TypeClassEnv

343344valsAndMembersToEnv xs =

344345 let (envUnhandledMembers, envValues) = partitionEithers xs

345346 envTypeClasses = []

@@ -360,11 +361,11 @@ typeClassesToEnv classes =

360361--

361362data TypeClassEnv = TypeClassEnv

362363 { -- |

363− -- Type class members which have not yet been dealt with. The String is the

364+ -- Type class members which have not yet been dealt with. The Text is the

364365 -- name of the type class they belong to, and the constraint is used to

365366 -- make sure that they have the correct type if they get promoted.

366367 --

367− envUnhandledMembers :: [(String, P.Constraint, ChildDeclaration)]

368+ envUnhandledMembers :: [(Text, P.Constraint, ChildDeclaration)]

368369 -- |

369370 -- A list of normal value declarations. Type class members will be added to

370371 -- this list if their parent type class is not available.

@@ -428,7 +429,7 @@ handleEnv TypeClassEnv{..} =

428429 _ ->

429430 internalErrorInModule

430431 ("handleEnv: Bad child declaration passed to promoteChild: "

431− ++ cdeclTitle)

432+ ++ T.unpack cdeclTitle)

432433

433434 addConstraint constraint =

434435 P.quantify . P.moveQuantifiersToFront . P.ConstrainedType [constraint]

@@ -448,7 +449,7 @@ filterDataConstructors

448449 -> Map P.ModuleName [Declaration]

449450 -> Map P.ModuleName [Declaration]

450451filterDataConstructors =

451− filterExportedChildren isDataConstructor (T.unpack . P.runProperName)

452+ filterExportedChildren isDataConstructor P.runProperName

452453

453454-- |

454455-- Given a list of exported type class member names, remove any data

@@ -460,12 +461,12 @@ filterTypeClassMembers

460461 -> Map P.ModuleName [Declaration]

461462 -> Map P.ModuleName [Declaration]

462463filterTypeClassMembers =

463− filterExportedChildren isTypeClassMember (T.unpack . P.showIdent)

464+ filterExportedChildren isTypeClassMember P.showIdent

464465

465466filterExportedChildren

466467 :: (Functor f)

467468 => (ChildDeclaration -> Bool)

468− -> (name -> String)

469+ -> (name -> Text)

469470 -> [name]

470471 -> f [Declaration]

471472 -> f [Declaration]

@@ -504,7 +505,7 @@ typeClassConstraintFor :: Declaration -> Maybe P.Constraint

504505typeClassConstraintFor Declaration{..} =

505506 case declInfo of

506507 TypeClassDeclaration tyArgs _ _ ->

507− Just (P.Constraint (P.Qualified Nothing (P.ProperName (T.pack declTitle))) (mkConstraint (map (first T.pack) tyArgs)) Nothing)

508+ Just (P.Constraint (P.Qualified Nothing (P.ProperName declTitle)) (mkConstraint tyArgs) Nothing)

508509 _ ->

509510 Nothing

510511 where

src/Language/PureScript/Docs/Convert/Single.hs+26−31

@@ -5,13 +5,12 @@ module Language.PureScript.Docs.Convert.Single

66import Prelude.Compat

8−import Control.Arrow (first)

98import Control.Category ((>>>))

109import Control.Monad

1110

1211import Data.Either

1312import Data.List (nub)

14−import Data.Maybe (mapMaybe)

13+import Data.Maybe (mapMaybe, fromMaybe)

1514import Data.Monoid ((<>))

1615import Data.Text (Text)

1716import qualified Data.Text as T

@@ -19,8 +18,6 @@ import qualified Data.Text as T

1918import Language.PureScript.Docs.Types

2019import qualified Language.PureScript as P

2120

22−-- TODO (Christoph): Get rid of the T.unpack s

23−

2421-- |

2522-- Convert a single Module, but ignore re-exports; any re-exported types or

2623-- values will not appear in the result.

@@ -46,14 +43,14 @@ convertSingleModule m@(P.Module _ coms moduleName _ _) =

4643-- In the second pass, we go over all of the Left values and augment the

4744-- relevant declarations, leaving only the augmented Right values.

4845--

49−-- Note that in the Left case, we provide a [String] as well as augment

50−-- information. The [String] value should be a list of titles of declarations

46+-- Note that in the Left case, we provide a [Text] as well as augment

47+-- information. The [Text] value should be a list of titles of declarations

5148-- that the augmentation should apply to. For example, for a type instance

5249-- declaration, that would be any types or type classes mentioned in the

5350-- instance. For a fixity declaration, it would be just the relevant operator's

5451-- name.

5552type IntermediateDeclaration

56− = Either ([String], DeclarationAugment) Declaration

53+ = Either ([Text], DeclarationAugment) Declaration

5754

5855-- | Some data which will be used to augment a Declaration in the

5956-- output.

@@ -97,7 +94,7 @@ getDeclarationTitle _ = Nothing

9794-- | Create a basic Declaration value.

9895mkDeclaration :: Text -> DeclarationInfo -> Declaration

9996mkDeclaration title info =

100− Declaration { declTitle = T.unpack title

97+ Declaration { declTitle = title

10198 , declComments = Nothing

10299 , declSourceSpan = Nothing

103100 , declChildren = []

@@ -119,27 +116,27 @@ convertDeclaration (P.ExternDeclaration _ ty) title =

119116convertDeclaration (P.DataDeclaration dtype _ args ctors) title =

120117 Just (Right (mkDeclaration title info) { declChildren = children })

121118 where

122− info = DataDeclaration dtype (map (first T.unpack) args)

119+ info = DataDeclaration dtype args

123120 children = map convertCtor ctors

124121 convertCtor (ctor', tys) =

125− ChildDeclaration (T.unpack (P.runProperName ctor')) Nothing Nothing (ChildDataConstructor tys)

122+ ChildDeclaration (P.runProperName ctor') Nothing Nothing (ChildDataConstructor tys)

126123convertDeclaration (P.ExternDataDeclaration _ kind') title =

127124 basicDeclaration title (ExternDataDeclaration kind')

128125convertDeclaration (P.TypeSynonymDeclaration _ args ty) title =

129− basicDeclaration title (TypeSynonymDeclaration (map (first T.unpack) args) ty)

126+ basicDeclaration title (TypeSynonymDeclaration args ty)

130127convertDeclaration (P.TypeClassDeclaration _ args implies fundeps ds) title =

131128 Just (Right (mkDeclaration title info) { declChildren = children })

132129 where

133− info = TypeClassDeclaration (map (first T.unpack) args) implies (convertFundepsToStrings args fundeps)

130+ info = TypeClassDeclaration args implies (convertFundepsToStrings args fundeps)

134131 children = map convertClassMember ds

135132 convertClassMember (P.PositionedDeclaration _ _ d) =

136133 convertClassMember d

137134 convertClassMember (P.TypeDeclaration ident' ty) =

138− ChildDeclaration (T.unpack (P.showIdent ident')) Nothing Nothing (ChildTypeClassMember ty)

135+ ChildDeclaration (P.showIdent ident') Nothing Nothing (ChildTypeClassMember ty)

139136 convertClassMember _ =

140137 P.internalError "convertDeclaration: Invalid argument to convertClassMember."

141138convertDeclaration (P.TypeInstanceDeclaration _ constraints className tys _) title =

142− Just (Left (T.unpack classNameString : map T.unpack typeNameStrings, AugmentChild childDecl))

139+ Just (Left (classNameString : typeNameStrings, AugmentChild childDecl))

143140 where

144141 classNameString = unQual className

145142 typeNameStrings = nub (concatMap (P.everythingOnTypes (++) extractProperNames) tys)

@@ -148,7 +145,7 @@ convertDeclaration (P.TypeInstanceDeclaration _ constraints className tys _) tit

148145 extractProperNames (P.TypeConstructor n) = [unQual n]

149146 extractProperNames _ = []

150147

151− childDecl = ChildDeclaration (T.unpack title) Nothing Nothing (ChildInstance constraints classApp)

148+ childDecl = ChildDeclaration title Nothing Nothing (ChildInstance constraints classApp)

152149 classApp = foldl P.TypeApp (P.TypeConstructor (fmap P.coerceProperName className)) tys

153150convertDeclaration (P.ValueFixityDeclaration fixity (P.Qualified mn alias) _) title =

154151 Just $ Right $ mkDeclaration title (AliasDeclaration fixity (P.Qualified mn (Right alias)))

@@ -172,25 +169,24 @@ convertDeclaration (P.PositionedDeclaration srcSpan com d') title =

172169 withAugmentChild f (t, AugmentChild d) = (t, AugmentChild (f d))

173170convertDeclaration _ _ = Nothing

174171

175−convertComments :: [P.Comment] -> Maybe String

172+convertComments :: [P.Comment] -> Maybe Text

176173convertComments cs = do

177174 let raw = concatMap toLines cs

178175 let docs = mapMaybe stripPipe raw

179176 guard (not (null docs))

180− pure (unlines docs)

177+ pure (T.unlines docs)

181178

182179 where

183− toLines (P.LineComment s) = [T.unpack s]

184− toLines (P.BlockComment s) = lines (T.unpack s)

185−

186− stripPipe s' =

187− case dropWhile (== ' ') s' of

188− ('|':' ':s) ->

189− Just s

190− ('|':s) ->

191− Just s

192− _ ->

193− Nothing

180+ toLines (P.LineComment s) = [s]

181+ toLines (P.BlockComment s) = T.lines s

182+

183+ stripPipe =

184+ T.dropWhile (== ' ')

185+ >>> T.stripPrefix "|"

186+ >>> fmap (dropPrefix " ")

187+

188+ dropPrefix prefix str =

189+ fromMaybe str (T.stripPrefix prefix str)

194190

195191-- | Go through a PureScript module and extract a list of Bookmarks; references

196192-- to data types or values, to be used as a kind of index. These are used for

@@ -199,8 +195,7 @@ collectBookmarks :: InPackage P.Module -> [Bookmark]

199195collectBookmarks (Local m) = map Local (collectBookmarks' m)

200196collectBookmarks (FromDep pkg m) = map (FromDep pkg) (collectBookmarks' m)

201197

202−collectBookmarks' :: P.Module -> [(P.ModuleName, String)]

198+collectBookmarks' :: P.Module -> [(P.ModuleName, Text)]

203199collectBookmarks' m =

204200 map (P.getModuleName m, )

205− (mapMaybe (fmap T.unpack . getDeclarationTitle)

206− (P.exportedDeclarations m))

201+ (mapMaybe getDeclarationTitle (P.exportedDeclarations m))

src/Language/PureScript/Docs/Prim.hs+22−22

@@ -2,7 +2,7 @@

22module Language.PureScript.Docs.Prim (primDocsModule) where

44import Prelude.Compat hiding (fail)

5−import Control.Arrow (first)

5+import Data.Text (Text)

66import qualified Data.Text as T

77import qualified Data.Map as Map

88import Language.PureScript.Docs.Types

@@ -30,18 +30,18 @@ primDocsModule = Module

3030 }

3131

3232unsafeLookup :: forall v (a :: P.ProperNameType).

33− Map.Map (P.Qualified (P.ProperName a)) v -> String -> String -> v

34−unsafeLookup m errorMsg ty = go ty

33+ Map.Map (P.Qualified (P.ProperName a)) v -> String -> Text -> v

34+unsafeLookup m errorMsg name = go name

3535 where

36− go = fromJust' . flip Map.lookup m . P.primName . T.pack

36+ go = fromJust' . flip Map.lookup m . P.primName

3737

3838 fromJust' (Just x) = x

39− fromJust' _ = P.internalError $ errorMsg ++ ty

39+ fromJust' _ = P.internalError $ errorMsg ++ show name

4040

41−lookupPrimKind :: String -> P.Kind

41+lookupPrimKind :: Text -> P.Kind

4242lookupPrimKind = fst . unsafeLookup P.primTypes "Docs.Prim: No such Prim type: "

4343

44−primType :: String -> String -> Declaration

44+primType :: Text -> Text -> Declaration

4545primType title comments = Declaration

4646 { declTitle = title

4747 , declComments = Just comments

@@ -52,10 +52,10 @@ primType title comments = Declaration

5252

5353-- | Lookup the TypeClassData of a Prim class. This function is specifically

5454-- not exported because it is partial.

55−lookupPrimClass :: String -> P.TypeClassData

55+lookupPrimClass :: Text -> P.TypeClassData

5656lookupPrimClass = unsafeLookup P.primClasses "Docs.Prim: No such Prim class: "

5757

58−primClass :: String -> String -> Declaration

58+primClass :: Text -> Text -> Declaration

5959primClass title comments = Declaration

6060 { declTitle = title

6161 , declComments = Just comments

@@ -68,11 +68,11 @@ primClass title comments = Declaration

6868 superclasses = P.typeClassSuperclasses tcd

6969 fundeps = convertFundepsToStrings args (P.typeClassDependencies tcd)

7070 in

71− TypeClassDeclaration (map (first T.unpack) args) superclasses fundeps

71+ TypeClassDeclaration args superclasses fundeps

7272 }

7373

7474function :: Declaration

75−function = primType "Function" $ unlines

75+function = primType "Function" $ T.unlines

7676 [ "A function, which takes values of the type specified by the first type"

7777 , "parameter, and returns values of the type specified by the second."

7878 , "In the JavaScript backend, this is a standard JavaScript Function."

@@ -91,7 +91,7 @@ function = primType "Function" $ unlines

9191 ]

9292

9393array :: Declaration

94−array = primType "Array" $ unlines

94+array = primType "Array" $ T.unlines

9595 [ "An Array: a data structure supporting efficient random access. In"

9696 , "the JavaScript backend, values of this type are represented as JavaScript"

9797 , "Arrays at runtime."

@@ -102,7 +102,7 @@ array = primType "Array" $ unlines

102102 ]

103103

104104record :: Declaration

105−record = primType "Record" $ unlines

105+record = primType "Record" $ T.unlines

106106 [ "The type of records whose fields are known at compile time. In the"

107107 , "JavaScript backend, values of this type are represented as JavaScript"

108108 , "Objects at runtime."

@@ -118,7 +118,7 @@ record = primType "Record" $ unlines

118118 ]

119119

120120number :: Declaration

121−number = primType "Number" $ unlines

121+number = primType "Number" $ T.unlines

122122 [ "A double precision floating point number (IEEE 754)."

123123 , ""

124124 , "Construct values of this type with literals:"

@@ -128,7 +128,7 @@ number = primType "Number" $ unlines

128128 ]

129129

130130int :: Declaration

131−int = primType "Int" $ unlines

131+int = primType "Int" $ T.unlines

132132 [ "A 32-bit signed integer. See the purescript-integers package for details"

133133 , "of how this is accomplished when compiling to JavaScript."

134134 , ""

@@ -138,7 +138,7 @@ int = primType "Int" $ unlines

138138 ]

139139

140140string :: Declaration

141−string = primType "String" $ unlines

141+string = primType "String" $ T.unlines

142142 [ "A String. As in JavaScript, String values represent sequences of UTF-16"

143143 , "code units, which are not required to form a valid encoding of Unicode"

144144 , "text (for example, lone surrogates are permitted)."

@@ -151,7 +151,7 @@ string = primType "String" $ unlines

151151 ]

152152

153153char :: Declaration

154−char = primType "Char" $ unlines

154+char = primType "Char" $ T.unlines

155155 [ "A single character (UTF-16 code unit). The JavaScript representation is a"

156156 , "normal String, which is guaranteed to contain one code unit. This means"

157157 , "that astral plane characters (i.e. those with code point values greater"

@@ -163,14 +163,14 @@ char = primType "Char" $ unlines

163163 ]

164164

165165boolean :: Declaration

166−boolean = primType "Boolean" $ unlines

166+boolean = primType "Boolean" $ T.unlines

167167 [ "A JavaScript Boolean value."

168168 , ""

169169 , "Construct values of this type with the literals `true` and `false`."

170170 ]

171171

172172partial :: Declaration

173−partial = primClass "Partial" $ unlines

173+partial = primClass "Partial" $ T.unlines

174174 [ "The Partial type class is used to indicate that a function is *partial,*"

175175 , "that is, it is not defined for all inputs. In practice, attempting to use"

176176 , "a partial function with a bad input will usually cause an error to be"

@@ -180,7 +180,7 @@ partial = primClass "Partial" $ unlines

180180 ]

181181

182182fail :: Declaration

183−fail = primClass "Fail" $ unlines

183+fail = primClass "Fail" $ T.unlines

184184 [ "The Fail type class is part of the custom type errors feature. To provide"

185185 , "a custom type error when someone tries to use a particular instance,"

186186 , "write that instance out with a Fail constraint."

@@ -190,7 +190,7 @@ fail = primClass "Fail" $ unlines

190190 ]

191191

192192typeConcat :: Declaration

193−typeConcat = primType "TypeConcat" $ unlines

193+typeConcat = primType "TypeConcat" $ T.unlines

194194 [ "The TypeConcat type constructor concatenates two Symbols in a custom type"

195195 , "error."

196196 , ""

@@ -199,7 +199,7 @@ typeConcat = primType "TypeConcat" $ unlines

199199 ]

200200

201201typeString :: Declaration

202−typeString = primType "TypeString" $ unlines

202+typeString = primType "TypeString" $ T.unlines

203203 [ "The TypeString type constructor renders any concrete type into a Symbol"

204204 , "in a custom type error."

205205 , ""

src/Language/PureScript/Docs/Render.hs+13−16

@@ -13,16 +13,14 @@ import Prelude.Compat

1313

1414import Data.Maybe (maybeToList)

1515import Data.Monoid ((<>))

16−import qualified Data.Text as T

1716import Data.Text (Text)

17+import qualified Data.Text as T

1818

1919import Language.PureScript.Docs.RenderedCode

2020import Language.PureScript.Docs.Types

2121import Language.PureScript.Docs.Utils.MonoidExtras

2222import qualified Language.PureScript as P

2323

24−-- TODO (Christoph): get rid of T.unpack's

25−

2624renderDeclaration :: Declaration -> RenderedCode

2725renderDeclaration = renderDeclarationWithOptions defaultRenderTypeOptions

2826

@@ -35,7 +33,7 @@ renderDeclarationWithOptions opts Declaration{..} =

3533 , renderType' ty

3634 ]

3735 DataDeclaration dtype args ->

38− [ keyword (T.unpack (P.showDataDeclType dtype))

36+ [ keyword (P.showDataDeclType dtype)

3937 , renderType' (typeApp declTitle args)

4038 ]

4139 ExternDataDeclaration kind' ->

@@ -76,7 +74,7 @@ renderDeclarationWithOptions opts Declaration{..} =

7674

7775 AliasDeclaration (P.Fixity associativity precedence) for@(P.Qualified _ alias) ->

7876 [ keywordFixity associativity

79− , syntax $ show precedence

77+ , syntax $ T.pack $ show precedence

8078 , ident $ renderQualAlias for

8179 , keyword "as"

8280 , ident $ adjustAliasName alias declTitle

@@ -86,10 +84,10 @@ renderDeclarationWithOptions opts Declaration{..} =

8684 renderType' :: P.Type -> RenderedCode

8785 renderType' = renderTypeWithOptions opts

8886

89− renderQualAlias :: FixityAlias -> String

87+ renderQualAlias :: FixityAlias -> Text

9088 renderQualAlias (P.Qualified mn alias)

91− | mn == currentModule opts = T.unpack (renderAlias id alias)

92− | otherwise = T.unpack (renderAlias (\f -> P.showQualified f . P.Qualified mn) alias)

89+ | mn == currentModule opts = renderAlias id alias

90+ | otherwise = renderAlias (\f -> P.showQualified f . P.Qualified mn) alias

9391

9492 renderAlias

9593 :: (forall a. (a -> Text) -> a -> Text)

@@ -99,8 +97,7 @@ renderDeclarationWithOptions opts Declaration{..} =

9997 = either (("type " <>) . f P.runProperName)

10098 $ either (f P.runIdent) (f P.runProperName)

10199

102− -- adjustAliasName (P.AliasType{}) title = drop 6 (init title)

103− adjustAliasName _ title = tail (init title)

100+ adjustAliasName _ title = T.tail (T.init title)

104101

105102renderChildDeclaration :: ChildDeclaration -> RenderedCode

106103renderChildDeclaration = renderChildDeclarationWithOptions defaultRenderTypeOptions

@@ -146,15 +143,15 @@ renderConstraintsWithOptions opts constraints

146143 mintersperse (syntax "," <> sp)

147144 (map (renderConstraintWithOptions opts) constraints)

148145

149−notQualified :: String -> P.Qualified (P.ProperName a)

150−notQualified = P.Qualified Nothing . P.ProperName . T.pack

146+notQualified :: Text -> P.Qualified (P.ProperName a)

147+notQualified = P.Qualified Nothing . P.ProperName

151148

152−typeApp :: String -> [(String, Maybe P.Kind)] -> P.Type

149+typeApp :: Text -> [(Text, Maybe P.Kind)] -> P.Type

153150typeApp title typeArgs =

154151 foldl P.TypeApp

155152 (P.TypeConstructor (notQualified title))

156153 (map toTypeVar typeArgs)

157154

158−toTypeVar :: (String, Maybe P.Kind) -> P.Type

159−toTypeVar (s, Nothing) = P.TypeVar (T.pack s)

160−toTypeVar (s, Just k) = P.KindedType (P.TypeVar (T.pack s)) k

155+toTypeVar :: (Text, Maybe P.Kind) -> P.Type

156+toTypeVar (s, Nothing) = P.TypeVar s

157+toTypeVar (s, Just k) = P.KindedType (P.TypeVar s) k

src/Language/PureScript/Docs/RenderedCode/Render.hs+10−13

@@ -14,10 +14,9 @@ import Prelude.Compat

1414

1515import Data.Maybe (fromMaybe)

1616import Data.Monoid ((<>))

17−import qualified Data.Text as T

1817import Data.Text (Text)

1918

20−import Control.Arrow ((<+>), first)

19+import Control.Arrow ((<+>))

2120import Control.PatternArrows as PA

2221

2322import Language.PureScript.Crash

@@ -35,7 +34,7 @@ typeLiterals = mkPattern match

3534 match TypeWildcard{} =

3635 Just (syntax "_")

3736 match (TypeVar var) =

38− Just (ident (T.unpack var))

37+ Just (ident var)

3938 match (PrettyPrintObject row) =

4039 Just $ mintersperse sp

4140 [ syntax "{"

@@ -43,7 +42,7 @@ typeLiterals = mkPattern match

4342 , syntax "}"

4443 ]

4544 match (TypeConstructor (Qualified mn name)) =

46− Just (ctor (T.unpack (runProperName name)) (maybeToContainingModule mn))

45+ Just (ctor (runProperName name) (maybeToContainingModule mn))

4746 match REmpty =

4847 Just (syntax "()")

4948 match row@RCons{} =

@@ -51,7 +50,7 @@ typeLiterals = mkPattern match

5150 match (BinaryNoParensType op l r) =

5251 Just $ renderTypeAtom l <> sp <> renderTypeAtom op <> sp <> renderTypeAtom r

5352 match (TypeOp (Qualified mn op)) =

54− Just (ident' (T.unpack (runOpName op)) (maybeToContainingModule mn))

53+ Just (ident' (runOpName op) (maybeToContainingModule mn))

5554 match _ =

5655 Nothing

5756

@@ -76,16 +75,14 @@ renderConstraints deps ty =

7675-- Render code representing a Row

7776--

7877renderRow :: Type -> RenderedCode

79−renderRow = uncurry renderRow' . convertString . rowToList

78+renderRow = uncurry renderRow' . rowToList

8079 where

81− convertString :: ([(Text, Type)], Type) -> ([(String, Type)], Type)

82− convertString = first (map (first T.unpack))

8380 renderRow' h t = renderHead h <> renderTail t

8481

85−renderHead :: [(String, Type)] -> RenderedCode

82+renderHead :: [(Text, Type)] -> RenderedCode

8683renderHead = mintersperse (syntax "," <> sp) . map renderLabel

8784

88−renderLabel :: (String, Type) -> RenderedCode

85+renderLabel :: (Text, Type) -> RenderedCode

8986renderLabel (label, ty) =

9087 mintersperse sp

9188 [ ident label

@@ -145,10 +142,10 @@ matchType = buildPrettyPrinter operators matchTypeAtom

145142 , [ Wrap explicitParens $ \_ ty -> ty ]

146143 ]

147144

148−forall_ :: Pattern () Type ([String], Type)

145+forall_ :: Pattern () Type ([Text], Type)

149146forall_ = mkPattern match

150147 where

151− match (PrettyPrintForAll idents ty) = Just (map T.unpack idents, ty)

148+ match (PrettyPrintForAll idents ty) = Just (idents, ty)

152149 match _ = Nothing

153150

154151insertPlaceholders :: RenderTypeOptions -> Type -> Type

@@ -180,7 +177,7 @@ preprocessType opts = dePrim . insertPlaceholders opts

180177-- Render code representing a Kind

181178--

182179renderKind :: Kind -> RenderedCode

183−renderKind = kind . T.unpack . prettyPrintKind

180+renderKind = kind . prettyPrintKind

184181

185182-- |

186183-- Render code representing a Type, as it should appear inside parentheses

src/Language/PureScript/Docs/RenderedCode/Types.hs+21−21

@@ -37,7 +37,7 @@ import Control.Monad.Error.Class (MonadError(..))

3737

3838import Data.Aeson.BetterErrors

3939import qualified Data.Aeson as A

40−import qualified Data.Text as T

40+import Data.Text (Text)

4141

4242import qualified Language.PureScript as P

4343

@@ -46,11 +46,11 @@ import qualified Language.PureScript as P

4646-- multiple output formats. For example, plain text, or highlighted HTML.

4747--

4848data RenderedCodeElement

49− = Syntax String

50− | Ident String ContainingModule

51− | Ctor String ContainingModule

52− | Kind String

53− | Keyword String

49+ = Syntax Text

50+ | Ident Text ContainingModule

51+ | Ctor Text ContainingModule

52+ | Kind Text

53+ | Keyword Text

5454 | Space

5555 deriving (Show, Eq, Ord)

5656

@@ -66,9 +66,9 @@ instance A.ToJSON RenderedCodeElement where

6666 toJSON (Keyword str) =

6767 A.toJSON ["keyword", str]

6868 toJSON Space =

69− A.toJSON ["space" :: String]

69+ A.toJSON ["space" :: Text]

7070

71−asRenderedCodeElement :: Parse String RenderedCodeElement

71+asRenderedCodeElement :: Parse Text RenderedCodeElement

7272asRenderedCodeElement =

7373 a Syntax "syntax" <|>

7474 asIdent <|>

@@ -80,14 +80,14 @@ asRenderedCodeElement =

8080 where

8181 p <|> q = catchError p (const q)

8282

83− a ctor' ctorStr = ctor' <$> (nth 0 (withString (eq ctorStr)) *> nth 1 asString)

84− asIdent = nth 0 (withString (eq "ident")) *> (Ident <$> nth 1 asString <*> nth 2 asContainingModule)

85− asCtor = nth 0 (withString (eq "ctor")) *> (Ctor <$> nth 1 asString <*> nth 2 asContainingModule)

86− asSpace = nth 0 (withString (eq "space")) *> pure Space

83+ a ctor' ctorStr = ctor' <$> (nth 0 (withText (eq ctorStr)) *> nth 1 asText)

84+ asIdent = nth 0 (withText (eq "ident")) *> (Ident <$> nth 1 asText <*> nth 2 asContainingModule)

85+ asCtor = nth 0 (withText (eq "ctor")) *> (Ctor <$> nth 1 asText <*> nth 2 asContainingModule)

86+ asSpace = nth 0 (withText (eq "space")) *> pure Space

8787

8888 eq s s' = if s == s' then Right () else Left ""

8989

90− unableToParse = withString (Left . show)

90+ unableToParse = withText Left

9191

9292-- |

9393-- This type is isomorphic to 'Maybe' 'P.ModuleName'. It makes code a bit easier

@@ -103,7 +103,7 @@ instance A.ToJSON ContainingModule where

103103

104104asContainingModule :: Parse e ContainingModule

105105asContainingModule =

106− maybeToContainingModule <$> perhaps (P.moduleNameFromString . T.pack <$> asString)

106+ maybeToContainingModule <$> perhaps (P.moduleNameFromString <$> asText)

107107

108108-- |

109109-- Convert a 'Maybe' 'P.ModuleName' to a 'ContainingModule', using the obvious

@@ -139,7 +139,7 @@ newtype RenderedCode

139139instance A.ToJSON RenderedCode where

140140 toJSON (RC elems) = A.toJSON elems

141141

142−asRenderedCode :: Parse String RenderedCode

142+asRenderedCode :: Parse Text RenderedCode

143143asRenderedCode = RC <$> eachInArray asRenderedCodeElement

144144

145145-- |

@@ -157,22 +157,22 @@ outputWith f = foldMap f . unRC

157157sp :: RenderedCode

158158sp = RC [Space]

159159

160−syntax :: String -> RenderedCode

160+syntax :: Text -> RenderedCode

161161syntax x = RC [Syntax x]

162162

163−ident :: String -> RenderedCode

163+ident :: Text -> RenderedCode

164164ident x = RC [Ident x ThisModule]

165165

166−ident' :: String -> ContainingModule -> RenderedCode

166+ident' :: Text -> ContainingModule -> RenderedCode

167167ident' x m = RC [Ident x m]

168168

169−ctor :: String -> ContainingModule -> RenderedCode

169+ctor :: Text -> ContainingModule -> RenderedCode

170170ctor x m = RC [Ctor x m]

171171

172−kind :: String -> RenderedCode

172+kind :: Text -> RenderedCode

173173kind x = RC [Kind x]

174174

175−keyword :: String -> RenderedCode

175+keyword :: Text -> RenderedCode

176176keyword kw = RC [Keyword kw]

177177

178178keywordForall :: RenderedCode

src/Language/PureScript/Docs/Types.hs+44−46

@@ -9,12 +9,11 @@ import Prelude.Compat

99import Control.Arrow (first, (***))

1010import Control.Monad (when)

1111

12−import Data.Bifunctor (bimap)

1312import Data.Aeson ((.=))

1413import Data.Aeson.BetterErrors

1514import Data.ByteString.Lazy (ByteString)

1615import Data.Either (isLeft, isRight)

17−import Data.Maybe (mapMaybe)

16+import Data.Maybe (mapMaybe, fromMaybe)

1817import Data.Text (Text)

1918import Data.Version

2019import qualified Data.Vector as V

@@ -38,7 +37,7 @@ import Language.PureScript.Docs.RenderedCode as ReExports

3837data Package a = Package

3938 { pkgMeta :: PackageMeta

4039 , pkgVersion :: Version

41− , pkgVersionTag :: String

40+ , pkgVersionTag :: Text

4241 , pkgModules :: [Module]

4342 , pkgBookmarks :: [Bookmark]

4443 , pkgResolvedDependencies :: [(PackageName, Version)]

@@ -73,7 +72,7 @@ packageName = bowerName . pkgMeta

7372

7473data Module = Module

7574 { modName :: P.ModuleName

76− , modComments :: Maybe String

75+ , modComments :: Maybe Text

7776 , modDeclarations :: [Declaration]

7877 -- Re-exported values from other modules

7978 , modReExports :: [(P.ModuleName, [Declaration])]

@@ -81,8 +80,8 @@ data Module = Module

8180 deriving (Show, Eq, Ord)

8281

8382data Declaration = Declaration

84− { declTitle :: String

85− , declComments :: Maybe String

83+ { declTitle :: Text

84+ , declComments :: Maybe Text

8685 , declSourceSpan :: Maybe P.SourceSpan

8786 , declChildren :: [ChildDeclaration]

8887 , declInfo :: DeclarationInfo

@@ -109,7 +108,7 @@ data DeclarationInfo

109108 -- newtype) and its type arguments. Constructors are represented as child

110109 -- declarations.

111110 --

112− | DataDeclaration P.DataDeclType [(String, Maybe P.Kind)]

111+ | DataDeclaration P.DataDeclType [(Text, Maybe P.Kind)]

113112

114113 -- |

115114 -- A data type foreign import, with its kind.

@@ -119,13 +118,13 @@ data DeclarationInfo

119118 -- |

120119 -- A type synonym, with its type arguments and its type.

121120 --

122− | TypeSynonymDeclaration [(String, Maybe P.Kind)] P.Type

121+ | TypeSynonymDeclaration [(Text, Maybe P.Kind)] P.Type

123122

124123 -- |

125124 -- A type class, with its type arguments, its superclasses and functional

126125 -- dependencies. Instances and members are represented as child declarations.

127126 --

128− | TypeClassDeclaration [(String, Maybe P.Kind)] [P.Constraint] [([String], [String])]

127+ | TypeClassDeclaration [(Text, Maybe P.Kind)] [P.Constraint] [([Text], [Text])]

129128

130129 -- |

131130 -- An operator alias declaration, with the member the alias is for and the

@@ -134,14 +133,13 @@ data DeclarationInfo

134133 | AliasDeclaration P.Fixity FixityAlias

135134 deriving (Show, Eq, Ord)

136135

137−convertFundepsToStrings :: [(Text, Maybe P.Kind)] -> [P.FunctionalDependency] -> [([String], [String])]

136+convertFundepsToStrings :: [(Text, Maybe P.Kind)] -> [P.FunctionalDependency] -> [([Text], [Text])]

138137convertFundepsToStrings args fundeps =

139− map (bimap (map T.unpack) (map T.unpack)) fundeps'

138+ map (\(P.FunctionalDependency from to) -> toArgs from to) fundeps

140139 where

141− fundeps' = map (\(P.FunctionalDependency from to) -> toArgs from to) fundeps

142140 argsVec = V.fromList (map fst args)

143141 getArg i =

144− maybe

142+ fromMaybe

145143 (P.internalError $ unlines

146144 [ "convertDeclaration: Functional dependency index"

147145 , show i

@@ -150,12 +148,12 @@ convertFundepsToStrings args fundeps =

150148 , "Functional dependencies are"

151149 , show fundeps

152150 ]

153− ) id $ argsVec V.!? i

151+ ) $ argsVec V.!? i

154152 toArgs from to = (map getArg from, map getArg to)

155153

156154type FixityAlias = P.Qualified (Either (P.ProperName 'P.TypeName) (Either P.Ident (P.ProperName 'P.ConstructorName)))

157155

158−declInfoToString :: DeclarationInfo -> String

156+declInfoToString :: DeclarationInfo -> Text

159157declInfoToString (ValueDeclaration _) = "value"

160158declInfoToString (DataDeclaration _ _) = "data"

161159declInfoToString (ExternDataDeclaration _) = "externData"

@@ -201,8 +199,8 @@ filterChildren p decl =

201199 decl { declChildren = filter p (declChildren decl) }

202200

203201data ChildDeclaration = ChildDeclaration

204− { cdeclTitle :: String

205− , cdeclComments :: Maybe String

202+ { cdeclTitle :: Text

203+ , cdeclComments :: Maybe Text

206204 , cdeclSourceSpan :: Maybe P.SourceSpan

207205 , cdeclInfo :: ChildDeclarationInfo

208206 }

@@ -227,7 +225,7 @@ data ChildDeclarationInfo

227225 | ChildTypeClassMember P.Type

228226 deriving (Show, Eq, Ord)

229227

230−childDeclInfoToString :: ChildDeclarationInfo -> String

228+childDeclInfoToString :: ChildDeclarationInfo -> Text

231229childDeclInfoToString (ChildInstance _ _) = "instance"

232230childDeclInfoToString (ChildDataConstructor _) = "dataConstructor"

233231childDeclInfoToString (ChildTypeClassMember _) = "typeClassMember"

@@ -245,11 +243,11 @@ isDataConstructor ChildDeclaration{..} =

245243 _ -> False

246244

247245newtype GithubUser

248− = GithubUser { runGithubUser :: String }

246+ = GithubUser { runGithubUser :: Text }

249247 deriving (Show, Eq, Ord)

250248

251249newtype GithubRepo

252− = GithubRepo { runGithubRepo :: String }

250+ = GithubRepo { runGithubRepo :: Text }

253251 deriving (Show, Eq, Ord)

254252

255253data PackageError

@@ -258,14 +256,14 @@ data PackageError

258256 -- parser, and actual version used.

259257 | ErrorInPackageMeta BowerError

260258 | InvalidVersion

261− | InvalidDeclarationType String

262− | InvalidChildDeclarationType String

259+ | InvalidDeclarationType Text

260+ | InvalidChildDeclarationType Text

263261 | InvalidFixity

264− | InvalidKind String

265− | InvalidDataDeclType String

262+ | InvalidKind Text

263+ | InvalidDataDeclType Text

266264 deriving (Show, Eq, Ord)

267265

268−type Bookmark = InPackage (P.ModuleName, String)

266+type Bookmark = InPackage (P.ModuleName, Text)

269267

270268data InPackage a

271269 = Local a

@@ -307,7 +305,7 @@ asPackage minimumVersion uploader = do

307305

308306 Package <$> key "packageMeta" asPackageMeta .! ErrorInPackageMeta

309307 <*> key "version" asVersion

310− <*> key "versionTag" asString

308+ <*> key "versionTag" asText

311309 <*> key "modules" (eachInArray asModule)

312310 <*> key "bookmarks" asBookmarks .! ErrorInPackageMeta

313311 <*> key "resolvedDependencies" asResolvedDependencies

@@ -338,15 +336,15 @@ displayPackageError e = case e of

338336 InvalidVersion ->

339337 "Invalid version"

340338 InvalidDeclarationType str ->

341− "Invalid declaration type: \"" <> T.pack str <> "\""

339+ "Invalid declaration type: \"" <> str <> "\""

342340 InvalidChildDeclarationType str ->

343− "Invalid child declaration type: \"" <> T.pack str <> "\""

341+ "Invalid child declaration type: \"" <> str <> "\""

344342 InvalidFixity ->

345343 "Invalid fixity"

346344 InvalidKind str ->

347− "Invalid kind: \"" <> T.pack str <> "\""

345+ "Invalid kind: \"" <> str <> "\""

348346 InvalidDataDeclType str ->

349− "Invalid data declaration type: \"" <> T.pack str <> "\""

347+ "Invalid data declaration type: \"" <> str <> "\""

350348 where

351349 (<>) = T.append

352350

@@ -355,7 +353,7 @@ instance A.FromJSON a => A.FromJSON (Package a) where

355353 (asPackage (Version [0,0,0,0] []) fromAesonParser)

356354

357355asGithubUser :: Parse e GithubUser

358−asGithubUser = GithubUser <$> asString

356+asGithubUser = GithubUser <$> asText

359357

360358instance A.FromJSON GithubUser where

361359 parseJSON = toAesonParser' asGithubUser

@@ -372,14 +370,14 @@ parseVersion' str =

372370asModule :: Parse PackageError Module

373371asModule =

374372 Module <$> key "name" (P.moduleNameFromString <$> asText)

375− <*> key "comments" (perhaps asString)

373+ <*> key "comments" (perhaps asText)

376374 <*> key "declarations" (eachInArray asDeclaration)

377375 <*> key "reExports" (eachInArray asReExport)

378376

379377asDeclaration :: Parse PackageError Declaration

380378asDeclaration =

381− Declaration <$> key "title" asString

382− <*> key "comments" (perhaps asString)

379+ Declaration <$> key "title" asText

380+ <*> key "comments" (perhaps asText)

383381 <*> key "sourceSpan" (perhaps asSourceSpan)

384382 <*> key "children" (eachInArray asChildDeclaration)

385383 <*> key "info" asDeclarationInfo

@@ -417,7 +415,7 @@ asAssociativity = withString (maybe (Left InvalidFixity) Right . parseAssociativ

417415

418416asDeclarationInfo :: Parse PackageError DeclarationInfo

419417asDeclarationInfo = do

420− ty <- key "declType" asString

418+ ty <- key "declType" asText

421419 case ty of

422420 "value" ->

423421 ValueDeclaration <$> key "type" asType

@@ -439,10 +437,10 @@ asDeclarationInfo = do

439437 other ->

440438 throwCustomError (InvalidDeclarationType other)

441439

442−asTypeArguments :: Parse PackageError [(String, Maybe P.Kind)]

440+asTypeArguments :: Parse PackageError [(Text, Maybe P.Kind)]

443441asTypeArguments = eachInArray asTypeArgument

444442 where

445− asTypeArgument = (,) <$> nth 0 asString <*> nth 1 (perhaps asKind)

443+ asTypeArgument = (,) <$> nth 0 asText <*> nth 1 (perhaps asKind)

446444

447445asKind :: Parse e P.Kind

448446asKind = fromAesonParser

@@ -450,28 +448,28 @@ asKind = fromAesonParser

450448asType :: Parse e P.Type

451449asType = fromAesonParser

452450

453−asFunDeps :: Parse PackageError [([String], [String])]

451+asFunDeps :: Parse PackageError [([Text], [Text])]

454452asFunDeps = eachInArray asFunDep

455453 where

456− asFunDep = (,) <$> nth 0 (eachInArray asString) <*> nth 1 (eachInArray asString)

454+ asFunDep = (,) <$> nth 0 (eachInArray asText) <*> nth 1 (eachInArray asText)

457455

458456asDataDeclType :: Parse PackageError P.DataDeclType

459457asDataDeclType =

460− withString $ \s -> case s of

458+ withText $ \s -> case s of

461459 "data" -> Right P.Data

462460 "newtype" -> Right P.Newtype

463461 other -> Left (InvalidDataDeclType other)

464462

465463asChildDeclaration :: Parse PackageError ChildDeclaration

466464asChildDeclaration =

467− ChildDeclaration <$> key "title" asString

468− <*> key "comments" (perhaps asString)

465+ ChildDeclaration <$> key "title" asText

466+ <*> key "comments" (perhaps asText)

469467 <*> key "sourceSpan" (perhaps asSourceSpan)

470468 <*> key "info" asChildDeclarationInfo

471469

472470asChildDeclarationInfo :: Parse PackageError ChildDeclarationInfo

473471asChildDeclarationInfo = do

474− ty <- key "declType" asString

472+ ty <- key "declType" asText

475473 case ty of

476474 "instance" ->

477475 ChildInstance <$> key "dependencies" (eachInArray asConstraint)

@@ -504,7 +502,7 @@ asBookmarks = eachInArray asBookmark

504502asBookmark :: Parse BowerError Bookmark

505503asBookmark =

506504 asInPackage ((,) <$> nth 0 (P.moduleNameFromString <$> asText)

507− <*> nth 1 asString)

505+ <*> nth 1 asText)

508506

509507asResolvedDependencies :: Parse PackageError [(PackageName, Version)]

510508asResolvedDependencies =

@@ -514,8 +512,8 @@ asResolvedDependencies =

514512 mapLeft _ (Right x) = Right x

515513

516514asGithub :: Parse e (GithubUser, GithubRepo)

517−asGithub = (,) <$> nth 0 (GithubUser <$> asString)

518− <*> nth 1 (GithubRepo <$> asString)

515+asGithub = (,) <$> nth 0 (GithubUser <$> asText)

516+ <*> nth 1 (GithubRepo <$> asText)

519517

520518asSourceSpan :: Parse e P.SourceSpan

521519asSourceSpan = P.SourceSpan <$> key "name" asString

src/Language/PureScript/Publish.hs+24−22

@@ -23,7 +23,7 @@ module Language.PureScript.Publish

2323import Prelude ()

2424import Prelude.Compat hiding (userError)

2525

26−import Control.Arrow ((***))

26+import Control.Arrow ((***), first)

2727import Control.Category ((>>>))

2828import Control.Exception (catch, try)

2929import Control.Monad.Error.Class (MonadError(..))

@@ -35,12 +35,13 @@ import Data.Aeson.BetterErrors

3535import Data.Char (isSpace)

3636import Data.Foldable (traverse_)

3737import Data.Function (on)

38−import Data.List (stripPrefix, isSuffixOf, (\\), nubBy)

38+import Data.List (stripPrefix, (\\), nubBy)

3939import Data.List.NonEmpty (NonEmpty(..))

4040import Data.List.Split (splitOn)

4141import Data.Maybe

4242import Data.Version

4343import qualified Data.SPDX as SPDX

44+import Data.Text (Text)

4445import qualified Data.Text as T

4546import qualified Data.Text.Lazy as TL

4647import qualified Data.Text.Lazy.Encoding as TL

@@ -65,7 +66,7 @@ import qualified Language.PureScript.Docs as D

6566data PublishOptions = PublishOptions

6667 { -- | How to obtain the version tag and version that the data being

6768 -- generated will refer to.

68− publishGetVersion :: PrepareM (String, Version)

69+ publishGetVersion :: PrepareM (Text, Version)

6970 , -- | What to do when the working tree is dirty

7071 publishWorkingTreeDirty :: PrepareM ()

7172 }

@@ -184,13 +185,13 @@ checkCleanWorkingTree opts = do

184185 unless (status == Clean) $

185186 publishWorkingTreeDirty opts

186187

187−getVersionFromGitTag :: PrepareM (String, Version)

188+getVersionFromGitTag :: PrepareM (Text, Version)

188189getVersionFromGitTag = do

189190 out <- readProcess' "git" ["tag", "--list", "--points-at", "HEAD"] ""

190191 let vs = map trimWhitespace (lines out)

191192 case mapMaybe parseMay vs of

192193 [] -> userError TagMustBeCheckedOut

193− [x] -> return x

194+ [x] -> return (first T.pack x)

194195 xs -> userError (AmbiguousVersions (map snd xs))

195196 where

196197 trimWhitespace =

@@ -209,7 +210,7 @@ getBowerRepositoryInfo = either (userError . BadRepositoryField) return . tryExt

209210 Just Repository{..} -> do

210211 unless (repositoryType == "git")

211212 (Left (BadRepositoryType repositoryType))

212− maybe (Left NotOnGithub) Right (extractGithub repositoryUrl)

213+ maybe (Left NotOnGithub) Right (extractGithub (T.pack repositoryUrl))

213214

214215checkLicense :: PackageMeta -> PrepareM ()

215216checkLicense pkgMeta =

@@ -226,9 +227,9 @@ checkLicense pkgMeta =

226227isValidSPDX :: String -> Bool

227228isValidSPDX = (== 1) . length . SPDX.parseExpression

228229

229−extractGithub :: String -> Maybe (D.GithubUser, D.GithubRepo)

230+extractGithub :: Text -> Maybe (D.GithubUser, D.GithubRepo)

230231extractGithub = stripGitHubPrefixes

231− >>> fmap (splitOn "/")

232+ >>> fmap (T.splitOn "/")

232233 >=> takeTwo

233234 >>> fmap (D.GithubUser *** (D.GithubRepo . dropDotGit))

234235

@@ -237,18 +238,18 @@ extractGithub = stripGitHubPrefixes

237238 takeTwo [x, y] = Just (x, y)

238239 takeTwo _ = Nothing

239240

240− stripGitHubPrefixes :: String -> Maybe String

241+ stripGitHubPrefixes :: Text -> Maybe Text

241242 stripGitHubPrefixes = stripPrefixes [ "git://github.com/"

242243 , "https://github.com/"

243244 , "git@github.com:"

244245 ]

245246

246− stripPrefixes :: [String] -> String -> Maybe String

247− stripPrefixes prefixes str = msum $ (`stripPrefix` str) <$> prefixes

247+ stripPrefixes :: [Text] -> Text -> Maybe Text

248+ stripPrefixes prefixes str = msum $ (`T.stripPrefix` str) <$> prefixes

248249

249− dropDotGit :: String -> String

250+ dropDotGit :: Text -> Text

250251 dropDotGit str

251− | ".git" `isSuffixOf` str = take (length str - 4) str

252+ | ".git" `T.isSuffixOf` str = T.take (T.length str - 4) str

252253 | otherwise = str

253254

254255readProcess' :: String -> [String] -> String -> PrepareM String

@@ -265,12 +266,12 @@ data DependencyStatus

265266 -- _resolution key. This can be caused by adding the dependency using

266267 -- `bower link`, or simply copying it into bower_components instead of

267268 -- installing it normally.

268− | ResolvedOther String

269− -- ^ Resolved, but to something other than a version. The String argument

269+ | ResolvedOther Text

270+ -- ^ Resolved, but to something other than a version. The Text argument

270271 -- is the resolution type. The values it can take that I'm aware of are

271272 -- "commit" and "branch".

272− | ResolvedVersion String

273− -- ^ Resolved to a version. The String argument is the resolution tag (eg,

273+ | ResolvedVersion Text

274+ -- ^ Resolved to a version. The Text argument is the resolution tag (eg,

274275 -- "v0.1.0").

275276 deriving (Show, Eq)

276277

@@ -341,9 +342,9 @@ asDependencyStatus = do

341342 else

342343 key "pkgMeta" $

343344 keyOrDefault "_resolution" NoResolution $ do

344− type_ <- key "type" asString

345+ type_ <- key "type" asText

345346 case type_ of

346− "version" -> ResolvedVersion <$> key "tag" asString

347+ "version" -> ResolvedVersion <$> key "tag" asText

347348 other -> return (ResolvedOther other)

348349

349350warnUndeclared :: [PackageName] -> [PackageName] -> PrepareM ()

@@ -374,15 +375,16 @@ handleDeps deps = do

374375 bowerDir pkgName = "bower_components/" ++ runPackageName pkgName

375376

376377 -- Try to extract a version, and warn if unsuccessful.

378+ tryExtractVersion' :: (PackageName, Text) -> PrepareM (Maybe (PackageName, Version))

377379 tryExtractVersion' pair =

378380 maybe (warn (UnacceptableVersion pair) >> return Nothing)

379381 (return . Just)

380382 (tryExtractVersion pair)

381383

382−tryExtractVersion :: (PackageName, String) -> Maybe (PackageName, Version)

384+tryExtractVersion :: (PackageName, Text) -> Maybe (PackageName, Version)

383385tryExtractVersion (pkgName, tag) =

384− let tag' = fromMaybe tag (stripPrefix "v" tag)

385− in (pkgName,) <$> D.parseVersion' tag'

386+ let tag' = fromMaybe tag (T.stripPrefix "v" tag)

387+ in (pkgName,) <$> D.parseVersion' (T.unpack tag')

386388

387389-- | Returns whether it looks like there is a purescript package checked out

388390-- in the given directory.

src/Language/PureScript/Publish/ErrorsWarnings.hs+5−4

@@ -24,6 +24,7 @@ import Data.Maybe

2424import Data.Monoid

2525import Data.Version

2626import qualified Data.List.NonEmpty as NonEmpty

27+import Data.Text (Text)

2728import qualified Data.Text as T

2829

2930import Language.PureScript.Publish.BoxesHelpers

@@ -43,7 +44,7 @@ data PackageError

4344data PackageWarning

4445 = NoResolvedVersion PackageName

4546 | UndeclaredDependency PackageName

46− | UnacceptableVersion (PackageName, String)

47+ | UnacceptableVersion (PackageName, Text)

4748 | DirtyWorkingTree_Warn

4849 deriving (Show)

4950

@@ -311,7 +312,7 @@ displayOtherError e = case e of

311312data CollectedWarnings = CollectedWarnings

312313 { noResolvedVersions :: [PackageName]

313314 , undeclaredDependencies :: [PackageName]

314− , unacceptableVersions :: [(PackageName, String)]

315+ , unacceptableVersions :: [(PackageName, Text)]

315316 , dirtyWorkingTree :: Any

316317 }

317318 deriving (Show, Eq, Ord)

@@ -387,7 +388,7 @@ warnUndeclaredDependencies pkgNames =

387388 ])

388389 : bulletedList runPackageName (NonEmpty.toList pkgNames)

389390

390−warnUnacceptableVersions :: NonEmpty (PackageName, String) -> Box

391+warnUnacceptableVersions :: NonEmpty (PackageName, Text) -> Box

391392warnUnacceptableVersions pkgs =

392393 let singular = NonEmpty.length pkgs == 1

393394 pl a b = if singular then b else a

@@ -414,7 +415,7 @@ warnUnacceptableVersions pkgs =

414415 ])

415416 ]

416417 where

417− showTuple (pkgName, tag) = runPackageName pkgName ++ "#" ++ tag

418+ showTuple (pkgName, tag) = runPackageName pkgName ++ "#" ++ T.unpack tag

418419

419420warnDirtyWorkingTree :: Box

420421warnDirtyWorkingTree =

tests/TestDocs.hs+83−70

@@ -1,6 +1,7 @@

11{-# LANGUAGE RecordWildCards #-}

22{-# LANGUAGE ViewPatterns #-}

33{-# LANGUAGE DataKinds #-}

4+{-# LANGUAGE OverloadedStrings #-}

56module TestDocs where

@@ -13,6 +14,7 @@ import Data.Monoid

1314import Data.Maybe (fromMaybe)

1415import Data.List ((\\))

1516import Data.Foldable

17+import Data.Text (Text)

1618import qualified Data.Text as T

1719import System.Exit

1820

@@ -37,7 +39,7 @@ main = pushd "examples/docs" $ do

3739 case res of

3840 Left e -> Publish.printErrorToStdout e >> exitFailure

3941 Right Docs.Package{..} ->

40− forM_ testCases $ \(P.moduleNameFromString . T.pack -> mn, pragmas) ->

42+ forM_ testCases $ \(P.moduleNameFromString -> mn, pragmas) ->

4143 let mdl = takeJust ("module not found in docs: " ++ T.unpack (P.runModuleName mn))

4244 (find ((==) mn . Docs.modName) pkgModules)

4345 in forM_ pragmas (`runAssertionIO` mdl)

@@ -49,25 +51,28 @@ takeJust msg = fromMaybe (error msg)

4951data Assertion

5052 -- | Assert that a particular declaration is documented with the given

5153 -- children

52− = ShouldBeDocumented P.ModuleName String [String]

54+ = ShouldBeDocumented P.ModuleName Text [Text]

5355 -- | Assert that a particular declaration is not documented

54− | ShouldNotBeDocumented P.ModuleName String

56+ | ShouldNotBeDocumented P.ModuleName Text

5557 -- | Assert that a particular declaration exists, but without a particular

5658 -- child.

57− | ChildShouldNotBeDocumented P.ModuleName String String

59+ | ChildShouldNotBeDocumented P.ModuleName Text Text

5860 -- | Assert that a particular declaration has a particular type class

5961 -- constraint.

60− | ShouldBeConstrained P.ModuleName String String

62+ | ShouldBeConstrained P.ModuleName Text Text

6163 -- | Assert that a particular typeclass declaration has a functional

6264 -- dependency list.

63− | ShouldHaveFunDeps P.ModuleName String [([String],[String])]

65+ | ShouldHaveFunDeps P.ModuleName Text [([Text],[Text])]

6466 -- | Assert that a particular value declaration exists, and its type

6567 -- satisfies the given predicate.

66− | ValueShouldHaveTypeSignature P.ModuleName String (ShowFn (P.Type -> Bool))

68+ | ValueShouldHaveTypeSignature P.ModuleName Text (ShowFn (P.Type -> Bool))

6769 -- | Assert that a particular type alias exists, and its corresponding

6870 -- type, when rendered, matches a given string exactly

6971 -- fields: module, type synonym name, expected type

70− | TypeSynonymShouldRenderAs P.ModuleName String String

72+ | TypeSynonymShouldRenderAs P.ModuleName Text Text

73+ -- | Assert that a documented declaration includes a documentation comment

74+ -- containing a particular string

75+ | ShouldHaveDocComment P.ModuleName Text Text

7176 deriving (Show)

7277

7378newtype ShowFn a = ShowFn a

@@ -77,28 +82,31 @@ instance Show (ShowFn a) where

7782

7883data AssertionFailure

7984 -- | A declaration was not documented, but should have been

80− = NotDocumented P.ModuleName String

85+ = NotDocumented P.ModuleName Text

8186 -- | A child declaration was not documented, but should have been

82− | ChildrenNotDocumented P.ModuleName String [String]

87+ | ChildrenNotDocumented P.ModuleName Text [Text]

8388 -- | A declaration was documented, but should not have been

84− | Documented P.ModuleName String

89+ | Documented P.ModuleName Text

8590 -- | A child declaration was documented, but should not have been

86− | ChildDocumented P.ModuleName String String

91+ | ChildDocumented P.ModuleName Text Text

8792 -- | A constraint was missing.

88− | ConstraintMissing P.ModuleName String String

93+ | ConstraintMissing P.ModuleName Text Text

8994 -- | A functional dependency was missing.

90− | FunDepMissing P.ModuleName String [([String], [String])]

95+ | FunDepMissing P.ModuleName Text [([Text], [Text])]

9196 -- | A declaration had the wrong "type" (ie, value, type, type class)

9297 -- Fields: declaration title, expected "type", actual "type".

93− | WrongDeclarationType P.ModuleName String String String

98+ | WrongDeclarationType P.ModuleName Text Text Text

9499 -- | A value declaration had the wrong type (in the sense of "type

95100 -- checking"), eg, because the inferred type was used when the explicit type

96101 -- should have been.

97102 -- Fields: module name, declaration name, actual type.

98− | ValueDeclarationWrongType P.ModuleName String P.Type

103+ | ValueDeclarationWrongType P.ModuleName Text P.Type

99104 -- | A Type synonym has been rendered in an unexpected format

100105 -- Fields: module name, declaration name, expected rendering, actual rendering

101− | TypeSynonymMismatch P.ModuleName String String String

106+ | TypeSynonymMismatch P.ModuleName Text Text Text

107+ -- | A doc comment was not found or did not match what was expected

108+ -- Fields: declaration title, expected substring, actual comments

109+ | DocCommentMissing P.ModuleName Text (Maybe Text)

102110 deriving (Show)

103111

104112data AssertionResult

@@ -135,62 +143,56 @@ runAssertion assertion Docs.Module{..} =

135143 Fail (NotDocumented mn decl)

136144

137145 ShouldBeConstrained mn decl tyClass ->

138− case find ((==) decl . Docs.declTitle) (declarationsFor mn) of

139− Nothing ->

140− Fail (NotDocumented mn decl)

141− Just Docs.Declaration{..} ->

142− case declInfo of

143− Docs.ValueDeclaration ty ->

144− if checkConstrained ty tyClass

145− then Pass

146− else Fail (ConstraintMissing mn decl tyClass)

147− _ ->

148− Fail (WrongDeclarationType mn decl "value"

149− (Docs.declInfoToString declInfo))

146+ findDecl mn decl $ \Docs.Declaration{..} ->

147+ case declInfo of

148+ Docs.ValueDeclaration ty ->

149+ if checkConstrained ty tyClass

150+ then Pass

151+ else Fail (ConstraintMissing mn decl tyClass)

152+ _ ->

153+ Fail (WrongDeclarationType mn decl "value"

154+ (Docs.declInfoToString declInfo))

150155

151156 ShouldHaveFunDeps mn decl fds ->

152− case find ((==) decl . Docs.declTitle) (declarationsFor mn) of

153− Nothing ->

154− Fail (NotDocumented mn decl)

155− Just Docs.Declaration{..} ->

156− case declInfo of

157− Docs.TypeClassDeclaration _ _ fundeps ->

158− if fundeps == fds

159− then Pass

160− else Fail (FunDepMissing mn decl fds)

161− _ ->

162− Fail (WrongDeclarationType mn decl "value"

163− (Docs.declInfoToString declInfo))

157+ findDecl mn decl $ \Docs.Declaration{..} ->

158+ case declInfo of

159+ Docs.TypeClassDeclaration _ _ fundeps ->

160+ if fundeps == fds

161+ then Pass

162+ else Fail (FunDepMissing mn decl fds)

163+ _ ->

164+ Fail (WrongDeclarationType mn decl "value"

165+ (Docs.declInfoToString declInfo))

164166

165167 ValueShouldHaveTypeSignature mn decl (ShowFn tyPredicate) ->

166− case find ((==) decl . Docs.declTitle) (declarationsFor mn) of

167− Nothing ->

168− Fail (NotDocumented mn decl)

169− Just Docs.Declaration{..} ->

170− case declInfo of

171− Docs.ValueDeclaration ty ->

172− if tyPredicate ty

173− then Pass

174− else Fail

175− (ValueDeclarationWrongType mn decl ty)

176− _ ->

177− Fail (WrongDeclarationType mn decl "value"

178− (Docs.declInfoToString declInfo))

168+ findDecl mn decl $ \Docs.Declaration{..} ->

169+ case declInfo of

170+ Docs.ValueDeclaration ty ->

171+ if tyPredicate ty

172+ then Pass

173+ else Fail

174+ (ValueDeclarationWrongType mn decl ty)

175+ _ ->

176+ Fail (WrongDeclarationType mn decl "value"

177+ (Docs.declInfoToString declInfo))

179178

180179 TypeSynonymShouldRenderAs mn decl expected ->

181− case find ((==) decl . Docs.declTitle) (declarationsFor mn) of

182− Nothing ->

183− Fail (NotDocumented mn decl)

184− Just Docs.Declaration{..} ->

185− case declInfo of

186− Docs.TypeSynonymDeclaration [] ty ->

187− let actual = codeToString (Docs.renderType ty) in

188− if actual == expected

189− then Pass

190− else Fail (TypeSynonymMismatch mn decl expected actual)

191− _ ->

192− Fail (WrongDeclarationType mn decl "synonym"

193− (Docs.declInfoToString declInfo))

180+ findDecl mn decl $ \Docs.Declaration{..} ->

181+ case declInfo of

182+ Docs.TypeSynonymDeclaration [] ty ->

183+ let actual = codeToString (Docs.renderType ty) in

184+ if actual == expected

185+ then Pass

186+ else Fail (TypeSynonymMismatch mn decl expected actual)

187+ _ ->

188+ Fail (WrongDeclarationType mn decl "synonym"

189+ (Docs.declInfoToString declInfo))

190+

191+ ShouldHaveDocComment mn decl expected ->

192+ findDecl mn decl $ \Docs.Declaration{..} ->

193+ if maybe False (expected `T.isInfixOf`) declComments

194+ then Pass

195+ else Fail (DocCommentMissing mn decl declComments)

194196

195197 where

196198 declarationsFor mn =

@@ -201,9 +203,16 @@ runAssertion assertion Docs.Module{..} =

201203 findChildren title =

202204 fmap childrenTitles . find ((==) title . Docs.declTitle)

203205

206+ findDecl mn title f =

207+ case find ((==) title . Docs.declTitle) (declarationsFor mn) of

208+ Nothing ->

209+ Fail (NotDocumented mn title)

210+ Just decl ->

211+ f decl

212+

204213 childrenTitles = map Docs.cdeclTitle . Docs.declChildren

205214

206−checkConstrained :: P.Type -> String -> Bool

215+checkConstrained :: P.Type -> Text -> Bool

207216checkConstrained ty tyClass =

208217 -- Note that we don't recurse on ConstrainedType if none of the constraints

209218 -- match; this is by design, as constraints should be moved to the front

@@ -217,7 +226,7 @@ checkConstrained ty tyClass =

217226 False

218227 where

219228 matches className =

220− (==) className . T.unpack . P.runProperName . P.disqualify . P.constraintClass

229+ (==) className . P.runProperName . P.disqualify . P.constraintClass

221230

222231runAssertionIO :: Assertion -> Docs.Module -> IO ()

223232runAssertionIO assertion mdl = do

@@ -228,7 +237,7 @@ runAssertionIO assertion mdl = do

228237 putStrLn ("Failed: " <> show reason)

229238 exitFailure

230239

231−testCases :: [(String, [Assertion])]

240+testCases :: [(Text, [Assertion])]

232241testCases =

233242 [ ("Example",

234243 [ -- From dependencies

@@ -319,6 +328,10 @@ testCases =

319328 , ValueShouldHaveTypeSignature (n "TypeOpAliases") "test4" (renderedType "forall a b c d. ((a ~> b) ~> c) ~> d")

320329 , ValueShouldHaveTypeSignature (n "TypeOpAliases") "third" (renderedType "forall a b c. a × b × c -> c")

321330 ])

331+

332+ , ("DocComments",

333+ [ ShouldHaveDocComment (n "DocComments") "example" " example == 0"

334+ ])

322335 ]

323336

324337 where

tests/TestPrimDocs.hs+2−3

@@ -3,7 +3,6 @@ module TestPrimDocs where

33import Control.Monad

44import Data.List ((\\))

55import qualified Data.Map as Map

6−import qualified Data.Text as T

76import qualified Language.PureScript as P

87import qualified Language.PureScript.Docs as D

98import qualified Language.PureScript.Docs.AsMarkdown as D

@@ -11,11 +10,11 @@ import qualified Language.PureScript.Docs.AsMarkdown as D

1110main :: IO ()

1211main = do

1312 putStrLn "Test that there are no bottoms hiding in primDocsModule"

14− seq (T.pack (D.runDocs (D.modulesAsMarkdown [D.primDocsModule]))) (return ())

13+ seq (D.runDocs (D.modulesAsMarkdown [D.primDocsModule])) (return ())

1514

1615 putStrLn "Test that Prim is fully documented"

1716 let actualPrimTypes = map (P.runProperName . P.disqualify . fst) $ Map.toList P.primTypes

18− let documentedPrimTypes = map (T.pack . D.declTitle) (D.modDeclarations D.primDocsModule)

17+ let documentedPrimTypes = map D.declTitle (D.modDeclarations D.primDocsModule)

1918

2019 let undocumentedTypes = actualPrimTypes \\ documentedPrimTypes

2120 let extraTypes = documentedPrimTypes \\ actualPrimTypes

tests/TestPscPublish.hs+2−10

@@ -1,20 +1,12 @@

11{-# OPTIONS_GHC -fno-warn-missing-signatures #-}

2−{-# OPTIONS_GHC -fno-warn-unused-imports #-}

32{-# LANGUAGE ScopedTypeVariables #-}

3+{-# LANGUAGE OverloadedStrings #-}

55module TestPscPublish where

7−import Control.Monad

8−import Control.Applicative

9−import Control.Exception

10−import System.Process

11−import System.Directory

12−import System.IO

13−import System.Exit

14−import qualified Data.ByteString.Lazy as BL

7+import System.Exit (exitFailure)

158import Data.ByteString.Lazy (ByteString)

169import qualified Data.Aeson as A

17−import Data.Aeson.BetterErrors

1810import Data.Version

1911

2012import Language.PureScript.Docs