HBS2.System.Dir moved to suckless

... and bound

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 UnliftIO as Exported
-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
 

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
 

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
+
+

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