Reexport docs

.gitignore

@@ -16,3 +16,5 @@ tmp/
 .stack-work/
 tests/support/flattened/
 output
+examples/docs/docs/
+core-tests/full-core-docs.md

.travis.yml

@@ -57,6 +57,8 @@ install:
   # Snapshot state of the sandbox now, so we don't need to make new one for test install
   - rm -rf ~/cabal-sandboxes/$GHCVER-${STACKAGE:-none}
   - cp -r .cabal-sandbox ~/cabal-sandboxes/$GHCVER-${STACKAGE:-none}
+  # Install bower globally (for psc-docs/psc-publish tests)
+  - npm install -g bower
 script:
   - ./travis/configure.sh
   - cabal build --ghc-options="-Werror"

core-tests/test-everything.sh

@@ -18,9 +18,7 @@ if [ "$force_reinstall" = "true" ] && [ -d "bower_components" ]; then
   rm -r bower_components
 fi
 
-npm install bower
-
-node_modules/.bin/bower i \
+bower i \
         purescript-prelude \
         purescript-eff \
         purescript-st \
@@ -75,3 +73,7 @@ fi
 ../dist/build/psc/psc tests/*/*.purs \
                       'bower_components/purescript-*/src/**/*.purs' \
                 --ffi 'bower_components/purescript-*/src/**/*.js'
+
+../dist/build/psc-docs/psc-docs tests/*/*.purs \
+                      'bower_components/purescript-*/src/**/*.purs' \
+                      > full-core-docs.md

examples/docs/bower.json

@@ -0,0 +1,19 @@
+{
+  "name": "docs-test-package",
+  "version": "1.0.0",
+  "moduleType": [
+    "node"
+  ],
+  "repository": {
+    "type": "git",
+    "url": "git://github.com/not-real/not-a-real-repo.git"
+  },
+  "ignore": [
+    "**/.*",
+    "node_modules",
+    "bower_components",
+    "output"
+  ],
+  "dependencies": {
+  }
+}

examples/docs/bower_components/purescript-prelude/src/Prelude.purs

@@ -0,0 +1,8 @@
+module Prelude where
+
+newtype Unit = Unit {}
+
+unit :: Unit
+unit = Unit {}
+
+data Boolean2 = True | False

examples/docs/src/Clash.purs

@@ -0,0 +1,32 @@
+module Clash (module Clash1) where
+
+import Clash1 as Clash1
+import Clash2 as Clash2
+
+module Clash1 (module Clash1a) where
+
+import Clash1a
+
+module Clash1a where
+
+value :: Int
+value = 0
+
+type Type = Int
+
+class TypeClass a where
+  typeClassMember :: a
+
+module Clash2 (module Clash2a) where
+
+import Clash2a
+
+module Clash2a where
+
+value :: String
+value = "hello"
+
+type Type = String
+
+class TypeClass a b where
+  typeClassMember :: a -> b

examples/docs/src/DuplicateNames.purs

@@ -0,0 +1,9 @@
+module DuplicateNames
+  ( module DuplicateNames
+  , module Prelude
+  ) where
+
+import Prelude (Unit)
+
+unit :: Int
+unit = 0

examples/docs/src/Example.purs

@@ -0,0 +1,7 @@
+module Example
+  ( module Prelude
+  , module Example2
+  ) where
+
+import Prelude (Unit())
+import Example2 (one)

examples/docs/src/Example2.purs

@@ -0,0 +1,7 @@
+module Example2 where
+
+one :: Int
+one = 1
+
+two :: Int
+two = 2

examples/docs/src/MultiVirtual.purs

@@ -0,0 +1,27 @@
+module MultiVirtual
+  ( module X )
+  where
+
+import MultiVirtual1 as X
+import MultiVirtual2 as X
+
+
+module MultiVirtual1 where
+
+foo :: Int
+foo = 1
+
+module MultiVirtual2 
+  ( module MultiVirtual2
+  , module MultiVirtual3
+  ) where
+
+import MultiVirtual3
+
+bar :: Int
+bar = 2
+
+module MultiVirtual3 where
+
+baz :: Int
+baz = 3

examples/docs/src/NewOperators.purs

@@ -0,0 +1,12 @@
+module NewOperators
+  ( module NewOperators2 )
+  where
+
+import NewOperators2
+
+module NewOperators2 where
+
+infixl 8 _compose as >>>
+
+_compose :: forall a b c. (b -> c) -> (a -> b) -> (a -> c)
+_compose f g x = f (g x)

