diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,9 @@ +1.0.7 + +* [Add `--base-import-url` flag](https://github.com/dhall-lang/dhall-haskell/pull/2215) + * This flag adds a URL prefix to all paths copied to the clipboard for ease + of pasting the import in Dhall code + 1.0.6 * Build against `dhall-1.39.0` diff --git a/dhall-docs.cabal b/dhall-docs.cabal --- a/dhall-docs.cabal +++ b/dhall-docs.cabal @@ -1,8 +1,7 @@ Name: dhall-docs -Version: 1.0.6 +Version: 1.0.7 Cabal-Version: >=1.10 Build-Type: Simple -Tested-With: GHC == 8.6.1 License: BSD3 License-File: LICENSE Copyright: 2020 Germán Robayo @@ -67,15 +66,15 @@ containers , cryptonite < 0.30, directory >= 1.3.0.0 && < 1.4 , - dhall >= 1.38.0 && < 1.40, + dhall >= 1.38.0 && < 1.41, file-embed >= 0.0.10.0 , filepath >= 1.4 && < 1.5 , lens-family-core >= 1.0.0 && < 2.2 , lucid >= 2.9.12 && < 2.10, mmark >= 0.0.7.0 && < 0.8 , - megaparsec >= 7 && < 9.1 , + megaparsec >= 7 && < 9.2 , memory < 0.17, - path >= 0.7.0 && < 0.9 , + path >= 0.7.0 && < 0.10, path-io >= 1.6.0 && < 1.7 , prettyprinter >= 1.5.1 && < 1.8 , text >= 0.11.1.0 && < 1.3 , diff --git a/src/Dhall/Docs.hs b/src/Dhall/Docs.hs --- a/src/Dhall/Docs.hs +++ b/src/Dhall/Docs.hs @@ -16,7 +16,7 @@ , defaultMain ) where -import Control.Applicative ((<|>)) +import Control.Applicative (optional, (<|>)) import Data.Text (Text) import Data.Version (showVersion) import Dhall.Pretty (CharacterSet(..)) @@ -39,10 +39,13 @@ -- | Command line options data Options = Options - { packageDir :: FilePath -- ^ Directory where your package resides - , docLink :: FilePath -- ^ Link to the generated documentation + { packageDir :: FilePath + -- ^ Directory where your package resides + , docLink :: FilePath + -- ^ Link to the generated documentation , resolvePackageName :: Path Abs Dir -> Text , characterSet :: CharacterSet + , baseImportUrl :: Maybe Text } | Version @@ -51,24 +54,36 @@ parseOptions = ( Options <$> Options.Applicative.strOption - ( Options.Applicative.long "input" - <> Options.Applicative.metavar "INPUT" - <> Options.Applicative.help "Directory of your dhall package" - <> Options.Applicative.action "directory" - ) + ( Options.Applicative.long "input" + <> Options.Applicative.metavar "INPUT" + <> Options.Applicative.help "Directory of your dhall package" + <> Options.Applicative.action "directory" + ) <*> Options.Applicative.strOption - ( Options.Applicative.long "output-link" - <> Options.Applicative.metavar "OUTPUT-LINK" - <> Options.Applicative.help - ( "Path to the link targeting the directory with the generated " - <> "documentation. The path needs to not exist or to be a symlink, " - <> "otherwise the tool won't generate any docs at all" - ) - <> Options.Applicative.value "./docs" - <> Options.Applicative.action "directory" - ) + ( Options.Applicative.long "output-link" + <> Options.Applicative.metavar "OUTPUT-LINK" + <> Options.Applicative.help + ( "Path to the link targeting the directory with the generated " + <> "documentation. The path needs to not exist or to be a " + <> "symlink, otherwise the tool won't generate any docs at all" + ) + <> Options.Applicative.value "./docs" + <> Options.Applicative.action "directory" + ) <*> parsePackageNameResolver <*> parseAscii + <*> optional + (Options.Applicative.strOption + ( Options.Applicative.long "base-import-url" + <> Options.Applicative.metavar "URL" + <> Options.Applicative.help + ( "Base URL for importing the package. This is used by " + <> "the 'Copy path to clipboard' feature to prepend the " + <> "specified URL to all copied paths so that they can be " + <> "pasted as valid imports for Dhall code" + ) + ) + ) ) <|> parseVersion where switch name description = @@ -134,7 +149,7 @@ resolvedDocLink <- Path.IO.resolveDir' docLink let packageName = resolvePackageName resolvedPackageDir - generateDocs resolvedPackageDir resolvedDocLink packageName characterSet + generateDocs resolvedPackageDir resolvedDocLink baseImportUrl packageName characterSet Version -> putStrLn (showVersion Meta.version) diff --git a/src/Dhall/Docs/CodeRenderer.hs b/src/Dhall/Docs/CodeRenderer.hs --- a/src/Dhall/Docs/CodeRenderer.hs +++ b/src/Dhall/Docs/CodeRenderer.hs @@ -341,9 +341,16 @@ -- to render the source code with the same structure (whitespaces, comments, -- language elements) as the source file renderCodeWithHyperLinks :: Text -> Expr Src Import -> Html () -renderCodeWithHyperLinks contents expr = pre_ $ go (1, 1) (Text.lines contents) imports +renderCodeWithHyperLinks contents expr = pre_ $ go (1, 1) lines_ imports where imports = fragments expr + + lines_ = map fixWindows (Text.lines contents) + + fixWindows line + | Text.null line = line + | Text.last line == '\r' = Text.init line + | otherwise = line -- we keep the current line, column and consumed text as part of function argument go :: (Int, Int) -> [Text] -> [SourceCodeFragment] -> Html () diff --git a/src/Dhall/Docs/Core.hs b/src/Dhall/Docs/Core.hs --- a/src/Dhall/Docs/Core.hs +++ b/src/Dhall/Docs/Core.hs @@ -288,14 +288,14 @@ "." -> "" _ -> "../" <> resolveRelativePath (Path.parent currentDir) -{-| Generates `Text` from the HTML representation of a `DhallFile` --} +-- | Generates `Text` from the HTML representation of a `DhallFile` makeHtml - :: Text -- ^ Package name + :: Maybe Text -- ^ Base import URL + -> Text -- ^ Package name -> CharacterSet -- ^ Output encoding -> DhallFile -- ^ Parsed header -> GeneratedDocs Text -makeHtml packageName characterSet DhallFile {..} = do +makeHtml baseImportUrl packageName characterSet DhallFile {..} = do let relativeResourcesPath = resolveRelativePath $ Path.parent path let strippedHeader = Maybe.maybe "" unDhallDocsText (headerComment fileComments) headerAsHtml <- @@ -311,7 +311,7 @@ expr examples headerAsHtml - DocParams { relativeResourcesPath, packageName, characterSet } + DocParams { relativeResourcesPath, packageName, characterSet, baseImportUrl } return htmlAsText @@ -333,8 +333,13 @@ @a/b/c@ and no @index.html@ should be generated inside of `a/` or `a/b/`, but yes on `a/b/c/` in the last one there is the @b.dhall@ file -} -createIndexes :: Text -> CharacterSet -> [DhallFile] -> [(Path Rel File, Text)] -createIndexes packageName characterSet dhallFiles = map toIndex dirToDirsAndFilesMapAssocs +createIndexes + :: Maybe Text + -> Text + -> CharacterSet + -> [DhallFile] + -> [(Path Rel File, Text)] +createIndexes baseImportUrl packageName characterSet dhallFiles = map toIndex dirToDirsAndFilesMapAssocs where -- Files grouped by their directory dirToFilesMap :: Map (Path Rel Dir) [DhallFile] @@ -377,7 +382,7 @@ indexDir (map (\DhallFile{..} -> (stripPrefix $ addHtmlExt path, mType)) files) (map stripPrefix dirs) - DocParams { relativeResourcesPath = resolveRelativePath indexDir, packageName, characterSet } + DocParams { relativeResourcesPath = resolveRelativePath indexDir, packageName, characterSet, baseImportUrl } stripPrefix :: Path Rel a -> Path Rel a stripPrefix relpath = @@ -416,14 +421,15 @@ generateDocs :: Path Abs Dir -- ^ Input directory -> Path Abs Dir -- ^ Link to be created to the generated documentation + -> Maybe Text -- ^ Base import URL -> Text -- ^ Package name, used in some HTML titles -> CharacterSet -- ^ Output encoding -> IO () -generateDocs inputDir outLink packageName characterSet = do +generateDocs inputDir outLink baseImportUrl packageName characterSet = do (_, absFiles) <- Path.IO.listDirRecur inputDir contents <- mapM (Data.ByteString.readFile . Path.fromAbsFile) absFiles strippedFiles <- mapM (Path.stripProperPrefix inputDir) absFiles - let GeneratedDocs warnings docs = generateDocsPure packageName characterSet $ zip strippedFiles contents + let GeneratedDocs warnings docs = generateDocsPure baseImportUrl packageName characterSet $ zip strippedFiles contents mapM_ print warnings if null docs then putStrLn $ @@ -461,15 +467,16 @@ If you want the `IO` version of this function, check `generateDocs` -} generateDocsPure - :: Text -- ^ Package name + :: Maybe Text -- ^ Base import URL + -> Text -- ^ Package name -> CharacterSet -- ^ Output encoding -> [(Path Rel File, ByteString)] -- ^ (Input file, contents) -> GeneratedDocs [(Path Rel File, Text)] -generateDocsPure packageName characterSet inputFiles = go +generateDocsPure baseImportUrl packageName characterSet inputFiles = go where go :: GeneratedDocs [(Path Rel File, Text)] go = do dhallFiles <- getAllDhallFiles inputFiles - htmls <- mapM (makeHtml packageName characterSet) dhallFiles - let indexes = createIndexes packageName characterSet dhallFiles + htmls <- mapM (makeHtml baseImportUrl packageName characterSet) dhallFiles + let indexes = createIndexes baseImportUrl packageName characterSet dhallFiles return (zip (map (addHtmlExt . path) dhallFiles) htmls <> indexes) diff --git a/src/Dhall/Docs/Html.hs b/src/Dhall/Docs/Html.hs --- a/src/Dhall/Docs/Html.hs +++ b/src/Dhall/Docs/Html.hs @@ -17,6 +17,7 @@ , DocParams(..) ) where +import Data.Foldable (fold) import Data.Text (Text) import Data.Void (Void) import Dhall.Core (Expr, Import) @@ -42,6 +43,7 @@ -- front-end files , packageName :: Text -- ^ Name of the package , characterSet :: CharacterSet -- ^ Render code as `ASCII` or `Unicode` + , baseImportUrl :: Maybe Text -- ^ Base import URL } -- | Generates an @`Html` ()@ with all the information about a dhall file @@ -60,7 +62,7 @@ navBar params mainContainer $ do setPageTitle params NotIndex breadcrumb - copyToClipboardButton htmlTitle + copyToClipboardButton clipboardText br_ [] div_ [class_ "doc-contents"] header Control.Monad.unless (null examples) $ do @@ -72,6 +74,7 @@ where breadcrumb = relPathToBreadcrumb filePath htmlTitle = breadCrumbsToText breadcrumb + clipboardText = fold baseImportUrl <> htmlTitle -- | Generates an index @`Html` ()@ that list all the dhall files in that folder indexToHtml @@ -86,7 +89,7 @@ navBar params mainContainer $ do setPageTitle params Index breadcrumbs - copyToClipboardButton htmlTitle + copyToClipboardButton clipboardText br_ [] Control.Monad.unless (null files) $ do h3_ "Exported files: " @@ -99,8 +102,8 @@ where listFile :: (Path Rel File, Maybe (Expr Void Import)) -> Html () listFile (file, maybeType) = - let fileRef = Data.Text.pack $ Path.fromRelFile file - itemText = Data.Text.pack $ tryToTakeExt file + let fileRef = toUnixPath $ Path.fromRelFile file + itemText = toUnixPath $ tryToTakeExt file in li_ $ do a_ [href_ fileRef] $ toHtml itemText Data.Foldable.forM_ maybeType $ \typeExpr -> do @@ -110,7 +113,7 @@ listDir :: Path Rel Dir -> Html () listDir dir = - let dirPath = Data.Text.pack $ Path.fromRelDir dir in + let dirPath = toUnixPath $ Path.fromRelDir dir in li_ $ a_ [href_ (dirPath <> "index.html")] $ toHtml dirPath tryToTakeExt :: Path Rel File -> FilePath @@ -121,6 +124,7 @@ breadcrumbs = relPathToBreadcrumb indexDir htmlTitle = breadCrumbsToText breadcrumbs + clipboardText = fold baseImportUrl <> htmlTitle copyToClipboardButton :: Text -> Html () copyToClipboardButton filePath = @@ -244,3 +248,6 @@ [ type_ "text/javascript" , src_ $ Data.Text.pack $ relativeResourcesPath <> "index.js"] ("" :: Text) + +toUnixPath :: String -> Text +toUnixPath = Data.Text.replace "\\" "/" . Data.Text.pack diff --git a/tasty/Main.hs b/tasty/Main.hs --- a/tasty/Main.hs +++ b/tasty/Main.hs @@ -35,7 +35,8 @@ GHC.IO.Encoding.setLocaleEncoding GHC.IO.Encoding.utf8 input <- getPackageContents - let GeneratedDocs _ docs = generateDocsPure "test-package" Unicode input + let GeneratedDocs _ docs = + generateDocsPure Nothing "test-package" Unicode input let docsMap = Map.fromList docs commentTests <- getCommentTests let testTree = Test.Tasty.testGroup "dhall-docs"