hdocs 0.5.4.0 → 0.5.5.0

raw patch · 10 files changed

+673/−665 lines, 10 filesdep ~ghcdep ~haddock-apidep ~haddock-library

Dependency ranges changed: ghc, haddock-api, haddock-library

Files

LICENSE +30/−30
hdocs.cabal +120/−112
src/HDocs/Base.hs +105/−105
src/HDocs/Compat.hs +24/−24
src/HDocs/Ghc/Compat.hs +53/−53
src/HDocs/Haddock.hs +133/−133
src/HDocs/Module.hs +88/−88
tests/HelpTest.hs +5/−5
tests/Test.hs +29/−29
tools/hdocs.hs +86/−86

LICENSE view

@@ -1,30 +1,30 @@-Copyright (c) 2013, Alexandr `Voidex` Ruchkin
-
-All rights reserved.
-
-Redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions are met:
-
-    * Redistributions of source code must retain the above copyright
-      notice, this list of conditions and the following disclaimer.
-
-    * Redistributions in binary form must reproduce the above
-      copyright notice, this list of conditions and the following
-      disclaimer in the documentation and/or other materials provided
-      with the distribution.
-
-    * Neither the name of Alexandr `Voidex` Ruchkin nor the names of other
-      contributors may be used to endorse or promote products derived
-      from this software without specific prior written permission.
-
-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
-LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
-A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
-OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
-SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
-LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
-DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
-THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
-(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+Copyright (c) 2013, Alexandr `Voidex` Ruchkin++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Alexandr `Voidex` Ruchkin nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

hdocs.cabal view

@@ -1,112 +1,120 @@-name:                hdocs
-version:             0.5.4.0
-synopsis:            Haskell docs tool
-description:
-  Tool and library to get docs for installed packages and source files.
-  Can return result in JSON format.
-  Can dump docs for all installed modules
-  .
-  @Usage:
-  hdocs <module> - get docs for module/file
-  hdocs <module> <name> - get docs for name in module/file
-  hdocs dump [r] - dump all installed docs, if [r], find docs for reexported declarations
-
-  flags
-  --pretty       pretty JSON output
-  -g GHC_OPT  --ghc=GHC_OPT  option to pass to GHC
-  @
-homepage:            https://github.com/mvoidex/hdocs
-license:             BSD3
-license-file:        LICENSE
-author:              Alexandr `Voidex` Ruchkin
-maintainer:          voidex@live.com
-category:            Development
-build-type:          Simple
-cabal-version:       >=1.8
-
-source-repository head
-  type: git
-  location: git://github.com/mvoidex/hdocs.git
-
-library
-  hs-source-dirs: src
-  ghc-options: -fno-warn-tabs
-  exposed-modules:
-    HDocs.Base
-    HDocs.Haddock
-    HDocs.Module
-  other-modules:
-    HDocs.Compat
-    HDocs.Ghc.Compat
-  if impl(ghc == 8.8.*)
-    build-depends:
-      ghc == 8.8.*,
-      haddock-api >= 2.23 && < 2.24,
-      haddock-library == 1.8.*
-  if impl(ghc == 8.6.*)
-    build-depends:
-      ghc == 8.6.*,
-      haddock-api >= 2.21 && < 2.23,
-      haddock-library == 1.7.*
-  if impl(ghc >= 8.3) && impl(ghc < 8.6)
-    build-depends:
-      ghc >= 8.3,
-      haddock-api >= 2.20.0 && < 2.21.0,
-      haddock-library == 1.6.*
-  if impl(ghc >= 8.2) && impl(ghc < 8.3)
-    build-depends:
-      ghc >= 8.2 && < 8.3,
-      haddock-api >= 2.18.0 && < 2.20.0,
-      haddock-library == 1.4.*
-  if impl(ghc >= 8.0) && impl(ghc < 8.2)
-    build-depends:
-      ghc >= 8.0.0,
-      haddock-api >= 2.17.0 && < 2.18.0,
-      haddock-library == 1.4.*
-  if impl(ghc < 8.0)
-    build-depends:
-      ghc >= 7.8.1 && < 8.0.0,
-      haddock-api >= 2.16.0 && < 2.17.0,
-      haddock-library == 1.2.*
-  build-depends:
-    base >= 4.7 && < 5,
-    aeson >= 0.7.0,
-    bytestring >= 0.10.0,
-    Cabal >= 1.22.2,
-    filepath >= 1.3.0,
-    ghc-paths >= 0.1.0,
-    containers >= 0.5.0,
-    network >= 2.4.0,
-    process >= 1.2.0,
-    text >= 1.1.0,
-    mtl >= 2.1.0
-
-executable hdocs
-  main-is: hdocs.hs
-  hs-source-dirs: tools
-  ghc-options: -fno-warn-tabs
-  build-depends:
-    base >= 4.7 && < 5,
-    hdocs,
-    aeson >= 0.7.0,
-    aeson-pretty >= 0.7.0,
-    bytestring >= 0.10.0,
-    containers >= 0.5.0,
-    filepath >= 1.3.0,
-    haddock-api,
-    mtl >= 2.1.0,
-    network >= 2.4.0,
-    text >= 1.1.0
-
-test-suite test
-  type: exitcode-stdio-1.0
-  main-is: Test.hs
-  hs-source-dirs: tests
-  ghc-options: -fno-warn-tabs
-  other-modules:
-    HelpTest
-  build-depends:
-    base >= 4.7 && < 5,
-    hdocs,
-    containers >= 0.5.0,
-    mtl >= 2.1.0
+name:                hdocs+version:             0.5.5.0+synopsis:            Haskell docs tool+description:+  Tool and library to get docs for installed packages and source files.+  Can return result in JSON format.+  Can dump docs for all installed modules+  .+  @Usage:+  hdocs <module> - get docs for module/file+  hdocs <module> <name> - get docs for name in module/file+  hdocs dump [r] - dump all installed docs, if [r], find docs for reexported declarations++  flags+  --pretty       pretty JSON output+  -g GHC_OPT  --ghc=GHC_OPT  option to pass to GHC+  @+homepage:            https://github.com/mvoidex/hdocs+license:             BSD3+license-file:        LICENSE+author:              Alexandr `Voidex` Ruchkin+maintainer:          voidex@live.com+category:            Development+build-type:          Simple+cabal-version:       >=1.10++source-repository head+  type: git+  location: git://github.com/mvoidex/hdocs.git++library+  hs-source-dirs: src+  ghc-options: -fno-warn-tabs+  default-language: Haskell2010+  exposed-modules:+    HDocs.Base+    HDocs.Haddock+    HDocs.Module+  other-modules:+    HDocs.Compat+    HDocs.Ghc.Compat+  if impl(ghc == 8.10.*)+    build-depends:+      ghc == 8.10.*,+      haddock-api >= 2.24 && < 2.25,+      haddock-library == 1.9.*+  if impl(ghc == 8.8.*)+    build-depends:+      ghc == 8.8.*,+      haddock-api >= 2.23 && < 2.24,+      haddock-library == 1.8.*+  if impl(ghc == 8.6.*)+    build-depends:+      ghc == 8.6.*,+      haddock-api >= 2.21 && < 2.23,+      haddock-library == 1.7.*+  if impl(ghc >= 8.3) && impl(ghc < 8.6)+    build-depends:+      ghc >= 8.3,+      haddock-api >= 2.20.0 && < 2.21.0,+      haddock-library == 1.6.*+  if impl(ghc >= 8.2) && impl(ghc < 8.3)+    build-depends:+      ghc >= 8.2 && < 8.3,+      haddock-api >= 2.18.0 && < 2.20.0,+      haddock-library == 1.4.*+  if impl(ghc >= 8.0) && impl(ghc < 8.2)+    build-depends:+      ghc >= 8.0.0,+      haddock-api >= 2.17.0 && < 2.18.0,+      haddock-library == 1.4.*+  if impl(ghc < 8.0)+    build-depends:+      ghc >= 7.8.1 && < 8.0.0,+      haddock-api >= 2.16.0 && < 2.17.0,+      haddock-library == 1.2.*+  build-depends:+    base >= 4.7 && < 5,+    aeson >= 0.7.0,+    bytestring >= 0.10.0,+    Cabal >= 1.22.2,+    filepath >= 1.3.0,+    ghc-paths >= 0.1.0,+    containers >= 0.5.0,+    network >= 2.4.0,+    process >= 1.2.0,+    text >= 1.1.0,+    mtl >= 2.1.0++executable hdocs+  main-is: hdocs.hs+  hs-source-dirs: tools+  default-language: Haskell2010+  ghc-options: -fno-warn-tabs+  build-depends:+    base >= 4.7 && < 5,+    hdocs,+    aeson >= 0.7.0,+    aeson-pretty >= 0.7.0,+    bytestring >= 0.10.0,+    containers >= 0.5.0,+    filepath >= 1.3.0,+    haddock-api,+    mtl >= 2.1.0,+    network >= 2.4.0,+    text >= 1.1.0++test-suite test+  type: exitcode-stdio-1.0+  main-is: Test.hs+  default-language: Haskell2010+  hs-source-dirs: tests+  ghc-options: -fno-warn-tabs+  other-modules:+    HelpTest+  build-depends:+    base >= 4.7 && < 5,+    hdocs,+    containers >= 0.5.0,+    mtl >= 2.1.0

src/HDocs/Base.hs view

@@ -1,105 +1,105 @@-{-# LANGUAGE CPP #-}
-
-module HDocs.Base (
-	ModuleDocMap,
-	withInitializedPackages, configSession,
-	formatDoc, formatDocs
-	) where
-
-import Data.Char (isSpace)
-import Data.Map (Map)
-import Data.Maybe (fromMaybe, listToMaybe)
-import Data.Foldable (foldMap, toList)
-import qualified Data.Map as M
-
-import Documentation.Haddock
-
-import DynFlags
-import GHC
-import GHC.Paths
-import qualified GhcMonad as GHC (liftIO)
-import Name (occNameString)
-import Packages
-
-import HDocs.Ghc.Compat
-
--- | Documentation in module
-type ModuleDocMap = Map String (Doc String)
-
--- | Run action with initialized packages
-withInitializedPackages :: [String] -> (DynFlags -> IO a) -> IO a
-withInitializedPackages ghcOpts cont = runGhc (Just libdir) $ do
-	fs <- getSessionDynFlags
-	cleanupHandler fs $ do
-		(fs', _, _) <- parseDynamicFlags fs (map noLoc ghcOpts)
-		_ <- setSessionDynFlags fs'
-		(result, _) <- GHC.liftIO $ initPackages fs'
-		GHC.liftIO $ cont result
-
--- | Config GHC session
-configSession :: [String] -> IO DynFlags
-configSession ghcOpts = runGhc (Just libdir) $ do
-	fs <- getSessionDynFlags
-	cleanupHandler fs $ do
-		(fs', _, _) <- parseDynamicFlags fs (map noLoc ghcOpts)
-		_ <- setSessionDynFlags fs'
-		(result, _) <- GHC.liftIO $ initPackages fs'
-		return result
-
--- | Format documentation to plain text.
-formatDoc :: Doc String -> String
-formatDoc = trim . go where
-	go :: Doc String -> String
-	go (DocAppend a b) = go a ++ go b
-	go (DocString str) = trimSpaces str
-	go (DocParagraph p) = go p ++ "\n"
-	go (DocIdentifier i) = unwrap i
-	go (DocIdentifierUnchecked m) = moduleNameString mname ++ "." ++ occNameString occname where
-			(mname, occname) = unwrap m
-	go (DocModule m) = m
-	go (DocWarning w) = go w
-	go (DocEmphasis e) = "*" ++ go e ++ "*"
-	go (DocMonospaced e) = "`" ++ go e ++ "`"
-	go (DocBold b) = "*" ++ go b ++ "*"
-	go (DocUnorderedList i) = unlines (map (("* " ++) . go) i)
-	go (DocOrderedList i) = unlines (zipWith (\i' x -> show i' ++ ". " ++ go x) ([1..] :: [Integer]) i)
-	go (DocDefList xs) = unlines (map (\(i,x) -> go i ++ ". " ++ go x) xs)
-	go (DocCodeBlock block) = unlines (map ("    " ++) (lines (go block))) ++ "\n"
-	go (DocHyperlink (Hyperlink url label)) = maybe url (\l -> showLabel l ++ "[" ++ url ++ "]") $ label where
-#if MIN_VERSION_haddock_library(1,8,0)
-			showLabel = go
-#else
-			showLabel = id
-#endif
-	go (DocPic pic) = show pic
-#if MIN_VERSION_haddock_library(1,4,0)
-	go (DocMathInline m) = m
-	go (DocMathDisplay m) = m
-#endif
-	go (DocAName name) = name
-	go (DocProperty prop) = prop
-	go (DocExamples exs) = unlines (map formatExample exs)
-	go (DocHeader h) = foldMap go h
-	go _ = ""
-
-	formatExample :: Example -> String
-	formatExample (Example expr result) = ">>> " ++ expr ++ "\n" ++ unlines result
-
-	trimSpaces [] = []
-	trimSpaces [s] = [s]
-	trimSpaces (' ':' ':ss) = trimSpaces (' ':ss)
-	trimSpaces (x:y:ss) = x : trimSpaces(y:ss)
-
-	trim :: String -> String
-	trim = p . p where
-		p = reverse . dropWhile isSpace
-
-#if MIN_VERSION_haddock_library(1,8,0)
-	unwrap = fromMaybe (error "toList on `Wrap` returns empty list") . listToMaybe . toList
-#else
-	unwrap = id
-#endif
-
--- | Format docs to plain text
-formatDocs :: ModuleDocMap -> Map String String
-formatDocs = M.map formatDoc
+{-# LANGUAGE CPP #-}++module HDocs.Base (+	ModuleDocMap,+	withInitializedPackages, configSession,+	formatDoc, formatDocs+	) where++import Data.Char (isSpace)+import Data.Map (Map)+import Data.Maybe (fromMaybe, listToMaybe)+import Data.Foldable (foldMap, toList)+import qualified Data.Map as M++import Documentation.Haddock++import DynFlags+import GHC+import GHC.Paths+import qualified GhcMonad as GHC (liftIO)+import Name (occNameString)+import Packages++import HDocs.Ghc.Compat++-- | Documentation in module+type ModuleDocMap = Map String (Doc String)++-- | Run action with initialized packages+withInitializedPackages :: [String] -> (DynFlags -> IO a) -> IO a+withInitializedPackages ghcOpts cont = runGhc (Just libdir) $ do+	fs <- getSessionDynFlags+	cleanupHandler fs $ do+		(fs', _, _) <- parseDynamicFlags fs (map noLoc ghcOpts)+		_ <- setSessionDynFlags fs'+		(result, _) <- GHC.liftIO $ initPackages fs'+		GHC.liftIO $ cont result++-- | Config GHC session+configSession :: [String] -> IO DynFlags+configSession ghcOpts = runGhc (Just libdir) $ do+	fs <- getSessionDynFlags+	cleanupHandler fs $ do+		(fs', _, _) <- parseDynamicFlags fs (map noLoc ghcOpts)+		_ <- setSessionDynFlags fs'+		(result, _) <- GHC.liftIO $ initPackages fs'+		return result++-- | Format documentation to plain text.+formatDoc :: Doc String -> String+formatDoc = trim . go where+	go :: Doc String -> String+	go (DocAppend a b) = go a ++ go b+	go (DocString str) = trimSpaces str+	go (DocParagraph p) = go p ++ "\n"+	go (DocIdentifier i) = unwrap i+	go (DocIdentifierUnchecked m) = moduleNameString mname ++ "." ++ occNameString occname where+			(mname, occname) = unwrap m+	go (DocModule m) = m+	go (DocWarning w) = go w+	go (DocEmphasis e) = "*" ++ go e ++ "*"+	go (DocMonospaced e) = "`" ++ go e ++ "`"+	go (DocBold b) = "*" ++ go b ++ "*"+	go (DocUnorderedList i) = unlines (map (("* " ++) . go) i)+	go (DocOrderedList i) = unlines (zipWith (\i' x -> show i' ++ ". " ++ go x) ([1..] :: [Integer]) i)+	go (DocDefList xs) = unlines (map (\(i,x) -> go i ++ ". " ++ go x) xs)+	go (DocCodeBlock block) = unlines (map ("    " ++) (lines (go block))) ++ "\n"+	go (DocHyperlink (Hyperlink url label)) = maybe url (\l -> showLabel l ++ "[" ++ url ++ "]") $ label where+#if MIN_VERSION_haddock_library(1,8,0)+			showLabel = go+#else+			showLabel = id+#endif+	go (DocPic pic) = show pic+#if MIN_VERSION_haddock_library(1,4,0)+	go (DocMathInline m) = m+	go (DocMathDisplay m) = m+#endif+	go (DocAName name) = name+	go (DocProperty prop) = prop+	go (DocExamples exs) = unlines (map formatExample exs)+	go (DocHeader h) = foldMap go h+	go _ = ""++	formatExample :: Example -> String+	formatExample (Example expr result) = ">>> " ++ expr ++ "\n" ++ unlines result++	trimSpaces [] = []+	trimSpaces [s] = [s]+	trimSpaces (' ':' ':ss) = trimSpaces (' ':ss)+	trimSpaces (x:y:ss) = x : trimSpaces(y:ss)++	trim :: String -> String+	trim = p . p where+		p = reverse . dropWhile isSpace++#if MIN_VERSION_haddock_library(1,8,0)+	unwrap = fromMaybe (error "toList on `Wrap` returns empty list") . listToMaybe . toList+#else+	unwrap = id+#endif++-- | Format docs to plain text+formatDocs :: ModuleDocMap -> Map String String+formatDocs = M.map formatDoc

src/HDocs/Compat.hs view

@@ -1,24 +1,24 @@-{-# LANGUAGE CPP #-}
-
-module HDocs.Compat (
-	readInterfaceFile,
-	mapDoc
-	) where
-
-import Control.Monad.IO.Class
-import Documentation.Haddock hiding (readInterfaceFile)
-import qualified Documentation.Haddock as Haddock
-
-readInterfaceFile :: MonadIO m => NameCacheAccessor m -> FilePath -> m (Either String InterfaceFile)
-#if MIN_VERSION_haddock_api(2,23,0)
-readInterfaceFile cache f = Haddock.readInterfaceFile cache f False
-#else
-readInterfaceFile = Haddock.readInterfaceFile
-#endif
-
-mapDoc :: (a -> b) -> Doc a -> Doc b
-#if MIN_VERSION_haddock_api(2,23,0)
-mapDoc = fmap . fmap
-#else
-mapDoc = fmap
-#endif
+{-# LANGUAGE CPP #-}++module HDocs.Compat (+	readInterfaceFile,+	mapDoc+	) where++import Control.Monad.IO.Class+import Documentation.Haddock hiding (readInterfaceFile)+import qualified Documentation.Haddock as Haddock++readInterfaceFile :: MonadIO m => NameCacheAccessor m -> FilePath -> m (Either String InterfaceFile)+#if MIN_VERSION_haddock_api(2,23,0)+readInterfaceFile cache f = Haddock.readInterfaceFile cache f False+#else+readInterfaceFile = Haddock.readInterfaceFile+#endif++mapDoc :: (a -> b) -> Doc a -> Doc b+#if MIN_VERSION_haddock_api(2,23,0)+mapDoc = fmap . fmap+#else+mapDoc = fmap+#endif

src/HDocs/Ghc/Compat.hs view

@@ -1,53 +1,53 @@-{-# LANGUAGE CPP #-}
-
-module HDocs.Ghc.Compat (
-	pkgDatabase, cleanupHandler, UnitId, unitId, moduleUnitId, getPackageDetails
-	) where
-
-import qualified GHC
-import qualified Module
-import qualified Packages as GHC
-
-#if __GLASGOW_HASKELL__ == 710
-import Exception (ExceptionMonad)
-#endif
-
-pkgDatabase :: GHC.DynFlags -> Maybe [GHC.PackageConfig]
-#if __GLASGOW_HASKELL__ >= 800
-pkgDatabase = fmap (concatMap snd) . GHC.pkgDatabase
-#elif __GLASGOW_HASKELL__ == 710
-pkgDatabase = GHC.pkgDatabase
-#endif
-
-#if __GLASGOW_HASKELL__ >= 800
-cleanupHandler :: GHC.DynFlags -> m a -> m a
-cleanupHandler _ = id
-#elif __GLASGOW_HASKELL__ == 710
-cleanupHandler :: (ExceptionMonad m) => GHC.DynFlags -> m a -> m a
-cleanupHandler = GHC.defaultCleanupHandler
-#endif
-
-#if __GLASGOW_HASKELL__ >= 800
-type UnitId = Module.UnitId
-#elif __GLASGOW_HASKELL__ == 710
-type UnitId = Module.PackageKey
-#endif
-
-unitId :: GHC.PackageConfig -> UnitId
-#if __GLASGOW_HASKELL__ >= 802
-unitId = GHC.packageConfigId
-#elif __GLASGOW_HASKELL__ == 800
-unitId = GHC.unitId
-#elif __GLASGOW_HASKELL__ == 710
-unitId = GHC.packageKey
-#endif
-
-moduleUnitId :: Module.Module -> UnitId
-#if __GLASGOW_HASKELL__ >= 800
-moduleUnitId = Module.moduleUnitId
-#elif __GLASGOW_HASKELL__ == 710
-moduleUnitId = Module.modulePackageKey
-#endif
-
-getPackageDetails :: GHC.DynFlags -> UnitId -> GHC.PackageConfig
-getPackageDetails = GHC.getPackageDetails
+{-# LANGUAGE CPP #-}++module HDocs.Ghc.Compat (+	pkgDatabase, cleanupHandler, UnitId, unitId, moduleUnitId, getPackageDetails+	) where++import qualified GHC+import qualified Module+import qualified Packages as GHC++#if __GLASGOW_HASKELL__ == 710+import Exception (ExceptionMonad)+#endif++pkgDatabase :: GHC.DynFlags -> Maybe [GHC.PackageConfig]+#if __GLASGOW_HASKELL__ >= 800+pkgDatabase = fmap (concatMap snd) . GHC.pkgDatabase+#elif __GLASGOW_HASKELL__ == 710+pkgDatabase = GHC.pkgDatabase+#endif++#if __GLASGOW_HASKELL__ >= 800+cleanupHandler :: GHC.DynFlags -> m a -> m a+cleanupHandler _ = id+#elif __GLASGOW_HASKELL__ == 710+cleanupHandler :: (ExceptionMonad m) => GHC.DynFlags -> m a -> m a+cleanupHandler = GHC.defaultCleanupHandler+#endif++#if __GLASGOW_HASKELL__ >= 800+type UnitId = Module.UnitId+#elif __GLASGOW_HASKELL__ == 710+type UnitId = Module.PackageKey+#endif++unitId :: GHC.PackageConfig -> UnitId+#if __GLASGOW_HASKELL__ >= 802+unitId = GHC.packageConfigId+#elif __GLASGOW_HASKELL__ == 800+unitId = GHC.unitId+#elif __GLASGOW_HASKELL__ == 710+unitId = GHC.packageKey+#endif++moduleUnitId :: Module.Module -> UnitId+#if __GLASGOW_HASKELL__ >= 800+moduleUnitId = Module.moduleUnitId+#elif __GLASGOW_HASKELL__ == 710+moduleUnitId = Module.modulePackageKey+#endif++getPackageDetails :: GHC.DynFlags -> UnitId -> GHC.PackageConfig+getPackageDetails = GHC.getPackageDetails

src/HDocs/Haddock.hs view

@@ -1,133 +1,133 @@-module HDocs.Haddock (
-	-- * Documentation functions
-	readInstalledDocsF, readInstalledDocs,
-	readHaddock,
-	readSources, readSources_, readSource, readSourcesGhc, readSourceGhc,
-
-	-- * Extract docs
-	installedInterfaceDocs, installedInterfacesDocs,
-	interfaceDocs,	
-
-	-- * Utility functions
-	haddockFilesF, haddockFiles,
-	readInstalledInterfaces, readPackageInterfaces,
-	lookupDoc, lookupNameDoc,
-
-	module HDocs.Base,
-
-	Ghc,
-	module Control.Monad.Except,
-	withGhc
-	) where
-
-import Control.Applicative
-import Control.Arrow
-import Control.Exception
-import Control.Monad.Except
-import Data.Map (Map)
-import qualified Data.Map as M
-import Data.Maybe (listToMaybe)
-
-import Documentation.Haddock hiding (readInterfaceFile)
-import Documentation.Haddock.Types (_doc)
-
-import DynFlags (DynFlags)
-import Exception (gtry)
-import GHC (Ghc)
-import Module
-import Name
-import PackageConfig
-
-import HDocs.Base
-import HDocs.Compat
-import HDocs.Ghc.Compat
-
--- | Read all installed docs
-readInstalledDocsF :: DynFlags -> ExceptT String IO (Map String ModuleDocMap)
-readInstalledDocsF df = do
-	fs <- haddockFilesF df
-	liftM M.unions $ forM fs $ \f -> (readHaddock f) `mplus` (return M.empty)
-
--- | Read all installed docs
-readInstalledDocs :: [String] -> ExceptT String IO (Map String ModuleDocMap)
-readInstalledDocs opts = do
-	fs <- haddockFiles opts
-	liftM M.unions $ forM fs $ \f -> (readHaddock f) `mplus` (return M.empty)
-
--- | Read docs from .haddock file
-readHaddock :: FilePath -> ExceptT String IO (Map String ModuleDocMap)
-readHaddock f = M.fromList . map installedInterfaceDocs <$> readInstalledInterfaces f
-
--- | Read docs for haskell modules
-readSources :: [String] -> [FilePath] -> ExceptT String IO (Map String ModuleDocMap)
-readSources opts = liftM M.fromList . readSources_ opts
-
--- | Read docs for haskell modules
-readSources_ :: [String] -> [FilePath] -> ExceptT String IO [(String, ModuleDocMap)]
-readSources_ opts fs = do
-	ifaces <- liftError $ liftIO $ createInterfaces ([Flag_Verbosity "0", Flag_NoWarnings, Flag_UseUnicode] ++ map Flag_OptGhc opts) fs
-	return $ map interfaceDocs ifaces
-
--- | Read docs for haskell module
-readSource :: [String] -> FilePath -> ExceptT String IO (String, ModuleDocMap)
-readSource opts f = liftM listToMaybe (readSources_ opts [f]) >>= maybe (throwError $ "Failed to load docs for " ++ f) return
-
--- | Read docs for source in Ghc monad
-readSourcesGhc :: [String] -> [FilePath] -> ExceptT String Ghc [(String, ModuleDocMap)]
-readSourcesGhc opts fs = ExceptT $ liftM (left (show :: SomeException -> String)) $ gtry $ do
-	ifaces <- liftM fst $ processModules minBound fs ([Flag_Verbosity "0", Flag_NoWarnings, Flag_UseUnicode] ++ map Flag_OptGhc opts) []
-	return $ map interfaceDocs ifaces
-
--- | Read docs for haskell module
-readSourceGhc :: [String] -> FilePath -> ExceptT String Ghc (String, ModuleDocMap)
-readSourceGhc opts f = liftM listToMaybe (readSourcesGhc opts [f]) >>= maybe (throwError $ "Failed to load docs for " ++ f) return
-
--- | Get docs for 'InstalledInterface'
-installedInterfaceDocs :: InstalledInterface -> (String, ModuleDocMap)
-installedInterfaceDocs = stringize . (instMod &&& (fmap _doc . instDocMap))
-
--- | Get docs for 'InstalledInterface's
-installedInterfacesDocs :: [InstalledInterface] -> Map String ModuleDocMap
-installedInterfacesDocs = M.fromList . map installedInterfaceDocs
-
--- | Get docs for 'Interface'
-interfaceDocs :: Interface -> (String, ModuleDocMap)
-interfaceDocs = stringize . (ifaceMod &&& (fmap _doc . ifaceDocMap))
-
--- | Get list of haddock files in package db
-haddockFilesF :: DynFlags -> ExceptT String IO [FilePath]
-haddockFilesF = ExceptT . return . maybe
-	(Left "Package database empty")
-	(Right . concatMap haddockInterfaces) .
-	pkgDatabase
-
--- | Get list of haddock files in package db
-haddockFiles :: [String] -> ExceptT String IO [FilePath]
-haddockFiles opts = ExceptT $ withInitializedPackages opts (runExceptT . haddockFilesF)
-
--- | Read installed interface
-readInstalledInterfaces :: FilePath -> ExceptT String IO [InstalledInterface]
-readInstalledInterfaces f = do
-	ifile <- liftError $ ExceptT $ readInterfaceFile freshNameCache f
-	return $ ifInstalledIfaces ifile
-
--- | Read installed interfaces for package
-readPackageInterfaces :: PackageConfig -> ExceptT String IO [InstalledInterface]
-readPackageInterfaces = liftM concat . mapM readInstalledInterfaces . haddockInterfaces
-
--- | Lookup doc
-lookupDoc :: String -> String -> Map String ModuleDocMap -> Maybe (Doc String)
-lookupDoc m n = M.lookup m >=> M.lookup n
-
--- | Lookup doc for Name
-lookupNameDoc :: Name -> Map String ModuleDocMap -> Maybe (Doc String)
-lookupNameDoc n = lookupDoc (moduleNameString $ moduleName $ nameModule n) (getOccString n)
-
-stringize :: (Module, Map Name (Doc Name)) -> (String, ModuleDocMap)
-stringize = moduleNameString . moduleName *** strDoc where
-	strDoc = M.mapKeys getOccString . M.map (mapDoc getOccString)
-
-liftError :: ExceptT String IO a -> ExceptT String IO a
-liftError = ExceptT . handle onErr . runExceptT where
-	onErr :: SomeException -> IO (Either String a)
-	onErr = return . Left . show
+module HDocs.Haddock (+	-- * Documentation functions+	readInstalledDocsF, readInstalledDocs,+	readHaddock,+	readSources, readSources_, readSource, readSourcesGhc, readSourceGhc,++	-- * Extract docs+	installedInterfaceDocs, installedInterfacesDocs,+	interfaceDocs,	++	-- * Utility functions+	haddockFilesF, haddockFiles,+	readInstalledInterfaces, readPackageInterfaces,+	lookupDoc, lookupNameDoc,++	module HDocs.Base,++	Ghc,+	module Control.Monad.Except,+	withGhc+	) where++import Control.Applicative+import Control.Arrow+import Control.Exception+import Control.Monad.Except+import Data.Map (Map)+import qualified Data.Map as M+import Data.Maybe (listToMaybe)++import Documentation.Haddock hiding (readInterfaceFile)+import Documentation.Haddock.Types (_doc)++import DynFlags (DynFlags)+import Exception (gtry)+import GHC (Ghc)+import Module+import Name+import PackageConfig++import HDocs.Base+import HDocs.Compat+import HDocs.Ghc.Compat++-- | Read all installed docs+readInstalledDocsF :: DynFlags -> ExceptT String IO (Map String ModuleDocMap)+readInstalledDocsF df = do+	fs <- haddockFilesF df+	liftM M.unions $ forM fs $ \f -> (readHaddock f) `mplus` (return M.empty)++-- | Read all installed docs+readInstalledDocs :: [String] -> ExceptT String IO (Map String ModuleDocMap)+readInstalledDocs opts = do+	fs <- haddockFiles opts+	liftM M.unions $ forM fs $ \f -> (readHaddock f) `mplus` (return M.empty)++-- | Read docs from .haddock file+readHaddock :: FilePath -> ExceptT String IO (Map String ModuleDocMap)+readHaddock f = M.fromList . map installedInterfaceDocs <$> readInstalledInterfaces f++-- | Read docs for haskell modules+readSources :: [String] -> [FilePath] -> ExceptT String IO (Map String ModuleDocMap)+readSources opts = liftM M.fromList . readSources_ opts++-- | Read docs for haskell modules+readSources_ :: [String] -> [FilePath] -> ExceptT String IO [(String, ModuleDocMap)]+readSources_ opts fs = do+	ifaces <- liftError $ liftIO $ createInterfaces ([Flag_Verbosity "0", Flag_NoWarnings, Flag_UseUnicode] ++ map Flag_OptGhc opts) fs+	return $ map interfaceDocs ifaces++-- | Read docs for haskell module+readSource :: [String] -> FilePath -> ExceptT String IO (String, ModuleDocMap)+readSource opts f = liftM listToMaybe (readSources_ opts [f]) >>= maybe (throwError $ "Failed to load docs for " ++ f) return++-- | Read docs for source in Ghc monad+readSourcesGhc :: [String] -> [FilePath] -> ExceptT String Ghc [(String, ModuleDocMap)]+readSourcesGhc opts fs = ExceptT $ liftM (left (show :: SomeException -> String)) $ gtry $ do+	ifaces <- liftM fst $ processModules minBound fs ([Flag_Verbosity "0", Flag_NoWarnings, Flag_UseUnicode] ++ map Flag_OptGhc opts) []+	return $ map interfaceDocs ifaces++-- | Read docs for haskell module+readSourceGhc :: [String] -> FilePath -> ExceptT String Ghc (String, ModuleDocMap)+readSourceGhc opts f = liftM listToMaybe (readSourcesGhc opts [f]) >>= maybe (throwError $ "Failed to load docs for " ++ f) return++-- | Get docs for 'InstalledInterface'+installedInterfaceDocs :: InstalledInterface -> (String, ModuleDocMap)+installedInterfaceDocs = stringize . (instMod &&& (fmap _doc . instDocMap))++-- | Get docs for 'InstalledInterface's+installedInterfacesDocs :: [InstalledInterface] -> Map String ModuleDocMap+installedInterfacesDocs = M.fromList . map installedInterfaceDocs++-- | Get docs for 'Interface'+interfaceDocs :: Interface -> (String, ModuleDocMap)+interfaceDocs = stringize . (ifaceMod &&& (fmap _doc . ifaceDocMap))++-- | Get list of haddock files in package db+haddockFilesF :: DynFlags -> ExceptT String IO [FilePath]+haddockFilesF = ExceptT . return . maybe+	(Left "Package database empty")+	(Right . concatMap haddockInterfaces) .+	pkgDatabase++-- | Get list of haddock files in package db+haddockFiles :: [String] -> ExceptT String IO [FilePath]+haddockFiles opts = ExceptT $ withInitializedPackages opts (runExceptT . haddockFilesF)++-- | Read installed interface+readInstalledInterfaces :: FilePath -> ExceptT String IO [InstalledInterface]+readInstalledInterfaces f = do+	ifile <- liftError $ ExceptT $ readInterfaceFile freshNameCache f+	return $ ifInstalledIfaces ifile++-- | Read installed interfaces for package+readPackageInterfaces :: PackageConfig -> ExceptT String IO [InstalledInterface]+readPackageInterfaces = liftM concat . mapM readInstalledInterfaces . haddockInterfaces++-- | Lookup doc+lookupDoc :: String -> String -> Map String ModuleDocMap -> Maybe (Doc String)+lookupDoc m n = M.lookup m >=> M.lookup n++-- | Lookup doc for Name+lookupNameDoc :: Name -> Map String ModuleDocMap -> Maybe (Doc String)+lookupNameDoc n = lookupDoc (moduleNameString $ moduleName $ nameModule n) (getOccString n)++stringize :: (Module, Map Name (Doc Name)) -> (String, ModuleDocMap)+stringize = moduleNameString . moduleName *** strDoc where+	strDoc = M.mapKeys getOccString . M.map (mapDoc getOccString)++liftError :: ExceptT String IO a -> ExceptT String IO a+liftError = ExceptT . handle onErr . runExceptT where+	onErr :: SomeException -> IO (Either String a)+	onErr = return . Left . show

src/HDocs/Module.hs view

@@ -1,88 +1,88 @@-module HDocs.Module (
-	-- * Get module docs
-	moduleDocsF, moduleDocs, installedDocsF, installedDocs,
-
-	-- * Utility
-	exportsDocs,
-
-	module HDocs.Base
-	) where
-
-import Control.Applicative
-import Control.Monad.Except
-
-import Data.List
-import Data.Map (Map)
-import qualified Data.Map as M
-import Data.Maybe
-
-import Documentation.Haddock
-
-import DynFlags
-import Module
-import Outputable (showSDoc, ppr)
-import Packages
-import Name
-
-import HDocs.Base
-import qualified HDocs.Ghc.Compat as Compat
-import qualified HDocs.Haddock as H
-
--- | Load docs for all exported module symbols
-moduleDocsF :: DynFlags -> String -> ExceptT String IO ModuleDocMap
-moduleDocsF df mname = do
-	pkg <- case pkgs of
-		[] -> throwError $ "Module " ++ mname ++ " not found"
-		[pkg] -> return pkg
-		_ -> throwError $ "Module " ++ mname ++ " found in several packages: " ++ intercalate ", " (map (pkgId df) pkgs)
-	ifaces <- H.readPackageInterfaces pkg
-	iface <- maybe
-		(throwError $ "Module " ++ mname ++ " not found in package " ++ pkgId df pkg)
-		return
-		(find ((== mname) . moduleNameString . moduleName . instMod) ifaces)
-
-	depsfaces <- liftM concat $ mapM H.readPackageInterfaces $
-		map (getPackageDetails df) $ ifacePackageDeps iface
-
-	let
-		deps = filter (ifaceDep iface) $ ifaces ++ depsfaces
-
-	return $ snd $ exportsDocs (H.installedInterfacesDocs deps) iface
-	where
-		pkgs = filter exposed $ map snd $ lookupModuleInAllPackages df (mkModuleName mname)
-
-		namePackage :: Name -> Compat.UnitId
-		namePackage = Compat.moduleUnitId . nameModule
-
-		ifacePackageDeps :: InstalledInterface -> [Compat.UnitId]
-		ifacePackageDeps i = (Compat.moduleUnitId $ instMod i) `delete` (nub . map namePackage . instExports $ i)
-
-		ifaceDep :: InstalledInterface -> InstalledInterface -> Bool
-		ifaceDep i idep = instMod i /= instMod idep && instMod idep `elem` map nameModule (instExports i)
-
-		pkgId :: DynFlags -> PackageConfig -> String
-		pkgId d = showSDoc d . ppr . Compat.unitId
-
--- | Load docs for all exported module symbols
-moduleDocs :: [String] -> String -> ExceptT String IO ModuleDocMap
-moduleDocs opts mname = ExceptT $ withInitializedPackages opts (runExceptT . flip moduleDocsF mname) where
-
--- | Load docs for all installed modules
-installedDocsF :: DynFlags -> ExceptT String IO (Map String ModuleDocMap)
-installedDocsF df = do
-	fs <- maybe (throwError "Package database empty") (return . concatMap haddockInterfaces) $ Compat.pkgDatabase df
-	ifaces <- liftM concat $ mapM ((`mplus` return []) . H.readInstalledInterfaces) fs
-	let
-		idocs = H.installedInterfacesDocs ifaces
-	return $ M.fromList $ map (exportsDocs idocs) ifaces
-
--- | Load docs for all installed modules
-installedDocs :: [String] -> ExceptT String IO (Map String ModuleDocMap)
-installedDocs opts = ExceptT $ withInitializedPackages opts (runExceptT . installedDocsF)
-
--- | Get docs for 'InstalledInterface' with its exports docs
-exportsDocs :: Map String ModuleDocMap -> InstalledInterface -> (String, ModuleDocMap)
-exportsDocs docs iface = (iname, snd (H.installedInterfaceDocs iface) `M.union` edocs) where
-	iname = moduleNameString $ moduleName $ instMod iface
-	edocs = M.fromList $ mapMaybe findDoc (instExports iface)
-	findDoc n = ((,) (getOccString n)) <$> (H.lookupNameDoc n docs)
+module HDocs.Module (+	-- * Get module docs+	moduleDocsF, moduleDocs, installedDocsF, installedDocs,++	-- * Utility+	exportsDocs,++	module HDocs.Base+	) where++import Control.Applicative+import Control.Monad.Except++import Data.List+import Data.Map (Map)+import qualified Data.Map as M+import Data.Maybe++import Documentation.Haddock++import DynFlags+import Module+import Outputable (showSDoc, ppr)+import Packages+import Name++import HDocs.Base+import qualified HDocs.Ghc.Compat as Compat+import qualified HDocs.Haddock as H++-- | Load docs for all exported module symbols+moduleDocsF :: DynFlags -> String -> ExceptT String IO ModuleDocMap+moduleDocsF df mname = do+	pkg <- case pkgs of+		[] -> throwError $ "Module " ++ mname ++ " not found"+		[pkg] -> return pkg+		_ -> throwError $ "Module " ++ mname ++ " found in several packages: " ++ intercalate ", " (map (pkgId df) pkgs)+	ifaces <- H.readPackageInterfaces pkg+	iface <- maybe+		(throwError $ "Module " ++ mname ++ " not found in package " ++ pkgId df pkg)+		return+		(find ((== mname) . moduleNameString . moduleName . instMod) ifaces)++	depsfaces <- liftM concat $ mapM H.readPackageInterfaces $+		map (getPackageDetails df) $ ifacePackageDeps iface++	let+		deps = filter (ifaceDep iface) $ ifaces ++ depsfaces++	return $ snd $ exportsDocs (H.installedInterfacesDocs deps) iface+	where+		pkgs = filter exposed $ map snd $ lookupModuleInAllPackages df (mkModuleName mname)++		namePackage :: Name -> Compat.UnitId+		namePackage = Compat.moduleUnitId . nameModule++		ifacePackageDeps :: InstalledInterface -> [Compat.UnitId]+		ifacePackageDeps i = (Compat.moduleUnitId $ instMod i) `delete` (nub . map namePackage . instExports $ i)++		ifaceDep :: InstalledInterface -> InstalledInterface -> Bool+		ifaceDep i idep = instMod i /= instMod idep && instMod idep `elem` map nameModule (instExports i)++		pkgId :: DynFlags -> PackageConfig -> String+		pkgId d = showSDoc d . ppr . Compat.unitId++-- | Load docs for all exported module symbols+moduleDocs :: [String] -> String -> ExceptT String IO ModuleDocMap+moduleDocs opts mname = ExceptT $ withInitializedPackages opts (runExceptT . flip moduleDocsF mname) where++-- | Load docs for all installed modules+installedDocsF :: DynFlags -> ExceptT String IO (Map String ModuleDocMap)+installedDocsF df = do+	fs <- maybe (throwError "Package database empty") (return . concatMap haddockInterfaces) $ Compat.pkgDatabase df+	ifaces <- liftM concat $ mapM ((`mplus` return []) . H.readInstalledInterfaces) fs+	let+		idocs = H.installedInterfacesDocs ifaces+	return $ M.fromList $ map (exportsDocs idocs) ifaces++-- | Load docs for all installed modules+installedDocs :: [String] -> ExceptT String IO (Map String ModuleDocMap)+installedDocs opts = ExceptT $ withInitializedPackages opts (runExceptT . installedDocsF)++-- | Get docs for 'InstalledInterface' with its exports docs+exportsDocs :: Map String ModuleDocMap -> InstalledInterface -> (String, ModuleDocMap)+exportsDocs docs iface = (iname, snd (H.installedInterfaceDocs iface) `M.union` edocs) where+	iname = moduleNameString $ moduleName $ instMod iface+	edocs = M.fromList $ mapMaybe findDoc (instExports iface)+	findDoc n = ((,) (getOccString n)) <$> (H.lookupNameDoc n docs)

tests/HelpTest.hs view

@@ -1,5 +1,5 @@-module HelpTest (test) where
-
--- | This is test function with documentation
-test :: ()
-test = ()
+module HelpTest (test) where++-- | This is test function with documentation+test :: ()+test = ()

tests/Test.hs view

@@ -1,29 +1,29 @@-module Main (
-	main
-	) where
-
-import Control.Monad
-import Control.Monad.Except
-import qualified Data.Map as M
-
-import System.Exit
-
-import HDocs.Module
-import HDocs.Haddock
-
--- | This is main function
-main :: IO ()
-main = runExceptT main' >>= either (\e -> putStrLn e >> exitFailure) (const exitSuccess) where
-	main' :: ExceptT String IO ()
-	main' = do
-		sdocs <- fmt $ liftM snd $ readSource [] "tests/HelpTest.hs"
-		check "Documentation for file: Test.hs, test"
-			(M.lookup "test" sdocs == Just "This is test function with documentation")
-		-- edocs <- fmt $ moduleDocs [] "Prelude"
-		-- check "Documentation for installed module: Prelude.null"
-		-- 	(M.lookup "null" edocs `elem`
-		-- 		[Just "Test whether a list is empty.",
-		-- 		Just "Test whether the structure is empty. The default implementation is\n optimized for structures that are similar to cons-lists, because there\n is no general way to do better."])
-		where
-			check str p = unless p $ throwError str
-			fmt = liftM formatDocs
+module Main (+	main+	) where++import Control.Monad+import Control.Monad.Except+import qualified Data.Map as M++import System.Exit++import HDocs.Module+import HDocs.Haddock++-- | This is main function+main :: IO ()+main = runExceptT main' >>= either (\e -> putStrLn e >> exitFailure) (const exitSuccess) where+	main' :: ExceptT String IO ()+	main' = do+		sdocs <- fmt $ liftM snd $ readSource [] "tests/HelpTest.hs"+		check "Documentation for file: Test.hs, test"+			(M.lookup "test" sdocs == Just "This is test function with documentation")+		-- edocs <- fmt $ moduleDocs [] "Prelude"+		-- check "Documentation for installed module: Prelude.null"+		-- 	(M.lookup "null" edocs `elem`+		-- 		[Just "Test whether a list is empty.",+		-- 		Just "Test whether the structure is empty. The default implementation is\n optimized for structures that are similar to cons-lists, because there\n is no general way to do better."])+		where+			check str p = unless p $ throwError str+			fmt = liftM formatDocs

tools/hdocs.hs view

@@ -1,86 +1,86 @@-module Main (
-	main
-	) where
-
-import Control.Monad.Except
-import Data.Aeson
-import Data.Aeson.Encode.Pretty (encodePretty)
-import Data.ByteString.Lazy (toStrict)
-import qualified Data.Map as M
-import Data.Monoid (Monoid(..))
-import Data.Semigroup (Semigroup(..))
-import qualified Data.Text as T (unpack, pack)
-import qualified Data.Text.Encoding as T (decodeUtf8)
-import Documentation.Haddock (Flag(Flag_OptGhc))
-
-import HDocs.Haddock
-import HDocs.Module
-
-import System.Console.GetOpt
-import System.Environment (getArgs)
-import System.FilePath (takeExtension)
-import System.IO
-
-data HDocsOptions = HDocsOptions {
-	optionPretty :: Bool,
-	optionGHC :: [String] }
-
-instance Semigroup HDocsOptions where
-	l <> r = HDocsOptions (optionPretty l || optionPretty r) (optionGHC l ++ optionGHC r)
-
-instance Monoid HDocsOptions where
-	mempty = HDocsOptions False []
-	mappend l r = HDocsOptions (optionPretty l || optionPretty r) (optionGHC l ++ optionGHC r)
-
-opts :: [OptDescr HDocsOptions]
-opts = [
-	Option [] ["pretty"] (NoArg $ HDocsOptions True []) "pretty JSON output",
-	Option ['g'] ["ghc"] (ReqArg (\s -> HDocsOptions False [s]) "GHC_OPT") "option to pass to GHC"]
-
-main :: IO ()
-main = do
-	hSetEncoding stdout utf8
-
-	(cfgs, cmds, _) <- fmap (getOpt Permute opts) getArgs
-
-	let
-		cfg = mconcat cfgs
-		isPretty = optionPretty cfg
-
-		toStr :: ToJSON a => a -> String
-		toStr = T.unpack . T.decodeUtf8 . toStrict . encode' where
-			encode'
-				| isPretty = encodePretty
-				| otherwise = encode
-
-		jsonError :: String -> Value
-		jsonError err = object [
-			T.pack "error" .= err]
-
-		run :: ToJSON a => ExceptT String IO a -> IO ()
-		run act = runExceptT act >>= putStrLn . either (toStr . jsonError) toStr
-
-		loadDocs :: String -> ExceptT String IO ModuleDocMap
-		loadDocs m
-			| takeExtension m == ".hs" = liftM snd $ ExceptT $ withGhc (map Flag_OptGhc $ optionGHC cfg) $ runExceptT $ readSourceGhc (optionGHC cfg) m
-			| otherwise = moduleDocs (optionGHC cfg) m
-
-	case cmds of
-		["dump", "r"] -> run $ liftM (M.map formatDocs) $ installedDocs (optionGHC cfg)
-		["dump"] -> run $ liftM (M.map formatDocs) $ readInstalledDocs (optionGHC cfg)
-		[m] -> run $ liftM formatDocs $ loadDocs m `mplus` do
-			mdocs <- installedDocs (optionGHC cfg)
-			return $ M.mapMaybe (M.lookup m) mdocs
-		[m, n] -> run $ liftM formatDocs $ do
-			docs <- loadDocs m
-			maybe (throwError $ "Symbol '" ++ n ++ "' not found") (return . M.singleton n) $ M.lookup n docs
-		_ -> printUsage
-
-printUsage :: IO ()
-printUsage = mapM_ putStrLn [
-	"Usage:",
-	"  hdocs <module> - get docs for module/file",
-	"  hdocs <module> <name> - get docs for name in module/file",
-	"  hdocs dump [r] - dump all installed docs, if [r], find docs for reexported declarations",
-	"",
-	usageInfo "flags" opts]
+module Main (+	main+	) where++import Control.Monad.Except+import Data.Aeson+import Data.Aeson.Encode.Pretty (encodePretty)+import Data.ByteString.Lazy (toStrict)+import qualified Data.Map as M+import Data.Monoid (Monoid(..))+import Data.Semigroup (Semigroup(..))+import qualified Data.Text as T (unpack, pack)+import qualified Data.Text.Encoding as T (decodeUtf8)+import Documentation.Haddock (Flag(Flag_OptGhc))++import HDocs.Haddock+import HDocs.Module++import System.Console.GetOpt+import System.Environment (getArgs)+import System.FilePath (takeExtension)+import System.IO++data HDocsOptions = HDocsOptions {+	optionPretty :: Bool,+	optionGHC :: [String] }++instance Semigroup HDocsOptions where+	l <> r = HDocsOptions (optionPretty l || optionPretty r) (optionGHC l ++ optionGHC r)++instance Monoid HDocsOptions where+	mempty = HDocsOptions False []+	mappend l r = HDocsOptions (optionPretty l || optionPretty r) (optionGHC l ++ optionGHC r)++opts :: [OptDescr HDocsOptions]+opts = [+	Option [] ["pretty"] (NoArg $ HDocsOptions True []) "pretty JSON output",+	Option ['g'] ["ghc"] (ReqArg (\s -> HDocsOptions False [s]) "GHC_OPT") "option to pass to GHC"]++main :: IO ()+main = do+	hSetEncoding stdout utf8++	(cfgs, cmds, _) <- fmap (getOpt Permute opts) getArgs++	let+		cfg = mconcat cfgs+		isPretty = optionPretty cfg++		toStr :: ToJSON a => a -> String+		toStr = T.unpack . T.decodeUtf8 . toStrict . encode' where+			encode'+				| isPretty = encodePretty+				| otherwise = encode++		jsonError :: String -> Value+		jsonError err = object [+			T.pack "error" .= err]++		run :: ToJSON a => ExceptT String IO a -> IO ()+		run act = runExceptT act >>= putStrLn . either (toStr . jsonError) toStr++		loadDocs :: String -> ExceptT String IO ModuleDocMap+		loadDocs m+			| takeExtension m == ".hs" = liftM snd $ ExceptT $ withGhc (map Flag_OptGhc $ optionGHC cfg) $ runExceptT $ readSourceGhc (optionGHC cfg) m+			| otherwise = moduleDocs (optionGHC cfg) m++	case cmds of+		["dump", "r"] -> run $ liftM (M.map formatDocs) $ installedDocs (optionGHC cfg)+		["dump"] -> run $ liftM (M.map formatDocs) $ readInstalledDocs (optionGHC cfg)+		[m] -> run $ liftM formatDocs $ loadDocs m `mplus` do+			mdocs <- installedDocs (optionGHC cfg)+			return $ M.mapMaybe (M.lookup m) mdocs+		[m, n] -> run $ liftM formatDocs $ do+			docs <- loadDocs m+			maybe (throwError $ "Symbol '" ++ n ++ "' not found") (return . M.singleton n) $ M.lookup n docs+		_ -> printUsage++printUsage :: IO ()+printUsage = mapM_ putStrLn [+	"Usage:",+	"  hdocs <module> - get docs for module/file",+	"  hdocs <module> <name> - get docs for name in module/file",+	"  hdocs dump [r] - dump all installed docs, if [r], find docs for reexported declarations",+	"",+	usageInfo "flags" opts]