diff --git a/CHANGELOG.md b/CHANGELOG.md index 073617f..019c517 100644 --- a/CHANGELOG.md +++ b/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 diff --git a/haskellorls.cabal b/haskellorls.cabal index f8afbc2..7fe2d99 100644 --- a/haskellorls.cabal +++ b/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 diff --git a/src/Haskellorls.hs b/src/Haskellorls.hs index 03b26bf..45314bd 100644 --- a/src/Haskellorls.hs +++ b/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 diff --git a/src/Haskellorls/Hyperlink/Option.hs b/src/Haskellorls/Hyperlink/Option.hs new file mode 100644 index 0000000..8846697 --- /dev/null +++ b/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" diff --git a/src/Haskellorls/Hyperlink/Type.hs b/src/Haskellorls/Hyperlink/Type.hs new file mode 100644 index 0000000..a14091a --- /dev/null +++ b/src/Haskellorls/Hyperlink/Type.hs @@ -0,0 +1,3 @@ +module Haskellorls.Hyperlink.Type (WHEN (..)) where + +data WHEN = NEVER | ALWAYS | AUTO diff --git a/src/Haskellorls/Name/Decorator.hs b/src/Haskellorls/Name/Decorator.hs index 659fa53..38b2711 100644 --- a/src/Haskellorls/Name/Decorator.hs +++ b/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 diff --git a/src/Haskellorls/Option.hs b/src/Haskellorls/Option.hs index 94107d0..fe07276 100644 --- a/src/Haskellorls/Option.hs +++ b/src/Haskellorls/Option.hs @@ -8,6 +8,7 @@ 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 @@ -15,6 +16,7 @@ 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 $ diff --git a/src/Haskellorls/SymbolicLink.hs b/src/Haskellorls/SymbolicLink.hs index 35912ec..16a2338 100644 --- a/src/Haskellorls/SymbolicLink.hs +++ b/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] diff --git a/src/Haskellorls/WrappedText.hs b/src/Haskellorls/WrappedText.hs index 3737793..260d28c 100644 --- a/src/Haskellorls/WrappedText.hs +++ b/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