examples/docs/src/NotAllCtors.purs

@@ -0,0 +1,5 @@
+module NotAllCtors
+  ( module Prelude )
+  where
+
+import Prelude (Boolean2(True))

examples/docs/src/OldOperators.purs

@@ -0,0 +1,10 @@
+
+-- Remove this after 0.9.
+module OldOperators (module OldOperators2) where
+
+import OldOperators2
+
+module OldOperators2 where
+
+(>>) :: forall a. a -> a -> a
+(>>) a b = b

examples/docs/src/ReExportedTypeClass.purs

@@ -0,0 +1,5 @@
+module ReExportedTypeClass
+  ( module SomeTypeClass )
+  where
+
+import SomeTypeClass

examples/docs/src/SolitaryTypeClassMember.purs

@@ -0,0 +1,6 @@
+module SolitaryTypeClassMember
+  ( module SomeTypeClass )
+  where
+
+import SomeTypeClass (member)
+

examples/docs/src/SomeTypeClass.purs

@@ -0,0 +1,5 @@
+
+module SomeTypeClass where
+
+class SomeClass a where
+  member :: a

examples/docs/src/Transitive1.purs

@@ -0,0 +1,5 @@
+module Transitive1
+  ( module Transitive2 )
+  where
+
+import Transitive2

examples/docs/src/Transitive2.purs

@@ -0,0 +1,5 @@
+module Transitive2
+  ( module Transitive3 )
+  where
+
+import Transitive3

examples/docs/src/Transitive3.purs

@@ -0,0 +1,4 @@
+module Transitive3 where
+
+transitive3 :: Int
+transitive3 = 0

examples/docs/src/TypeClassWithoutMembers.purs

@@ -0,0 +1,11 @@
+module TypeClassWithoutMembers
+  ( module Intermediate )
+  where
+
+import Intermediate
+
+module Intermediate
+  ( module SomeTypeClass )
+  where
+
+import SomeTypeClass (SomeClass)

examples/docs/src/UTF8.purs

@@ -0,0 +1,7 @@
+module UTF8 where
+
+import Prelude (Unit, unit)
+
+-- | üÜäÄ 😰
+thing :: Unit
+thing = unit

examples/docs/src/Virtual.purs

@@ -0,0 +1,5 @@
+module Virtual
+  ( module VirtualPrelude )
+  where
+
+import Prelude as VirtualPrelude

psc-docs/Main.hs

@@ -16,6 +16,7 @@
 module Main where
 
 import Control.Applicative
+import Control.Monad.Trans.Except (runExceptT)
 import Control.Arrow (first, second)
 import Control.Category ((>>>))
 import Control.Monad.Writer
@@ -68,55 +69,68 @@ docgen (PSCDocsOptions fmt inputGlob output) = do
     Etags -> dumpTags input dumpEtags
     Ctags -> dumpTags input dumpCtags
     Markdown -> do
