Add the --hyperlink=WHEN option

Fix #4.

CHANGELOG.md

@@ -2,6 +2,12 @@
 
 ## Unreleased
 
+## 0.5.1.0 -- 2022-07-12
+
+### Added
+
+- Support `--hyperlink=WHEN` option.
+
 ## 0.5.0.2 -- 2022-06-19
 
 ### Fixed

haskellorls.cabal

@@ -1,6 +1,6 @@
 cabal-version:      2.2
 name:               haskellorls
-version:            0.5.0.2
+version:            0.5.1.0
 synopsis:           Haskell implementation of ls
 license:            BSD-3-Clause
 license-file:       LICENSE
@@ -60,6 +60,8 @@ library
     Haskellorls.Format.Option
     Haskellorls.Format.Type
     Haskellorls.Format.Util
+    Haskellorls.Hyperlink.Option
+    Haskellorls.Hyperlink.Type
     Haskellorls.Icon
     Haskellorls.Indicator.Decorator
     Haskellorls.Indicator.Option
@@ -112,6 +114,7 @@ library
     LambdaCase
     MultiParamTypeClasses
     MultiWayIf
+    NamedFieldPuns
     OverloadedStrings
     RecordWildCards
     StrictData
@@ -126,6 +129,7 @@ library
     , extra                 ^>=1.7.10
     , filepath-bytestring   ^>=1.4.2.1.10
     , Glob                  ^>=0.10.2
+    , hostname              ^>=1.0
     , mtl                   ^>=2.2.2
     , natural-sort          ^>=0.1.2
     , optparse-applicative  ^>=0.17.0

src/Haskellorls.hs

@@ -6,6 +6,7 @@ where
 
 import Control.Monad
 import Data.Either
+import qualified Data.Text as T
 import Data.Version (showVersion)
 import qualified Haskellorls.Decorator as Decorator
 import Haskellorls.Exception
@@ -14,11 +15,13 @@ import qualified Haskellorls.Quote.Utils as Quote
 import qualified Haskellorls.Recursive as Recursive
 import qualified Haskellorls.Size.Utils as Size
 import qualified Haskellorls.Utils as Utils
+import Network.HostName
 import Options.Applicative
 import Paths_haskellorls (version)
 import System.Exit
 import System.FilePath.Posix.ByteString
 import System.IO
+import System.Posix.Directory.ByteString
 
 -- | Haskellorls's process flow
 -- 1. Gets all arguments passed to itself as string list.
@@ -38,8 +41,17 @@ haskellorls args = do
       isConnectedToTerminal <- hIsTerminalDevice stdout
       blockSize <- Size.lookupBlockSize options
       quotingStyle <- Quote.lookupQuotingStyle options
+      cwd <- getWorkingDirectory
+      hostname <- T.pack <$> getHostName
 
-      run options {Option.blockSize = blockSize, Option.quotingStyle = quotingStyle, Option.toStdout = isConnectedToTerminal}
+      run
+        options
+          { Option.blockSize = blockSize,
+            Option.quotingStyle = quotingStyle,
+            Option.toStdout = isConnectedToTerminal,
+            Option.currentWorkingDirectory = cwd,
+            Option.hostname = hostname
+          }
 
 run :: Option.Option -> IO ()
 run opt = do

src/Haskellorls/Hyperlink/Option.hs

@@ -0,0 +1,30 @@
+module Haskellorls.Hyperlink.Option
+  ( hyperlinkParser,
+    module Haskellorls.Hyperlink.Type,
+  )
+where
+
+import Haskellorls.Hyperlink.Type
+import Options.Applicative
+
+hyperlinkParser :: Parser WHEN
+hyperlinkParser =
+  option reader $
+    long "hyperlink"
+      <> metavar "WHEN"
+      <> value NEVER
+      <> help "When embed the hyperlink to the file into the filename."
+      <> completeWith ["never", "always", "auto"]
+  where
+    reader =
+      str @String >>= \case
+        "never" -> return NEVER
+        "no" -> return NEVER
+        "none" -> return NEVER
+        "always" -> return ALWAYS
+        "yes" -> return ALWAYS
+        "force" -> return ALWAYS
+        "auto" -> return AUTO
+        "tty" -> return AUTO
+        "if-tty" -> return AUTO
+        _ -> readerError "Only never, always or auto"

