From 0f6fc6223cc78e06de6f640ae0e50b4b67a80222 Mon Sep 17 00:00:00 2001 From: voidlizard Date: Sun, 2 Feb 2025 20:29:39 +0300 Subject: [PATCH] HBS2.System.Dir moved to suckless ... and bound --- hbs2-core/lib/HBS2/System/Dir.hs | 116 +---------------- .../Data/Config/Suckless/Script/Internal.hs | 59 +++++++++ .../lib/Data/Config/Suckless/System.hs | 117 ++++++++++++++++++ .../suckless-conf/suckless-conf.cabal | 1 + 4 files changed, 181 insertions(+), 112 deletions(-) create mode 100644 miscellaneous/suckless-conf/lib/Data/Config/Suckless/System.hs diff --git a/hbs2-core/lib/HBS2/System/Dir.hs b/hbs2-core/lib/HBS2/System/Dir.hs index f6179a27..02540e6a 100644 --- a/hbs2-core/lib/HBS2/System/Dir.hs +++ b/hbs2-core/lib/HBS2/System/Dir.hs @@ -1,119 +1,11 @@ -{-# Language MultiWayIf #-} module HBS2.System.Dir - ( module HBS2.System.Dir - , module System.FilePath + ( module System.FilePath , module System.FilePattern - , module UnliftIO + , module Exported ) where -import HBS2.Prelude.Plated - +import Data.Config.Suckless.System as Exported import System.FilePath import System.FilePattern -import System.Directory qualified as D -import Data.ByteString.Lazy qualified as LBS -import UnliftIO -import Control.Exception qualified as E - -import Streaming.Prelude qualified as S - -data MkDirOpt = MkDirOptNone - -class HasMkDirOptions a where - mkdirOpts :: a -> [MkDirOpt] - -instance HasMkDirOptions FilePath where - mkdirOpts = mempty - -class ToFilePath a where - toFilePath :: a -> FilePath - -instance ToFilePath FilePath where - toFilePath = id - -mkdir :: (MonadIO m, ToFilePath a) => a -> m () -mkdir a = do - void $ liftIO $ E.try @SomeException (D.createDirectoryIfMissing True (toFilePath a)) - -data TouchOpt = TouchEasy | TouchHard - deriving stock (Eq,Ord,Show) - -class ToFilePath a => HasTouchOpts a where - touchOpts :: a -> [TouchOpt] - -instance HasTouchOpts FilePath where - touchOpts = const [TouchEasy] - -touch :: (MonadIO m, HasTouchOpts a) => a -> m () -touch what = do - here <- doesPathExist fn - dir <- doesDirectoryExist fn - - when (not here || hard) do - mkdir (takeDirectory fn) - unless dir do - liftIO $ LBS.appendFile fn mempty - - where - hard = TouchHard `elem` touchOpts what - fn = toFilePath what - -pwd :: MonadIO m => m FilePath -pwd = liftIO D.getCurrentDirectory - - -doesPathExist :: MonadIO m => FilePath -> m Bool -doesPathExist = liftIO . D.doesPathExist - -canonicalizePath :: MonadIO m => FilePath -> m FilePath -canonicalizePath = liftIO . D.canonicalizePath - -expandPath :: MonadIO m => FilePath -> m FilePath -expandPath = liftIO . D.canonicalizePath - -doesDirectoryExist :: MonadIO m => FilePath -> m Bool -doesDirectoryExist = liftIO . D.doesDirectoryExist - -doesFileExist :: MonadIO m => FilePath -> m Bool -doesFileExist = liftIO . D.doesFileExist - - -fileSize :: MonadIO m => FilePath -> m Integer -fileSize = liftIO . D.getFileSize - -mv :: MonadIO m => FilePath -> FilePath -> m () -mv a b = liftIO $ D.renamePath a b - -rm :: MonadIO m => FilePath -> m () -rm fn = liftIO $ D.removePathForcibly fn - -home :: MonadIO m => m FilePath -home = liftIO D.getHomeDirectory - -data DirEntry = EntryFile FilePath | EntryDir FilePath | EntryOther FilePath - -dirFiles :: MonadIO m => FilePath -> m [FilePath] -dirFiles d = S.toList_ $ do - dirEntries d $ \case - EntryFile f -> S.yield f >> pure True - _ -> pure True - -dirEntries :: MonadIO m => FilePath -> ( DirEntry -> m Bool ) -> m () -dirEntries dir what = do - es <- liftIO $ D.listDirectory dir - - flip fix es $ \next -> \case - [] -> pure () - (x:xs) -> do - let entry = dir x - isFile <- liftIO (D.doesFileExist entry) - isDir <- liftIO (D.doesDirectoryExist entry) - if | isFile -> continueThen (what (EntryFile entry)) (next xs) - | isDir -> continueThen (what (EntryDir entry)) (next xs) - | otherwise -> continueThen (what (EntryOther entry)) (next xs) - - where - continueThen a b = do - r <- a - when r b +import UnliftIO as Exported diff --git a/miscellaneous/suckless-conf/lib/Data/Config/Suckless/Script/Internal.hs b/miscellaneous/suckless-conf/lib/Data/Config/Suckless/Script/Internal.hs index 7f7b2731..c1c1d2d7 100644 --- a/miscellaneous/suckless-conf/lib/Data/Config/Suckless/Script/Internal.hs +++ b/miscellaneous/suckless-conf/lib/Data/Config/Suckless/Script/Internal.hs @@ -12,6 +12,7 @@ import Data.Config.Suckless import Data.Config.Suckless.Syntax import Data.Config.Suckless.Parse.Fuzzy as P import Data.Config.Suckless.Almost.RPC +import Data.Config.Suckless.System import Data.Traversable import Control.Applicative @@ -55,6 +56,7 @@ import Prettyprinter.Render.Terminal import Safe import Streaming.Prelude qualified as S import System.Environment +import System.Directory qualified as Dir import Text.InterpolatedString.Perl6 (qc) import UnliftIO @@ -1085,6 +1087,10 @@ internalEntries = do _ -> throwIO (BadFormException @c nil) + entry $ bindMatch "sort" $ \case + [ListVal es] -> pure $ mkList $ (List.sortOn toSortable) es + _ -> throwIO (BadFormException @c nil) + entry $ bindMatch "sort-by" $ \case [what, ListVal es] -> do sorted <- forM es \e -> do @@ -1576,6 +1582,59 @@ internalEntries = do _ -> pure nil + entry $ bindMatch "mkdir" $ nil_ $ \case + [ StringLike p ] -> mkdir p + _ -> throwIO $ BadFormException @c nil + + entry $ bindMatch "rm" $ nil_ $ \case + [ StringLike p ] -> rm p + _ -> throwIO $ BadFormException @c nil + + entry $ bindMatch "mv" $ nil_ $ \case + [ StringLike a, StringLike b ] -> mv a b + _ -> throwIO $ BadFormException @c nil + + entry $ bindMatch "touch" $ nil_ $ \case + [ StringLike p ] -> touch p + _ -> throwIO $ BadFormException @c nil + + entry $ bindMatch "path:exists?" $ \case + [ StringLike p ] -> lift do + liftIO (Dir.doesPathExist p) <&> mkBool + _ -> pure $ mkBool False + + entry $ bindMatch "path:dir?" $ \case + [ StringLike p ] -> lift do + liftIO (Dir.doesDirectoryExist p) <&> mkBool + _ -> pure $ mkBool False + + entry $ bindMatch "path:file?" $ \case + [ StringLike p ] -> lift do + liftIO (Dir.doesFileExist p) <&> mkBool + _ -> pure $ mkBool False + + entry $ bindMatch "path:expand" $ \case + [ StringLike p ] -> lift do + mkSym <$> canonicalizePath p + _ -> throwIO $ BadFormException @c nil + + entry $ bindMatch "dir:list:files" $ \case + [ StringLike p ] -> lift do + dirFiles p <&> mkList . fmap mkSym + _ -> throwIO $ BadFormException @c nil + + entry $ bindMatch "dir:list:all" $ \case + [ StringLike p ] -> lift do + what <- S.toList_ $ dirEntries p $ \e -> do + let r = case e of + EntryFile what -> mkList @c [mkSym what, mkSym "file" ] + EntryDir what -> mkList @c [ mkSym what, mkSym "dir" ] + EntryOther what -> mkList @c [ mkSym what,mkSym "other" ] + S.yield r + pure True + pure $ mkList what + + _ -> throwIO $ BadFormException @c nil entry $ bindMatch "html" $ \syn -> do diff --git a/miscellaneous/suckless-conf/lib/Data/Config/Suckless/System.hs b/miscellaneous/suckless-conf/lib/Data/Config/Suckless/System.hs new file mode 100644 index 00000000..52559d2e --- /dev/null +++ b/miscellaneous/suckless-conf/lib/Data/Config/Suckless/System.hs @@ -0,0 +1,117 @@ +{-# Language MultiWayIf #-} +module Data.Config.Suckless.System where + +import Data.Function +import System.FilePath +import System.Directory qualified as D +import Data.ByteString.Lazy qualified as LBS +import UnliftIO +import Control.Exception qualified as E +import Control.Monad + +import Streaming.Prelude qualified as S + +data MkDirOpt = MkDirOptNone + +class HasMkDirOptions a where + mkdirOpts :: a -> [MkDirOpt] + +instance HasMkDirOptions FilePath where + mkdirOpts = mempty + +class ToFilePath a where + toFilePath :: a -> FilePath + +instance ToFilePath FilePath where + toFilePath = id + +mkdir :: (MonadIO m, ToFilePath a) => a -> m () +mkdir a = do + void $ liftIO $ E.try @SomeException (D.createDirectoryIfMissing True (toFilePath a)) + +data TouchOpt = TouchEasy | TouchHard + deriving stock (Eq,Ord,Show) + +class ToFilePath a => HasTouchOpts a where + touchOpts :: a -> [TouchOpt] + +instance HasTouchOpts FilePath where + touchOpts = const [TouchEasy] + +touch :: (MonadIO m, HasTouchOpts a) => a -> m () +touch what = do + here <- doesPathExist fn + dir <- doesDirectoryExist fn + + when (not here || hard) do + mkdir (takeDirectory fn) + unless dir do + liftIO $ LBS.appendFile fn mempty + + where + hard = TouchHard `elem` touchOpts what + fn = toFilePath what + +pwd :: MonadIO m => m FilePath +pwd = liftIO D.getCurrentDirectory + + +doesPathExist :: MonadIO m => FilePath -> m Bool +doesPathExist = liftIO . D.doesPathExist + +canonicalizePath :: MonadIO m => FilePath -> m FilePath +canonicalizePath = liftIO . D.canonicalizePath + +expandPath :: MonadIO m => FilePath -> m FilePath +expandPath = liftIO . D.canonicalizePath + +doesDirectoryExist :: MonadIO m => FilePath -> m Bool +doesDirectoryExist = liftIO . D.doesDirectoryExist + +doesFileExist :: MonadIO m => FilePath -> m Bool +doesFileExist = liftIO . D.doesFileExist + + +fileSize :: MonadIO m => FilePath -> m Integer +fileSize = liftIO . D.getFileSize + +mv :: MonadIO m => FilePath -> FilePath -> m () +mv a b = liftIO $ D.renamePath a b + +rm :: MonadIO m => FilePath -> m () +rm fn = liftIO $ D.removePathForcibly fn + +home :: MonadIO m => m FilePath +home = liftIO D.getHomeDirectory + +data DirEntry = + EntryFile { entryPath :: FilePath } + | EntryDir { entryPath :: FilePath } + | EntryOther { entryPath :: FilePath } + +dirFiles :: MonadIO m => FilePath -> m [FilePath] +dirFiles d = S.toList_ $ do + dirEntries d $ \case + EntryFile f -> S.yield f >> pure True + _ -> pure True + +dirEntries :: MonadIO m => FilePath -> ( DirEntry -> m Bool ) -> m () +dirEntries dir what = do + es <- liftIO $ D.listDirectory dir + + flip fix es $ \next -> \case + [] -> pure () + (x:xs) -> do + let entry = dir x + isFile <- liftIO (D.doesFileExist entry) + isDir <- liftIO (D.doesDirectoryExist entry) + if | isFile -> continueThen (what (EntryFile entry)) (next xs) + | isDir -> continueThen (what (EntryDir entry)) (next xs) + | otherwise -> continueThen (what (EntryOther entry)) (next xs) + + where + continueThen a b = do + r <- a + when r b + + diff --git a/miscellaneous/suckless-conf/suckless-conf.cabal b/miscellaneous/suckless-conf/suckless-conf.cabal index f9e42edb..5415eae9 100644 --- a/miscellaneous/suckless-conf/suckless-conf.cabal +++ b/miscellaneous/suckless-conf/suckless-conf.cabal @@ -65,6 +65,7 @@ library , Data.Config.Suckless.Syntax , Data.Config.Suckless.Parse , Data.Config.Suckless.KeyValue + , Data.Config.Suckless.System , Data.Config.Suckless.Script , Data.Config.Suckless.Script.File , Data.Config.Suckless.Almost.RPC