-      e <- D.parseAndDesugar input [] (\_ ms -> return ms)
-      case e of
-        Left err -> do
-          hPutStrLn stderr $ P.prettyPrintMultipleErrors False err
-          exitFailure
-        Right ms' ->
-          case output of
-            EverythingToStdOut ->
-              putStrLn (D.renderModulesAsMarkdown ms')
-            ToStdOut names -> do
-              let (ms, missing) = takeModulesByName ms' names
-              guardMissing missing
-              putStrLn (D.renderModulesAsMarkdown ms)
-            ToFiles names -> do
-              let (ms, missing) = takeModulesByName' ms' names
-              guardMissing missing
-              let ms'' = groupBy ((==) `on` fst) . sortBy (compare `on` fst) $ map swap ms
-              forM_ ms'' $ \grp -> do
-                let fp = fst (head grp)
-                createDirectoryIfMissing True (takeDirectory fp)
-                writeFile fp (D.renderModulesAsMarkdown $ snd `map` grp)
+      ms <- runExceptT (D.parseAndDesugar input []
+                           >>= ((\(ms, _, env) -> D.convertModulesInPackage env ms)))
+               >>= successOrExit
+
+      case output of
+        EverythingToStdOut ->
+          putStrLn (D.runDocs (D.modulesAsMarkdown ms))
+        ToStdOut names -> do
+          let (ms', missing) = takeByName ms (map P.runModuleName names)
+          guardMissing missing
+          putStrLn (D.runDocs (D.modulesAsMarkdown ms'))
+        ToFiles names -> do
+          let (ms', missing) = takeByName' ms (map (first P.runModuleName) names)
+          guardMissing missing
+
+          let ms'' = groupBy ((==) `on` fst) . sortBy (compare `on` fst) $ map swap ms'
+          forM_ ms'' $ \grp -> do
+            let fp = fst (head grp)
+            createDirectoryIfMissing True (takeDirectory fp)
+            writeFile fp (D.runDocs (D.modulesAsMarkdown (map snd grp)))
+
   where
   guardMissing [] = return ()
   guardMissing [mn] = do
-    hPutStrLn stderr ("psc-docs: error: unknown module \"" ++ show mn ++ "\"")
+    hPutStrLn stderr ("psc-docs: error: unknown module \"" ++ mn ++ "\"")
     exitFailure
   guardMissing mns = do
     hPutStrLn stderr "psc-docs: error: unknown modules:"
     forM_ mns $ \mn ->
-      hPutStrLn stderr ("  * " ++ show mn)
+      hPutStrLn stderr ("  * " ++ mn)
     exitFailure
 
+  successOrExit :: Either P.MultipleErrors a -> IO a
+  successOrExit act =
+    case act of
+      Right x ->
+        return x
+      Left err -> do
+        hPutStrLn stderr $ P.prettyPrintMultipleErrors False err
+        exitFailure
+
+  takeByName = takeModulesByName D.modName
+  takeByName' = takeModulesByName' D.modName
+
 -- |
 -- Given a list of module names and a list of modules, return a list of modules
 -- whose names appeared in the given name list, together with a list of names
 -- for which no module could be found in the module list.
 --
-takeModulesByName :: [P.Module] -> [P.ModuleName] -> ([P.Module], [P.ModuleName])
-takeModulesByName modules names =
-  first (map fst) (takeModulesByName' modules (map (,()) names))
+takeModulesByName :: (Eq n) => (m -> n) -> [m] -> [n] -> ([m], [n])
+takeModulesByName getModuleName modules names =
+  first (map fst) (takeModulesByName' getModuleName modules (map (,()) names))
 
 -- |
--- Like takeModulesByName but also keeps some extra data with the module.
+-- Like takeModulesByName, but also keeps some extra information with each
+-- module.
 --
-takeModulesByName' :: [P.Module] -> [(P.ModuleName, a)] -> ([(P.Module, a)], [P.ModuleName])
-takeModulesByName' modules = foldl go ([], [])
+takeModulesByName' :: (Eq n) => (m -> n) -> [m] -> [(n, a)] -> ([(m, a)], [n])
+takeModulesByName' getModuleName modules = foldl go ([], [])
   where
   go (ms, missing) (name, x) =
-    case find ((== name) . P.getModuleName) modules of
+    case find ((== name) . getModuleName) modules of
       Just m  -> ((m, x) : ms, missing)
       Nothing -> (ms, name : missing)
 

purescript.cabal

@@ -20,6 +20,9 @@ tested-with: GHC==7.8
 
 extra-source-files: examples/passing/*.purs
                   , examples/failing/*.purs
+                  , examples/docs/bower_components/purescript-prelude/src/*.purs
+                  , examples/docs/bower.json
+                  , examples/docs/src/*.purs
                   , tests/support/setup.js
                   , tests/support/package.json
                   , tests/support/bower.json
@@ -159,6 +162,8 @@ library
 
                      Language.PureScript.Docs
                      Language.PureScript.Docs.Convert
+                     Language.PureScript.Docs.Convert.Single
+                     Language.PureScript.Docs.Convert.ReExports
                      Language.PureScript.Docs.Render
                      Language.PureScript.Docs.Types
                      Language.PureScript.Docs.RenderedCode
@@ -220,7 +225,8 @@ executable psc-docs
     build-depends: base >=4 && <5, purescript -any,
                    optparse-applicative >= 0.10.0, process -any, mtl -any,
                    split -any, ansi-wl-pprint -any, directory -any,
-                   filepath -any, Glob -any
+                   filepath -any, Glob -any, transformers -any,
+                   transformers-compat -any
     main-is: Main.hs
     buildable: True
     hs-source-dirs: psc-docs
@@ -272,6 +278,7 @@ test-suite tests
     main-is: Main.hs
     other-modules: TestsSetup
                    TestPscPublish
+                   TestDocs
     buildable: True
     hs-source-dirs: tests tests/common