src/Haskellorls/Hyperlink/Type.hs

@@ -0,0 +1,3 @@
+module Haskellorls.Hyperlink.Type (WHEN (..)) where
+
+data WHEN = NEVER | ALWAYS | AUTO

src/Haskellorls/Name/Decorator.hs

@@ -9,31 +9,54 @@ where
 import Data.Maybe
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
+import Haskellorls.Class
+import qualified Haskellorls.Hyperlink.Type as Hyperlink
 import qualified Haskellorls.LsColor as Color
 import qualified Haskellorls.NodeInfo as Node
 import qualified Haskellorls.Option as Option
 import qualified Haskellorls.Quote.Utils as Quote
 import qualified Haskellorls.Utils as Utils
 import qualified Haskellorls.WrappedText as WT
+import System.FilePath.Posix.ByteString
 
 colorizedNodeNameWrapper :: Option.Option -> Color.LsColors -> Node.NodeInfo -> [WT.WrappedText]
 colorizedNodeNameWrapper opt config nd = Quote.quote (Quote.quoteStyle opt) $ colorizedNodeName opt config nd
 
 colorizedNodeName :: Option.Option -> Color.LsColors -> Node.NodeInfo -> WT.WrappedText
-colorizedNodeName opt c@(Color.Options {..}) nd = WT.WrappedText (left' <> l <> right') name' (left' <> r <> right')
+colorizedNodeName opt c@(Color.Options {..}) nd = WT.WrappedText (left' <> l <> right' <> wtPrefix) wtWord (wtSuffix <> left' <> r <> right')
   where
-    name = nodeName nd
-    name' = Utils.escapeFormatter opt name
+    WT.WrappedText {..} = WT.modify (Utils.escapeFormatter opt) $ nodeName opt nd
     left' = Color.unSequence $ fromMaybe "" left
     right' = Color.unSequence $ fromMaybe "" right
     l = maybe "" Color.unSequence $ nd `Color.lookup` c
     r = Color.unSequence $ fromMaybe "" reset
 
 nodeNameWrapper :: Option.Option -> Node.NodeInfo -> [WT.WrappedText]
-nodeNameWrapper opt node = Quote.quote style . WT.deserialize $ Utils.escapeFormatter opt name
+nodeNameWrapper opt node = Quote.quote style $ WT.modify (Utils.escapeFormatter opt) . nodeName opt $ node
   where
-    name = nodeName node
     style = Quote.quoteStyle opt
 
-nodeName :: Node.NodeInfo -> T.Text
-nodeName = T.decodeUtf8 . Node.getNodePath
+nodeName :: Option.Option -> Node.NodeInfo -> WT.WrappedText
+nodeName opt@(Option.Option {hyperlink, hostname, toStdout}) node =
+  case hyperlink of
+    Hyperlink.NEVER -> deserialize $ rawNodeName node
+    Hyperlink.ALWAYS -> WT.WrappedText (left <> uri <> right) (rawNodeName node) (left <> right)
+      where
+        left = "\^[]8;;"
+        right = "\^G"
+        uri = "file://" <> hostname <> T.decodeUtf8 (mkAbsolutePath opt node)
+    Hyperlink.AUTO
+      | toStdout -> nodeName opt {Option.hyperlink = Hyperlink.ALWAYS} node
+      | otherwise -> nodeName opt {Option.hyperlink = Hyperlink.NEVER} node
+
+rawNodeName :: Node.NodeInfo -> T.Text
+rawNodeName = T.decodeUtf8 . Node.getNodePath
+
+-- | Make the absolute path from a node.
+mkAbsolutePath :: Option.Option -> Node.NodeInfo -> RawFilePath
+mkAbsolutePath Option.Option {currentWorkingDirectory} Node.NodeInfo {..} =
+  normalise $
+    if
+        | isAbsolute getNodePath -> getNodePath
+        | isAbsolute getNodeDirName -> getNodeDirName </> getNodePath
+        | otherwise -> currentWorkingDirectory </> getNodeDirName </> getNodePath

