twoparam actions, formatting and nix
This commit is contained in:
parent
372e485073
commit
bb9007c9e3
13 changed files with 566 additions and 283 deletions
1
.gitignore
vendored
1
.gitignore
vendored
|
|
@ -2,3 +2,4 @@ dist-newstyle/*
|
|||
/.DS_Store
|
||||
/src/.DS_Store
|
||||
/result
|
||||
/.direnv/
|
||||
|
|
|
|||
1
Setup.hs
1
Setup.hs
|
|
@ -1,2 +1,3 @@
|
|||
import Distribution.Simple
|
||||
|
||||
main = defaultMain
|
||||
|
|
|
|||
|
|
@ -1,2 +0,0 @@
|
|||
packages: *.cabal
|
||||
-- jobs: $ncpus
|
||||
|
|
@ -1,65 +1,75 @@
|
|||
cabal-version: 3.6
|
||||
cabal-version: 3.6
|
||||
|
||||
-- Initial package description 'fast-bronze.cabal' generated by 'cabal
|
||||
-- init'. For further documentation, see
|
||||
-- http://haskell.org/cabal/users-guide/
|
||||
|
||||
name: fast-bronze
|
||||
version: 0.1.0.0
|
||||
synopsis: A reimplementation of quicksilver
|
||||
name: fast-bronze
|
||||
version: 0.1.0.0
|
||||
synopsis: A reimplementation of quicksilver
|
||||
|
||||
-- description:
|
||||
-- bug-reports:
|
||||
license: MIT
|
||||
license-file: LICENSE
|
||||
author: Jack Wines
|
||||
maintainer: jackwines@mac.com
|
||||
license: MIT
|
||||
license-file: LICENSE
|
||||
author: Jack Wines
|
||||
maintainer: jackwines@mac.com
|
||||
|
||||
-- copyright:
|
||||
-- category:
|
||||
build-type: Simple
|
||||
extra-source-files: CHANGELOG.md
|
||||
build-type: Simple
|
||||
extra-source-files: CHANGELOG.md
|
||||
|
||||
source-repository head
|
||||
type: git
|
||||
location: https://git.sr.ht/~jackwines/fast-bronze
|
||||
type: git
|
||||
location: https://gitlab.com/winesj/fast-bronze
|
||||
|
||||
executable fast-bronze
|
||||
main-is: Main.hs
|
||||
default-extensions: ScopedTypeVariables,
|
||||
OverloadedStrings,
|
||||
TemplateHaskell,
|
||||
DataKinds,
|
||||
FlexibleContexts,
|
||||
FlexibleInstances,
|
||||
MultiParamTypeClasses,
|
||||
OverloadedLabels,
|
||||
TypeFamilies,
|
||||
TupleSections,
|
||||
UndecidableInstances,
|
||||
RecursiveDo,
|
||||
RecordWildCards,
|
||||
RankNTypes,
|
||||
DuplicateRecordFields
|
||||
other-modules: Catalog,
|
||||
ListZipper,
|
||||
main-is: Main.hs
|
||||
default-extensions:
|
||||
DataKinds
|
||||
DuplicateRecordFields
|
||||
FlexibleContexts
|
||||
FlexibleInstances
|
||||
InstanceSigs
|
||||
MultiParamTypeClasses
|
||||
OverloadedLabels
|
||||
OverloadedStrings
|
||||
RankNTypes
|
||||
RecordWildCards
|
||||
RecursiveDo
|
||||
ScopedTypeVariables
|
||||
TemplateHaskell
|
||||
TupleSections
|
||||
TypeFamilies
|
||||
UndecidableInstances
|
||||
|
||||
other-modules:
|
||||
Catalog
|
||||
Config
|
||||
Desktop
|
||||
ListZipper
|
||||
System.FD
|
||||
|
||||
-- other-extensions:
|
||||
build-depends:
|
||||
async,
|
||||
-- xdg-desktop-entry,
|
||||
base,
|
||||
bytestring,
|
||||
data-default,
|
||||
text,
|
||||
directory,
|
||||
unix,
|
||||
shelly,
|
||||
vector,
|
||||
pipes,
|
||||
pipes-extras,
|
||||
brick,
|
||||
vty
|
||||
, async
|
||||
, base
|
||||
, brick
|
||||
, bytestring
|
||||
, containers
|
||||
, data-default
|
||||
, directory
|
||||
, path
|
||||
, shelly
|
||||
, text
|
||||
, unix
|
||||
, vector
|
||||
, vty
|
||||
, xdg-desktop-entry
|
||||
|
||||
|
||||
|
||||
default-language: Haskell2010
|
||||
hs-source-dirs: src
|
||||
ghc-options: -threaded
|
||||
-- pipes,
|
||||
-- pipes-extras,
|
||||
default-language: GHC2021
|
||||
hs-source-dirs: src
|
||||
ghc-options: -threaded
|
||||
|
|
|
|||
83
flake.lock
generated
83
flake.lock
generated
|
|
@ -1,42 +1,73 @@
|
|||
{
|
||||
"nodes": {
|
||||
"flake-utils": {
|
||||
"flake-parts": {
|
||||
"inputs": {
|
||||
"systems": "systems"
|
||||
"nixpkgs-lib": "nixpkgs-lib"
|
||||
},
|
||||
"locked": {
|
||||
"lastModified": 1689068808,
|
||||
"narHash": "sha256-6ixXo3wt24N/melDWjq70UuHQLxGV8jZvooRanIHXw0=",
|
||||
"owner": "numtide",
|
||||
"repo": "flake-utils",
|
||||
"rev": "919d646de7be200f3bf08cb76ae1f09402b6f9b4",
|
||||
"lastModified": 1717285511,
|
||||
"narHash": "sha256-iKzJcpdXih14qYVcZ9QC9XuZYnPc6T8YImb6dX166kw=",
|
||||
"owner": "hercules-ci",
|
||||
"repo": "flake-parts",
|
||||
"rev": "2a55567fcf15b1b1c7ed712a2c6fadaec7412ea8",
|
||||
"type": "github"
|
||||
},
|
||||
"original": {
|
||||
"owner": "numtide",
|
||||
"repo": "flake-utils",
|
||||
"owner": "hercules-ci",
|
||||
"repo": "flake-parts",
|
||||
"type": "github"
|
||||
}
|
||||
},
|
||||
"haskell-flake": {
|
||||
"locked": {
|
||||
"lastModified": 1718653460,
|
||||
"narHash": "sha256-8ana22BZaLp91gGvQq8YbfteJKFqza4qrqc6++bCnH4=",
|
||||
"owner": "srid",
|
||||
"repo": "haskell-flake",
|
||||
"rev": "569e28636c1aaee767a43741511fb36a6d3c284b",
|
||||
"type": "github"
|
||||
},
|
||||
"original": {
|
||||
"owner": "srid",
|
||||
"repo": "haskell-flake",
|
||||
"type": "github"
|
||||
}
|
||||
},
|
||||
"nixpkgs": {
|
||||
"locked": {
|
||||
"lastModified": 1690962823,
|
||||
"narHash": "sha256-2uXndQOSjn9pLq9wl0Db5qZNxa26Mk2CZJpllA8nrn4=",
|
||||
"owner": "NixOS",
|
||||
"lastModified": 1718543737,
|
||||
"narHash": "sha256-e8S/ODM1vkKHIexSVn9nIvne7vRO5M+35VAq/6JOYto=",
|
||||
"owner": "nixos",
|
||||
"repo": "nixpkgs",
|
||||
"rev": "278602108d78cfe43f3129990ef7bdd7cfe7601e",
|
||||
"rev": "683aa7c4e385509ca651d49eeb35e58c7a1baad6",
|
||||
"type": "github"
|
||||
},
|
||||
"original": {
|
||||
"owner": "NixOS",
|
||||
"owner": "nixos",
|
||||
"ref": "nixpkgs-unstable",
|
||||
"repo": "nixpkgs",
|
||||
"type": "github"
|
||||
}
|
||||
},
|
||||
"nixpkgs-lib": {
|
||||
"locked": {
|
||||
"lastModified": 1717284937,
|
||||
"narHash": "sha256-lIbdfCsf8LMFloheeE6N31+BMIeixqyQWbSr2vk79EQ=",
|
||||
"type": "tarball",
|
||||
"url": "https://github.com/NixOS/nixpkgs/archive/eb9ceca17df2ea50a250b6b27f7bf6ab0186f198.tar.gz"
|
||||
},
|
||||
"original": {
|
||||
"type": "tarball",
|
||||
"url": "https://github.com/NixOS/nixpkgs/archive/eb9ceca17df2ea50a250b6b27f7bf6ab0186f198.tar.gz"
|
||||
}
|
||||
},
|
||||
"root": {
|
||||
"inputs": {
|
||||
"flake-utils": "flake-utils",
|
||||
"nixpkgs": "nixpkgs"
|
||||
"flake-parts": "flake-parts",
|
||||
"haskell-flake": "haskell-flake",
|
||||
"nixpkgs": "nixpkgs",
|
||||
"systems": "systems",
|
||||
"treefmt-nix": "treefmt-nix"
|
||||
}
|
||||
},
|
||||
"systems": {
|
||||
|
|
@ -53,6 +84,26 @@
|
|||
"repo": "default",
|
||||
"type": "github"
|
||||
}
|
||||
},
|
||||
"treefmt-nix": {
|
||||
"inputs": {
|
||||
"nixpkgs": [
|
||||
"nixpkgs"
|
||||
]
|
||||
},
|
||||
"locked": {
|
||||
"lastModified": 1718522839,
|
||||
"narHash": "sha256-ULzoKzEaBOiLRtjeY3YoGFJMwWSKRYOic6VNw2UyTls=",
|
||||
"owner": "numtide",
|
||||
"repo": "treefmt-nix",
|
||||
"rev": "68eb1dc333ce82d0ab0c0357363ea17c31ea1f81",
|
||||
"type": "github"
|
||||
},
|
||||
"original": {
|
||||
"owner": "numtide",
|
||||
"repo": "treefmt-nix",
|
||||
"type": "github"
|
||||
}
|
||||
}
|
||||
},
|
||||
"root": "root",
|
||||
|
|
|
|||
113
flake.nix
113
flake.nix
|
|
@ -1,43 +1,90 @@
|
|||
# SPDX-FileCopyrightText: 2021 Serokell <https://serokell.io/>
|
||||
#
|
||||
# SPDX-License-Identifier: CC0-1.0
|
||||
|
||||
{
|
||||
description = "My haskell application";
|
||||
|
||||
description = "srid/haskell-template: Nix template for Haskell projects";
|
||||
inputs = {
|
||||
nixpkgs.url = "github:NixOS/nixpkgs";
|
||||
flake-utils.url = "github:numtide/flake-utils";
|
||||
nixpkgs.url = "github:nixos/nixpkgs/nixpkgs-unstable";
|
||||
systems.url = "github:nix-systems/default";
|
||||
flake-parts.url = "github:hercules-ci/flake-parts";
|
||||
haskell-flake.url = "github:srid/haskell-flake";
|
||||
treefmt-nix.url = "github:numtide/treefmt-nix";
|
||||
treefmt-nix.inputs.nixpkgs.follows = "nixpkgs";
|
||||
};
|
||||
|
||||
outputs = { self, nixpkgs, flake-utils }:
|
||||
flake-utils.lib.eachDefaultSystem (system:
|
||||
let
|
||||
pkgs = nixpkgs.legacyPackages.${system};
|
||||
outputs = inputs:
|
||||
inputs.flake-parts.lib.mkFlake { inherit inputs; } {
|
||||
systems = import inputs.systems;
|
||||
imports = [
|
||||
inputs.haskell-flake.flakeModule
|
||||
inputs.treefmt-nix.flakeModule
|
||||
];
|
||||
perSystem = { self', system, lib, config, pkgs, ... }: {
|
||||
# Our only Haskell project. You can have multiple projects, but this template
|
||||
# has only one.
|
||||
# See https://github.com/srid/haskell-flake/blob/master/example/flake.nix
|
||||
haskellProjects.default = {
|
||||
# The base package set (this value is the default)
|
||||
# basePackages = pkgs.haskellPackages;
|
||||
|
||||
haskellPackages = pkgs.haskellPackages;
|
||||
|
||||
jailbreakUnbreak = pkg:
|
||||
pkgs.haskell.lib.doJailbreak (pkg.overrideAttrs (_: { meta = { }; }));
|
||||
|
||||
# DON'T FORGET TO PUT YOUR PACKAGE NAME HERE, REMOVING `throw`
|
||||
packageName = "fast-bronze";
|
||||
in {
|
||||
packages.${packageName} =
|
||||
haskellPackages.callCabal2nix packageName self rec {
|
||||
# Dependency overrides go here
|
||||
# Packages to add on top of `basePackages`
|
||||
packages = {
|
||||
# Add source or Hackage overrides here
|
||||
# (Local packages are added automatically)
|
||||
/*
|
||||
aeson.source = "1.5.0.0" # Hackage version
|
||||
shower.source = inputs.shower; # Flake input
|
||||
*/
|
||||
};
|
||||
|
||||
packages.default = self.packages.${system}.${packageName};
|
||||
defaultPackage = self.packages.${system}.default;
|
||||
# Add your package overrides here
|
||||
settings = {
|
||||
/*
|
||||
haskell-template = {
|
||||
haddock = false;
|
||||
};
|
||||
aeson = {
|
||||
check = false;
|
||||
};
|
||||
*/
|
||||
};
|
||||
|
||||
devShells.default = pkgs.mkShell {
|
||||
buildInputs = with pkgs; [
|
||||
haskellPackages.haskell-language-server # you must build it with your ghc to work
|
||||
cabal-install
|
||||
];
|
||||
inputsFrom = map (__getAttr "env") (__attrValues self.packages.${system});
|
||||
# Development shell configuration
|
||||
devShell = {
|
||||
hlsCheck.enable = false;
|
||||
};
|
||||
|
||||
# What should haskell-flake add to flake outputs?
|
||||
autoWire = [ "packages" "apps" "checks" ]; # Wire all but the devShell
|
||||
};
|
||||
devShell = self.devShells.${system}.default;
|
||||
});
|
||||
|
||||
# Auto formatters. This also adds a flake check to ensure that the
|
||||
# source tree was auto formatted.
|
||||
treefmt.config = {
|
||||
projectRootFile = "flake.nix";
|
||||
|
||||
programs.ormolu.enable = true;
|
||||
programs.nixpkgs-fmt.enable = true;
|
||||
programs.cabal-fmt.enable = true;
|
||||
programs.hlint.enable = true;
|
||||
|
||||
# We use fourmolu
|
||||
programs.ormolu.package = pkgs.haskellPackages.fourmolu;
|
||||
};
|
||||
|
||||
# Default package & app.
|
||||
packages.default = self'.packages.fast-bronze;
|
||||
apps.default = self'.apps.fast-bronze;
|
||||
|
||||
# Default shell.
|
||||
devShells.default = pkgs.mkShell {
|
||||
name = "haskell-template";
|
||||
meta.description = "Haskell development environment";
|
||||
# See https://zero-to-flakes.com/haskell-flake/devshell#composing-devshells
|
||||
inputsFrom = [
|
||||
config.haskellProjects.default.outputs.devShell
|
||||
config.treefmt.build.devShell
|
||||
];
|
||||
nativeBuildInputs = with pkgs; [
|
||||
];
|
||||
};
|
||||
};
|
||||
};
|
||||
}
|
||||
|
|
|
|||
17
fourmolu.yaml
Normal file
17
fourmolu.yaml
Normal file
|
|
@ -0,0 +1,17 @@
|
|||
# Generated from web app, for more information, see: https://fourmolu.github.io/config/
|
||||
indentation: 4
|
||||
column-limit: none
|
||||
function-arrows: trailing
|
||||
comma-style: leading
|
||||
import-export-style: diff-friendly
|
||||
indent-wheres: false
|
||||
record-brace-space: false
|
||||
newlines-between-decls: 1
|
||||
haddock-style: multi-line
|
||||
haddock-style-module: null
|
||||
let-style: auto
|
||||
in-style: right-align
|
||||
single-constraint-parens: always
|
||||
unicode: never
|
||||
respectful: true
|
||||
single-deriving-parens: always
|
||||
177
src/Catalog.hs
177
src/Catalog.hs
|
|
@ -1,50 +1,64 @@
|
|||
module Catalog where
|
||||
import qualified Data.Text as T
|
||||
import qualified System.Directory as D
|
||||
import qualified System.Posix as P
|
||||
import qualified System.Info as In
|
||||
import qualified Shelly as S
|
||||
import qualified Data.List as L
|
||||
import qualified Data.Maybe as My
|
||||
|
||||
import Config qualified as C
|
||||
import Control.Monad.IO.Class qualified as M
|
||||
import Data.Default qualified as D
|
||||
import Data.List qualified as L
|
||||
import Data.Map.Strict qualified as M
|
||||
import Data.Maybe qualified as My
|
||||
import Data.Ord (comparing)
|
||||
import qualified Control.Monad.IO.Class as M
|
||||
import Data.Text qualified as T
|
||||
import Shelly qualified as S
|
||||
import System.Directory qualified as D
|
||||
import System.FD qualified as FD
|
||||
import System.Info qualified as In
|
||||
import System.Posix qualified as P
|
||||
|
||||
data SearchDir = SearchDir {
|
||||
dirDepth ::Int,
|
||||
searchDir :: T.Text
|
||||
} deriving (Show, Eq, Ord)
|
||||
data SearchDir = SearchDir
|
||||
{ dirDepth :: Word
|
||||
, searchDir :: T.Text
|
||||
}
|
||||
deriving (Show, Eq, Ord)
|
||||
|
||||
data Action = Action {
|
||||
actionSearchString :: T.Text,
|
||||
ioAction :: IOAction
|
||||
}
|
||||
data Action = Action
|
||||
{ actionSearchString :: T.Text
|
||||
, ioAction :: IOAction
|
||||
, canRun :: Cataloged -> Bool
|
||||
}
|
||||
|
||||
data IOAction = OneParam (Cataloged -> IO ()) | TwoParam (Cataloged -> Cataloged -> IO ())
|
||||
data IOAction
|
||||
= OneParam (Cataloged -> IO ())
|
||||
| TwoParam
|
||||
{ run :: Cataloged -> Cataloged -> IO ()
|
||||
, catalogStart :: Cataloged -> IO [Cataloged]
|
||||
, modFDParams :: FD.Params -> FD.Params
|
||||
}
|
||||
|
||||
newtype Cataloged = Cataloged {
|
||||
dirPath :: T.Text
|
||||
} deriving (Show, Eq, Ord)
|
||||
newtype Cataloged = Cataloged
|
||||
{ dirPath :: T.Text
|
||||
}
|
||||
deriving (Show, Eq, Ord)
|
||||
|
||||
instance Searchable Action where
|
||||
searchString = actionSearchString
|
||||
searchString = actionSearchString
|
||||
|
||||
instance Searchable Cataloged where
|
||||
searchString = T.toLower . T.reverse . T.takeWhile (/= '/') . T.reverse . removeTrailingSlash . dirPath
|
||||
searchString = T.toLower . T.reverse . T.takeWhile (/= '/') . T.reverse . removeTrailingSlash . dirPath
|
||||
|
||||
instance Show Action where
|
||||
show = T.unpack . searchString
|
||||
show = T.unpack . searchString
|
||||
|
||||
instance Ord Action where
|
||||
compare = comparing actionSearchString
|
||||
compare = comparing actionSearchString
|
||||
|
||||
instance Eq Action where
|
||||
(==) a b = (== EQ) $ compare a b
|
||||
(==) a b = (== EQ) $ compare a b
|
||||
|
||||
instance Searchable T.Text where
|
||||
searchString = id
|
||||
searchString = id
|
||||
|
||||
class Searchable s where
|
||||
searchString :: s -> T.Text
|
||||
searchString :: s -> T.Text
|
||||
|
||||
removeTrailingSlash :: T.Text -> T.Text
|
||||
removeTrailingSlash txt = if T.last txt == '/' then T.init txt else txt
|
||||
|
|
@ -54,56 +68,85 @@ parentDir = My.maybe "/" (T.reverse . T.dropWhile (/= '/') . snd) . T.uncons . T
|
|||
|
||||
getCatalog :: IO [Cataloged]
|
||||
getCatalog = do
|
||||
absHomeDir <- D.getHomeDirectory
|
||||
searchCatalogItem SearchDir {
|
||||
dirDepth = 1,
|
||||
searchDir = T.pack absHomeDir
|
||||
} ""
|
||||
absHomeDir <- D.getHomeDirectory
|
||||
searchCatalogItem
|
||||
SearchDir
|
||||
{ dirDepth = 1
|
||||
, searchDir = T.pack absHomeDir
|
||||
}
|
||||
""
|
||||
|
||||
homeSearchDir = do
|
||||
absHomeDir <- D.getHomeDirectory
|
||||
pure SearchDir {
|
||||
dirDepth = 1,
|
||||
searchDir = T.pack absHomeDir
|
||||
}
|
||||
absHomeDir <- D.getHomeDirectory
|
||||
pure
|
||||
SearchDir
|
||||
{ dirDepth = 1
|
||||
, searchDir = T.pack absHomeDir
|
||||
}
|
||||
|
||||
searchCatalogItem :: SearchDir -> T.Text -> IO [Cataloged]
|
||||
searchCatalogItem (SearchDir {..}) query =
|
||||
fmap (map Cataloged . T.lines)
|
||||
. S.shelly . S.silently
|
||||
. S.run "fd"
|
||||
$ ["-a", "-d", T.pack . show $ dirDepth, fuzzyRegexQuery, searchDir]
|
||||
score :: T.Text -> T.Text -> Word
|
||||
score query candidate = L.sum . M.elems . M.unionWith (-) (toMultiSet candidate) $ toMultiSet query
|
||||
where
|
||||
toMultiSet :: T.Text -> M.Map Char Word
|
||||
toMultiSet = M.fromListWith (+) . map (,1) . T.unpack
|
||||
|
||||
toFDParams :: SearchDir -> T.Text -> FD.Params
|
||||
toFDParams (SearchDir{..}) query = D.def{FD.regexPattern = fuzzyRegexQuery, FD.path = searchDir, FD.depth = Just dirDepth}
|
||||
where
|
||||
fuzzyRegexQuery :: T.Text
|
||||
fuzzyRegexQuery = T.intercalate ".*?" . map T.singleton . T.unpack $ query
|
||||
|
||||
searchInitialCatalog :: C.Config -> IO [Cataloged]
|
||||
searchInitialCatalog = fmap (map Cataloged . concat) . mapM FD.search . C.fdArgs
|
||||
|
||||
searchCatalogByFDParams :: FD.Params -> T.Text -> IO [Cataloged]
|
||||
searchCatalogByFDParams params query =
|
||||
fmap
|
||||
( map Cataloged
|
||||
. L.sortOn (score query)
|
||||
)
|
||||
. FD.search
|
||||
$ params
|
||||
|
||||
searchCatalogItem :: SearchDir -> T.Text -> IO [Cataloged]
|
||||
searchCatalogItem params query = searchCatalogByFDParams (toFDParams params query) query
|
||||
|
||||
getActions :: Cataloged -> [Action]
|
||||
getActions cataloged =
|
||||
[
|
||||
Action {
|
||||
actionSearchString = "move to trash",
|
||||
ioAction = OneParam $ \cataloged -> P.executeFile "mv" True [T.unpack . dirPath $ cataloged, "~/.Trash"] Nothing
|
||||
},
|
||||
Action {
|
||||
actionSearchString = "move to",
|
||||
ioAction = TwoParam (\cataloged cataloged' -> P.executeFile "mv" True (map (T.unpack . dirPath) [cataloged, cataloged']) Nothing)
|
||||
}
|
||||
] ++ case In.os of
|
||||
"darwin" -> darwinActions
|
||||
"linux" -> linuxActions
|
||||
[ Action
|
||||
{ actionSearchString = "move to trash"
|
||||
, ioAction = OneParam $ \cataloged -> P.executeFile "mv" True [T.unpack . dirPath $ cataloged, "~/.Trash"] Nothing
|
||||
, canRun = const True
|
||||
}
|
||||
, Action
|
||||
{ actionSearchString = "move to"
|
||||
, canRun = const True
|
||||
, ioAction =
|
||||
TwoParam
|
||||
{ run = \cataloged cataloged' -> P.executeFile "mv" True (map (T.unpack . dirPath) [cataloged, cataloged']) Nothing
|
||||
, catalogStart = \firstCatalogItem -> searchCatalogItem (SearchDir 1 (parentDir . dirPath $ firstCatalogItem)) ""
|
||||
, modFDParams = \fd -> fd{FD.fileTypes = [FD.Directory]}
|
||||
}
|
||||
}
|
||||
]
|
||||
++ case In.os of
|
||||
"darwin" -> darwinActions
|
||||
"linux" -> linuxActions
|
||||
|
||||
darwinActions :: [Action]
|
||||
darwinActions = [
|
||||
Action {
|
||||
actionSearchString = "open",
|
||||
ioAction = OneParam $ \cataloged -> P.executeFile "open" True [T.unpack . dirPath $ cataloged] Nothing
|
||||
}
|
||||
]
|
||||
darwinActions =
|
||||
[ Action
|
||||
{ actionSearchString = "open"
|
||||
, ioAction = OneParam $ \cataloged -> P.executeFile "open" True [T.unpack . dirPath $ cataloged] Nothing
|
||||
, canRun = const True
|
||||
}
|
||||
]
|
||||
|
||||
linuxActions :: [Action]
|
||||
linuxActions = [
|
||||
Action {
|
||||
actionSearchString = "xfg-open",
|
||||
ioAction = OneParam $ \cataloged -> P.executeFile "xfg-open" True [T.unpack . dirPath $ cataloged] Nothing
|
||||
}
|
||||
]
|
||||
linuxActions =
|
||||
[ Action
|
||||
{ actionSearchString = "xfg-open"
|
||||
, ioAction = OneParam $ \cataloged -> P.executeFile "xfg-open" True [T.unpack . dirPath $ cataloged] Nothing
|
||||
, canRun = const True
|
||||
}
|
||||
]
|
||||
|
|
|
|||
12
src/Config.hs
Normal file
12
src/Config.hs
Normal file
|
|
@ -0,0 +1,12 @@
|
|||
module Config where
|
||||
|
||||
import Data.Default qualified as D
|
||||
import System.FD qualified as FD
|
||||
|
||||
newtype Config = Config
|
||||
{ fdArgs :: [FD.Params]
|
||||
}
|
||||
|
||||
-- jacksTestConfig = Config [
|
||||
-- D.default
|
||||
-- ]
|
||||
13
src/Desktop.hs
Normal file
13
src/Desktop.hs
Normal file
|
|
@ -0,0 +1,13 @@
|
|||
module Desktop where
|
||||
|
||||
import Data.Text qualified as T
|
||||
import System.Directory qualified as D
|
||||
import System.Environment.XDG.DesktopEntry qualified as DE
|
||||
import System.FD qualified as FD
|
||||
import System.Posix.Env qualified as P
|
||||
|
||||
-- getXDGDataDirs :: IO [T.Text]
|
||||
-- getXDGDataDirs = T.splitOn ":" . T.pack <$> P.getEnvDefault "" "XDG_DATA_DIRS"
|
||||
|
||||
-- getDesktopFiles :: T.Text -> IO [T.Text]
|
||||
-- getDesktopFiles dir = fmap (map T.pack) . D.listDirectory . T.unpack . T.append dir $ "/applications"
|
||||
|
|
@ -1,24 +1,26 @@
|
|||
module ListZipper where
|
||||
import qualified Data.Foldable as F
|
||||
import qualified Data.Maybe as My
|
||||
|
||||
data ListZipper a = ListZipper {
|
||||
before :: [a],
|
||||
focus :: a,
|
||||
after :: [a]
|
||||
} deriving (Show, Ord, Eq)
|
||||
import Data.Foldable qualified as F
|
||||
import Data.Maybe qualified as My
|
||||
|
||||
data ListZipper a = ListZipper
|
||||
{ before :: [a]
|
||||
, focus :: a
|
||||
, after :: [a]
|
||||
}
|
||||
deriving (Show, Ord, Eq)
|
||||
|
||||
moveLeft :: ListZipper a -> ListZipper a
|
||||
moveLeft (ListZipper xs x []) = ListZipper xs x []
|
||||
moveLeft (ListZipper xs x xs') = ListZipper (x:xs) (head xs') (tail xs')
|
||||
moveLeft (ListZipper xs x xs') = ListZipper (x : xs) (head xs') (tail xs')
|
||||
|
||||
moveRight :: ListZipper a -> ListZipper a
|
||||
moveRight (ListZipper [] x xs) = ListZipper [] x xs
|
||||
moveRight (ListZipper xs x xs') = ListZipper (tail xs) (head xs) (x:xs')
|
||||
moveRight (ListZipper xs x xs') = ListZipper (tail xs) (head xs) (x : xs')
|
||||
|
||||
fromList :: [a] -> Maybe (ListZipper a)
|
||||
fromList [] = Nothing
|
||||
fromList (x:xs) = Just $ ListZipper [] x xs
|
||||
fromList (x : xs) = Just $ ListZipper [] x xs
|
||||
|
||||
map :: (a -> b) -> ListZipper a -> ListZipper b
|
||||
map f (ListZipper xs x xs') = ListZipper (Prelude.map f xs) (f x) (Prelude.map f xs')
|
||||
|
|
@ -27,7 +29,7 @@ mapFocus :: (a -> a) -> ListZipper a -> ListZipper a
|
|||
mapFocus f (ListZipper xs x xs') = ListZipper xs (f x) xs'
|
||||
|
||||
asList :: ListZipper a -> [a]
|
||||
asList (ListZipper xs x xs') = reverse xs ++ x:xs'
|
||||
asList (ListZipper xs x xs') = reverse xs ++ x : xs'
|
||||
|
||||
asListMaybe :: Maybe (ListZipper a) -> [a]
|
||||
asListMaybe Nothing = []
|
||||
|
|
@ -35,17 +37,17 @@ asListMaybe (Just a) = asList a
|
|||
|
||||
filter :: (a -> Bool) -> ListZipper a -> Maybe (ListZipper a)
|
||||
filter p (ListZipper xs x xs') = case (Prelude.filter p xs, justIf p x, Prelude.filter p xs') of
|
||||
([], Nothing, []) -> Nothing
|
||||
(x:xs, Nothing, xs') -> Just $ ListZipper xs x xs'
|
||||
(xs, Nothing, x:xs') -> Just $ ListZipper xs x xs'
|
||||
(xs, Just x, xs') -> Just $ ListZipper xs x xs'
|
||||
([], Nothing, []) -> Nothing
|
||||
(x : xs, Nothing, xs') -> Just $ ListZipper xs x xs'
|
||||
(xs, Nothing, x : xs') -> Just $ ListZipper xs x xs'
|
||||
(xs, Just x, xs') -> Just $ ListZipper xs x xs'
|
||||
|
||||
justIf :: (a -> Bool) -> a -> Maybe a
|
||||
justIf fn x = if fn x then Just x else Nothing
|
||||
justIf fn x = if fn x then Just x else Nothing
|
||||
|
||||
length (ListZipper {..}) = F.length before + 1 + F.length after
|
||||
length (ListZipper{..}) = F.length before + 1 + F.length after
|
||||
|
||||
focusOn :: Eq a => ListZipper a -> a -> ListZipper a
|
||||
focusOn :: (Eq a) => ListZipper a -> a -> ListZipper a
|
||||
focusOn lz seek = My.fromMaybe lz ((F.find ((== seek) . focus) . takeLzLen . iterate moveRight) =<< farthestLeft)
|
||||
where
|
||||
farthestLeft = F.find (null . before) . takeLzLen . iterate moveLeft $ lz
|
||||
|
|
|
|||
207
src/Main.hs
207
src/Main.hs
|
|
@ -1,41 +1,43 @@
|
|||
module Main where
|
||||
import Control.Monad ( void )
|
||||
import Data.Function ( (&) )
|
||||
import Data.Text ( Text )
|
||||
import Pipes
|
||||
import qualified Pipes.Extras as Pipes
|
||||
|
||||
import Brick qualified as B
|
||||
import Brick.Widgets.Border qualified as BWB
|
||||
import Catalog
|
||||
import Control.Applicative qualified as A
|
||||
import Control.Concurrent.Async (async)
|
||||
import Control.Monad (void)
|
||||
import Control.Monad.IO.Class
|
||||
import Control.Concurrent.Async ( async )
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.IO as TIO
|
||||
import qualified System.Posix.Files as F
|
||||
import System.IO
|
||||
import qualified System.Posix as P
|
||||
import qualified System.Directory as D
|
||||
import qualified Data.Char as C
|
||||
import Data.Maybe
|
||||
import qualified Debug.Trace as T
|
||||
import qualified Data.ByteString as BS
|
||||
import qualified Data.Vector as Vec
|
||||
import qualified Control.Monad.IO.Class as M
|
||||
import qualified Control.Applicative as A
|
||||
import Catalog
|
||||
import qualified ListZipper as LZ
|
||||
import qualified Graphics.Vty.Attributes as B
|
||||
import qualified Brick as B
|
||||
import qualified Data.Maybe as My
|
||||
import qualified Brick.Widgets.Border as BWB
|
||||
import Data.List as L ( singleton )
|
||||
import Control.Monad.IO.Class qualified as M
|
||||
import Data.ByteString qualified as BS
|
||||
import Data.Char qualified as C
|
||||
import Data.Function ((&))
|
||||
import Data.List as L (singleton)
|
||||
import Data.Maybe
|
||||
import Data.Maybe qualified as My
|
||||
import Data.Text (Text)
|
||||
import Data.Text qualified as T
|
||||
import Data.Text.IO qualified as TIO
|
||||
import Data.Vector qualified as Vec
|
||||
import Data.Vector.Storable.Mutable (grow)
|
||||
import qualified Graphics.Vty.Input as Vty
|
||||
import Debug.Trace qualified as T
|
||||
import Graphics.Vty.Attributes qualified as B
|
||||
import Graphics.Vty.Input qualified as Vty
|
||||
import ListZipper qualified as LZ
|
||||
|
||||
-- import Pipes
|
||||
-- import qualified Pipes.Extras as Pipes
|
||||
import System.Directory qualified as D
|
||||
import System.IO
|
||||
import System.Posix qualified as P
|
||||
import System.Posix.Files qualified as F
|
||||
|
||||
data Event = Search Text | Delete | Tab | Enter | Up | Down | Left | Right | ReplaceCatalog [Cataloged]
|
||||
|
||||
data Model = Model {
|
||||
selections :: Selections,
|
||||
searchText :: T.Text
|
||||
} deriving (Show, Ord, Eq)
|
||||
|
||||
data Model = Model
|
||||
{ selections :: Selections
|
||||
, searchText :: T.Text
|
||||
}
|
||||
deriving (Show, Ord, Eq)
|
||||
|
||||
firstCatalog :: Selections -> Maybe (LZ.ListZipper Cataloged)
|
||||
firstCatalog = fmap fst
|
||||
|
|
@ -50,15 +52,15 @@ secondCatalog _ = Nothing
|
|||
|
||||
type Selections = Maybe (LZ.ListZipper Cataloged, Maybe (LZ.ListZipper Action, Maybe (LZ.ListZipper Cataloged)))
|
||||
|
||||
modifySelection :: (forall s. Searchable s => LZ.ListZipper s -> Maybe (LZ.ListZipper s)) -> Model -> Model
|
||||
modifySelection f Model {..} = Model {selections = newSelections, ..}
|
||||
modifySelection :: (forall s. (Searchable s) => LZ.ListZipper s -> Maybe (LZ.ListZipper s)) -> Model -> Model
|
||||
modifySelection f Model{..} = Model{selections = newSelections, ..}
|
||||
where
|
||||
newSelections :: Selections
|
||||
newSelections = case selections of
|
||||
Nothing -> firstOfTuple $ (f . fst =<< selections)
|
||||
(Just (a, Nothing)) -> firstOfTuple . f $ a
|
||||
(Just (a, (Just (b, Nothing)))) -> Just (a, firstOfTuple . f $ b)
|
||||
((Just (a, (Just (b, Just c))))) -> Just (a, (Just (b, f $ c)))
|
||||
Nothing -> firstOfTuple $ (f . fst =<< selections)
|
||||
(Just (a, Nothing)) -> firstOfTuple . f $ a
|
||||
(Just (a, (Just (b, Nothing)))) -> Just (a, firstOfTuple . f $ b)
|
||||
((Just (a, (Just (b, Just c))))) -> Just (a, (Just (b, f $ c)))
|
||||
|
||||
firstOfTuple (Just x) = Just (x, Nothing)
|
||||
firstOfTuple Nothing = Nothing
|
||||
|
|
@ -74,14 +76,16 @@ justPrefer :: Maybe a -> Maybe a -> Maybe a
|
|||
justPrefer (Just a) _ = Just a
|
||||
justPrefer _ a = a
|
||||
|
||||
draw (Model {..}) = L.singleton $ B.vBox [
|
||||
B.txt searchText,
|
||||
BWB.border (B.txt $ maybe "type to enter text" (searchString . LZ.focus) (firstCatalog selections)),
|
||||
BWB.border (B.txt $ maybe "empty actions selection" (searchString . LZ.focus) (actions selections)),
|
||||
maybe B.emptyWidget (BWB.border . B.vBox . toPrettyList . LZ.map B.txt) (currSelection selections) ]
|
||||
draw (Model{..}) =
|
||||
L.singleton $
|
||||
B.vBox
|
||||
[ B.txt searchText
|
||||
, BWB.border (B.txt $ maybe "type to enter text" (dirPath . LZ.focus) (firstCatalog selections))
|
||||
, BWB.border (B.txt $ maybe "empty actions selection" (searchString . LZ.focus) (actions selections))
|
||||
, maybe B.emptyWidget (BWB.border . B.vBox . toPrettyList . LZ.map B.txt) (currSelection selections)
|
||||
]
|
||||
|
||||
|
||||
toPrettyList LZ.ListZipper {..} = (reverse . take beforeTakeLen $ before) ++ (BWB.border focus) : (take afterTakeLen after)
|
||||
toPrettyList LZ.ListZipper{..} = (reverse . take beforeTakeLen $ before) ++ (BWB.border focus) : (take afterTakeLen after)
|
||||
where
|
||||
-- if one side doesn't have 5 items, we want the other to pick up the slack
|
||||
beforeTakeLen = 5 + max 0 (5 - length after)
|
||||
|
|
@ -92,80 +96,87 @@ handleEvent (B.VtyEvent (Vty.EvKey (Vty.KChar 'c') [Vty.MCtrl])) = B.halt
|
|||
handleEvent (B.VtyEvent (Vty.EvKey Vty.KUp [])) = B.modify $ modifySelection (Just . LZ.moveRight)
|
||||
handleEvent (B.VtyEvent (Vty.EvKey Vty.KDown [])) = B.modify $ modifySelection (Just . LZ.moveLeft)
|
||||
handleEvent (B.VtyEvent (Vty.EvKey Vty.KLeft [])) = do
|
||||
Model{..} <- B.get
|
||||
newCatalog' <- liftIO $ mapM (flip searchCatalogItem searchText . SearchDir 1 . parentDir . parentDir . dirPath . LZ.focus . fst) selections
|
||||
B.put Model {selections = fmap (, Nothing) . LZ.fromList =<< newCatalog', searchText = ""}
|
||||
|
||||
Model{..} <- B.get
|
||||
newCatalog' <- liftIO $ mapM (flip searchCatalogItem searchText . SearchDir 1 . parentDir . parentDir . dirPath . LZ.focus . fst) selections
|
||||
B.put Model{selections = fmap (,Nothing) . LZ.fromList =<< newCatalog', searchText = ""}
|
||||
handleEvent (B.VtyEvent (Vty.EvKey Vty.KRight [])) = do
|
||||
Model{..} <- B.get
|
||||
newCatalog' <- liftIO $ mapM (flip searchCatalogItem "" . SearchDir 1 . dirPath . LZ.focus . fst) selections
|
||||
B.put Model{selections = fmap (, Nothing) . LZ.fromList =<< newCatalog', searchText = "", ..}
|
||||
|
||||
Model{..} <- B.get
|
||||
newCatalog' <- liftIO $ mapM (flip searchCatalogItem "" . SearchDir 1 . dirPath . LZ.focus . fst) selections
|
||||
let newSelections = (case LZ.fromList =<< newCatalog' of Nothing -> fmap fst selections; a -> a)
|
||||
B.put Model{selections = fmap (,Nothing) newSelections, searchText = "", ..}
|
||||
handleEvent (B.VtyEvent (Vty.EvKey Vty.KBS [])) = do
|
||||
Model{..} <- B.get
|
||||
let newSearchText = maybe "" fst $ T.unsnoc searchText
|
||||
newModel <- case firstCatalog selections of
|
||||
Just firstCatalog' -> do
|
||||
newCatalog <- M.liftIO . searchCatalogItem (SearchDir 1 . parentDir . dirPath . LZ.focus $ firstCatalog') $ newSearchText
|
||||
pure Model {selections = (, Nothing) <$> (flip LZ.focusOn (LZ.focus firstCatalog') <$> LZ.fromList newCatalog)
|
||||
, searchText = newSearchText}
|
||||
Nothing -> pure . searchFor $ Model { searchText = newSearchText, ..}
|
||||
B.put newModel
|
||||
|
||||
Model{..} <- B.get
|
||||
let newSearchText = maybe "" fst $ T.unsnoc searchText
|
||||
newModel <- case firstCatalog selections of
|
||||
Just firstCatalog' -> do
|
||||
newCatalog <- M.liftIO . searchCatalogItem (SearchDir 1 . parentDir . dirPath . LZ.focus $ firstCatalog') $ newSearchText
|
||||
pure
|
||||
Model
|
||||
{ selections = (,Nothing) <$> (flip LZ.focusOn (LZ.focus firstCatalog') <$> LZ.fromList newCatalog)
|
||||
, searchText = newSearchText
|
||||
}
|
||||
Nothing -> pure . searchFor $ Model{searchText = newSearchText, ..}
|
||||
B.put newModel
|
||||
handleEvent (B.VtyEvent (Vty.EvKey (Vty.KChar '\t') [])) = do
|
||||
model <- B.get
|
||||
B.put $ searchFor $ model { selections = nextSelections (selections model), searchText = "" }
|
||||
model <- B.get
|
||||
newSelections <- liftIO $ nextSelections (selections model)
|
||||
B.put $ searchFor $ model{selections = newSelections, searchText = ""}
|
||||
handleEvent (B.VtyEvent (Vty.EvKey Vty.KEnter [])) = do
|
||||
model <- B.get
|
||||
case selections model of
|
||||
(Just (LZ.ListZipper{focus = catalogFocus}, Just (LZ.ListZipper{focus = actionFocus}, Nothing))) -> case ioAction actionFocus of
|
||||
OneParam action -> liftIO $ action catalogFocus
|
||||
_ -> pure ()
|
||||
_ -> pure ()
|
||||
B.put $ searchFor $ model { selections = nextSelections (selections model), searchText = "" }
|
||||
model <- B.get
|
||||
case selections model of
|
||||
(Just (LZ.ListZipper{focus = catalogFocus}, Just (LZ.ListZipper{focus = (Action{ioAction = OneParam run})}, Nothing))) -> liftIO $ run catalogFocus
|
||||
(Just (LZ.ListZipper{focus = catalogFocus}, Just (LZ.ListZipper{focus = (Action{ioAction = (TwoParam{..})})}, Just (LZ.ListZipper{focus = catalogFocusTwo})))) -> liftIO $ run catalogFocus catalogFocusTwo
|
||||
_ -> pure ()
|
||||
B.put model
|
||||
handleEvent (B.VtyEvent (Vty.EvKey (Vty.KChar inputChar) [])) = do
|
||||
liftIO . TIO.appendFile "./input.txt" . T.singleton $ inputChar
|
||||
model <- B.get
|
||||
B.put $ searchFor $ model { searchText = T.snoc (searchText model) inputChar }
|
||||
|
||||
liftIO . TIO.appendFile "./input.txt" . T.singleton $ inputChar
|
||||
model <- B.get
|
||||
B.put $ searchFor $ model{searchText = T.snoc (searchText model) inputChar}
|
||||
handleEvent e = do
|
||||
B.continueWithoutRedraw
|
||||
B.continueWithoutRedraw
|
||||
|
||||
attrMap _ = B.attrMap B.defAttr []
|
||||
|
||||
nextSelections :: Selections -> Selections
|
||||
nextSelections (Just (catalog, Nothing)) = Just (catalog, (, Nothing) <$> (LZ.fromList . getActions $ LZ.focus catalog))
|
||||
nextSelections a = a
|
||||
nextSelections :: Selections -> IO Selections
|
||||
nextSelections (Just (catalog, Nothing)) = pure . Just $ (catalog, (,Nothing) <$> (LZ.fromList . getActions $ LZ.focus catalog))
|
||||
nextSelections (Just (catalog, Just (actions, Nothing))) =
|
||||
case (LZ.focus actions) of
|
||||
(Action{ioAction = (OneParam _)}) -> pure . Just $ (catalog, Just (actions, Nothing))
|
||||
(Action{ioAction = (TwoParam{..})}) -> do
|
||||
newSecondCatalog <- catalogStart . LZ.focus $ catalog
|
||||
pure . Just $ (catalog, Just (actions, LZ.fromList newSecondCatalog))
|
||||
nextSelections a = pure a
|
||||
|
||||
searchFor :: Model -> Model
|
||||
searchFor model = modifySelection (LZ.filter fuzzyMatchSearchable) model
|
||||
where
|
||||
fuzzyMatchSearchable :: Searchable s => s -> Bool
|
||||
fuzzyMatchSearchable :: (Searchable s) => s -> Bool
|
||||
fuzzyMatchSearchable s = fuzzyMatches (searchText model) (searchString s)
|
||||
|
||||
tuiApp :: B.App Model Event T.Text
|
||||
tuiApp = B.App {
|
||||
appDraw = draw,
|
||||
appChooseCursor = const . const $ Nothing,
|
||||
appHandleEvent = handleEvent,
|
||||
appStartEvent = B.continueWithoutRedraw,
|
||||
appAttrMap = attrMap
|
||||
}
|
||||
tuiApp =
|
||||
B.App
|
||||
{ appDraw = draw
|
||||
, appChooseCursor = const . const $ Nothing
|
||||
, appHandleEvent = handleEvent
|
||||
, appStartEvent = B.continueWithoutRedraw
|
||||
, appAttrMap = attrMap
|
||||
}
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
currDir <- homeSearchDir
|
||||
initialSelections <- searchCatalogItem currDir ""
|
||||
B.defaultMain tuiApp $ Model {
|
||||
searchText = "",
|
||||
selections = (, Nothing) <$> LZ.fromList initialSelections
|
||||
|
||||
}
|
||||
pure ()
|
||||
currDir <- homeSearchDir
|
||||
initialSelections <- searchCatalogItem currDir ""
|
||||
B.defaultMain tuiApp $
|
||||
Model
|
||||
{ searchText = ""
|
||||
, selections = (,Nothing) <$> LZ.fromList initialSelections
|
||||
}
|
||||
pure ()
|
||||
|
||||
fuzzyMatches :: T.Text -> T.Text -> Bool
|
||||
fuzzyMatches "" _ = True
|
||||
fuzzyMatches _ "" = False
|
||||
fuzzyMatches s s'
|
||||
| T.head s == T.head s' = fuzzyMatches (T.tail s) (T.tail s')
|
||||
| otherwise = fuzzyMatches s (T.tail s')
|
||||
| T.head s == T.head s' = fuzzyMatches (T.tail s) (T.tail s')
|
||||
| otherwise = fuzzyMatches s (T.tail s')
|
||||
|
|
|
|||
77
src/System/FD.hs
Normal file
77
src/System/FD.hs
Normal file
|
|
@ -0,0 +1,77 @@
|
|||
{-
|
||||
This could be a completely seperate package really
|
||||
It's a haskell interface to FD
|
||||
-}
|
||||
module System.FD where
|
||||
|
||||
import Data.Default qualified as Data
|
||||
import Data.List qualified as L
|
||||
import Data.Maybe qualified as My
|
||||
import Data.Text qualified as T
|
||||
import Shelly qualified as S
|
||||
|
||||
data Params = Params
|
||||
{ regexPattern :: T.Text
|
||||
, path :: T.Text
|
||||
, depth :: Maybe Word
|
||||
, fileTypes :: [FileType]
|
||||
, extension :: Maybe T.Text
|
||||
, exclude :: Maybe T.Text
|
||||
, threads :: Maybe Word
|
||||
}
|
||||
deriving (Eq, Ord, Show)
|
||||
|
||||
data FileType = File | Directory | SymLink | Socket | Pipe | Executable | Empty deriving (Eq, Ord, Show)
|
||||
|
||||
instance Data.Default Params where
|
||||
def :: Params
|
||||
def =
|
||||
Params
|
||||
{ regexPattern = ""
|
||||
, path = "."
|
||||
, depth = Nothing
|
||||
, fileTypes = []
|
||||
, extension = Nothing
|
||||
, exclude = Nothing
|
||||
, threads = Nothing
|
||||
}
|
||||
|
||||
fileTypeToArg :: FileType -> [T.Text]
|
||||
fileTypeToArg x = ("--type" :) . L.singleton $ case x of
|
||||
File -> "f"
|
||||
Directory -> "d"
|
||||
SymLink -> "l"
|
||||
Socket -> "s"
|
||||
Pipe -> "p"
|
||||
Executable -> "x"
|
||||
Empty -> "e"
|
||||
|
||||
depthToArg :: Maybe Word -> [T.Text]
|
||||
depthToArg Nothing = []
|
||||
depthToArg (Just n) = ["--maxdepth", T.pack . show $ n]
|
||||
|
||||
extensionToArg :: Maybe T.Text -> [T.Text]
|
||||
extensionToArg Nothing = []
|
||||
extensionToArg (Just txt) = ["--extension", T.pack . show $ txt]
|
||||
|
||||
excludeToArg :: Maybe T.Text -> [T.Text]
|
||||
excludeToArg Nothing = []
|
||||
excludeToArg (Just txt) = ["--exclude", T.pack . show $ txt]
|
||||
|
||||
threadsToArg :: Maybe Word -> [T.Text]
|
||||
threadsToArg Nothing = []
|
||||
threadsToArg (Just n) = ["--threads", T.pack . show $ n]
|
||||
|
||||
search :: Params -> IO [T.Text]
|
||||
search (Params{..}) =
|
||||
fmap T.lines
|
||||
. S.shelly
|
||||
. S.handleany_sh (const $ pure "")
|
||||
. S.silently
|
||||
. S.run "fd"
|
||||
$ depthToArg depth
|
||||
++ concatMap fileTypeToArg fileTypes
|
||||
++ extensionToArg extension
|
||||
++ excludeToArg exclude
|
||||
++ threadsToArg threads
|
||||
++ [regexPattern, path]
|
||||
Loading…
Add table
Add a link
Reference in a new issue