src/Haskellorls/Option.hs

@@ -8,13 +8,15 @@ import qualified Data.Text as T
 import qualified Haskellorls.Color.Option as Color
 import qualified Haskellorls.Depth as Depth
 import qualified Haskellorls.Format.Option as Format
+import qualified Haskellorls.Hyperlink.Option as Hyperlink
 import qualified Haskellorls.Indicator.Option as Indicator
 import qualified Haskellorls.Quote.Option as Quote
 import qualified Haskellorls.Size.Option as Size
 import qualified Haskellorls.Sort.Option as Sort
 import qualified Haskellorls.Time.Option as Time
 import qualified Options.Applicative as OA
 import qualified Options.Applicative.Help.Pretty as OA
+import System.FilePath.Posix.ByteString
 import Text.Read
 
 data Option = Option
@@ -42,6 +44,7 @@ data Option = Option
     dereferenceCommandLine :: Bool,
     dereferenceCommandLineSymlinkToDir :: Bool,
     hide :: String,
+    hyperlink :: Hyperlink.WHEN,
     icon :: Bool,
     indicatorStyle :: Indicator.IndicatorStyle,
     inode :: Bool,
@@ -80,6 +83,8 @@ data Option = Option
     oneline :: Bool,
     toStdout :: Bool,
     noQuote :: Bool,
+    currentWorkingDirectory :: RawFilePath,
+    hostname :: T.Text,
     version :: Bool,
     targets :: [FilePath]
   }
@@ -114,6 +119,7 @@ optionParser =
     <*> dereferenceCommandLineParser
     <*> dereferenceCommandLineSymlinkToDirParser
     <*> hideParser
+    <*> Hyperlink.hyperlinkParser
     <*> iconParser
     <*> Indicator.indicatorStyleParser
     <*> inodeParser
@@ -152,6 +158,8 @@ optionParser =
     <*> onelineParser
     <*> toStdoutParser
     <*> noQuoteParser
+    <*> currentWorkingDirectoryParser
+    <*> hostnameParser
     <*> versionParser
     <*> argParser
 
@@ -481,6 +489,12 @@ escapeParser =
       <> OA.short 'b'
       <> OA.help "Escape file name and link name by C lang style"
 
+currentWorkingDirectoryParser :: OA.Parser RawFilePath
+currentWorkingDirectoryParser = OA.strOption $ OA.value "" <> OA.internal
+
+hostnameParser :: OA.Parser T.Text
+hostnameParser = OA.strOption $ OA.value "" <> OA.internal
+
 versionParser :: OA.Parser Bool
 versionParser =
   OA.switch $

src/Haskellorls/SymbolicLink.hs

@@ -16,10 +16,10 @@ import qualified Haskellorls.WrappedText as WT
 linkName :: Option.Option -> Node.NodeInfo -> [WT.WrappedText]
 linkName opt node = case Node.getNodeLinkInfo node of
   Nothing -> []
-  _ -> prefix' : Quote.quote style (WT.deserialize $ Utils.escapeFormatter opt link)
+  _ -> prefix' : Quote.quote style (WT.modify (Utils.escapeFormatter opt) link)
   where
     style = Quote.quoteStyleForLink opt
-    link = Name.nodeName $ Node.toFileInfo node
+    link = Name.nodeName opt $ Node.toFileInfo node
     prefix' = WT.deserialize prefix
 
 coloredLinkName :: Option.Option -> Color.LsColors -> Node.NodeInfo -> [WT.WrappedText]

src/Haskellorls/WrappedText.hs

@@ -1,5 +1,6 @@
 module Haskellorls.WrappedText
   ( WrappedText (..),
+    modify,
     module Haskellorls.Class,
   )
 where
@@ -26,3 +27,7 @@ instance Deserialize WrappedText
 
 instance Length WrappedText where
   len = Utils.textLengthForDisplay . wtWord
+
+-- | Modify only 'wtWord' in 'WrappedText'.
+modify :: (T.Text -> T.Text) -> WrappedText -> WrappedText
+modify f WrappedText {..} = WrappedText wtPrefix (f wtWord) wtSuffix