From 1e54682f1cc593637428bc8983a53c089c4c2991 Mon Sep 17 00:00:00 2001 From: ndwarshuis Date: Tue, 14 Feb 2023 23:09:12 -0500 Subject: [PATCH] REF remove partial lists from dev --- app/rofi-dev.hs | 76 ++++++++++++++++++++++++++----------------------- 1 file changed, 41 insertions(+), 35 deletions(-) diff --git a/app/rofi-dev.hs b/app/rofi-dev.hs index 255a566..8c62a4f 100644 --- a/app/rofi-dev.hs +++ b/app/rofi-dev.hs @@ -18,8 +18,8 @@ import Dhall.TH import RIO import RIO.Directory import qualified RIO.List as L -import qualified RIO.List.Partial as LP import qualified RIO.Map as M +import qualified RIO.NonEmpty as NE import qualified RIO.Text as T import Rofi.Command import System.Console.GetOpt @@ -139,10 +139,9 @@ getGroups = do actions <- sequence [getStaticActions, getRemovableActions, getMTPActions] return $ (++ [metaActions]) $ - mapMaybe mkGroup $ - L.groupBy (\(hx, _) (hy, _) -> hx == hy) $ - L.sortBy (\(hx, _) (hy, _) -> compare hx hy) $ - concat actions + fmap mkGroup $ + NE.groupAllWith fst $ + concat actions where metaActions = titledGroup "Meta Actions" $ @@ -163,30 +162,38 @@ mountByAlias unmountFlag alias = do static <- asks mountconfStaticDevs mapM_ (`mountMaybe` unmountFlag) $ configToTree static <$> M.lookup alias static -mkGroup :: [(Header, ProtoAction [T.Text])] -> Maybe (RofiGroup MountConf) -mkGroup [] = Nothing +mkGroup :: NE.NonEmpty (Header, ProtoAction) -> RofiGroup MountConf mkGroup as = - let ((h, _) : _) = as - in Just $ titledGroup (T.pack $ show h) $ toRofiActions $ alignEntries $ fmap snd as + let (h, _) = NE.head as + in titledGroup (T.pack $ show h) $ toRofiActions $ NE.toList $ alignEntries $ fmap snd as alignSep :: T.Text alignSep = " | " -alignEntries :: [ProtoAction [T.Text]] -> [(T.Text, RofiMountIO ())] -alignEntries ps = zip (align es) as +alignEntries :: NE.NonEmpty (ProtoAction) -> NE.NonEmpty (T.Text, RofiMountIO ()) +alignEntries ps = NE.zip (align es) as where - (es, as) = L.unzip $ fmap (\(ProtoAction e a) -> (e, a)) ps + (es, as) = NE.unzip $ fmap (\(ProtoAction e a) -> (e, a)) ps align = - fmap (T.intercalate alignSep) - . L.transpose - . mapToLast pad - . L.transpose - -- TODO not DRY (this is just a pad operation) - pad xs = let m = getMax xs in fmap (\x -> T.append x (T.replicate (m - T.length x) " ")) xs - getMax = LP.maximum . fmap T.length - mapToLast _ [] = [] - mapToLast _ [x] = [x] - mapToLast f (x : xs) = f x : mapToLast f xs + fmap (T.intercalate alignSep . NE.toList) + . NE.transpose + . fmap padAll + -- . mapToLast pad + . NE.transpose + -- padAll xs = let + padAll xs = let m = maxNE $ fmap T.length xs in fmap (rpad m ' ') xs + maxNE (x :| []) = x + maxNE (x :| (y : ys)) = maxNE $ (max x y) :| ys + +-- pad xs = let m = getMax xs in fmap (\x -> T.append x (T.replicate (m - T.length x) " ")) xs +-- getMax = LP.maximum . fmap T.length + +rpad :: Int -> Char -> T.Text -> T.Text +rpad n c s = T.append s $ T.replicate (n - T.length s) $ T.singleton c + +-- mapToLast _ [] = [] +-- mapToLast _ [x] = [x] +-- mapToLast f (x : xs) = f x : mapToLast f xs -------------------------------------------------------------------------------- -- Global config used in the reader monad stack @@ -251,22 +258,21 @@ class Mountable a where class Mountable a => Actionable a where -- | Return a string to go in the Rofi menu for the given type - fmtEntry :: a -> [T.Text] - fmtEntry d = [getLabel d] + fmtEntry :: a -> NE.NonEmpty T.Text + fmtEntry d = (getLabel d :| []) groupHeader :: a -> Header -- | Given a mountable type, return a rofi action (string to go in the -- Rofi prompt and an action to perform when it is selected) - mkAction :: a -> RofiMountIO (Header, ProtoAction [T.Text]) + mkAction :: a -> RofiMountIO (Header, ProtoAction) mkAction dev = do m <- mountState dev i <- allInstalled dev let h = groupHeader dev let action = when i $ mountMaybe dev $ mountedState m let entry = case fmtEntry dev of - (e : es) -> (T.append (mountedPrefix m i) e) : es - _ -> [] + (e :| es) -> (T.append (mountedPrefix m i) e) :| es return (h, ProtoAction entry action) where mountedPrefix _ False = "! " @@ -277,7 +283,7 @@ class Mountable a => Actionable a where mountableToAction :: Actionable a => RofiMountIO [a] - -> RofiMountIO [(Header, ProtoAction [T.Text])] + -> RofiMountIO [(Header, ProtoAction)] mountableToAction ms = mapM mkAction =<< ms type RofiMountIO a = RIO MountConf a @@ -304,7 +310,7 @@ instance Show Header where instance Ord Header where compare x y = compare (fromEnum x) (fromEnum y) -data ProtoAction a = ProtoAction a (RofiMountIO ()) +data ProtoAction = ProtoAction (NE.NonEmpty T.Text) (RofiMountIO ()) -------------------------------------------------------------------------------- -- Static devices trees @@ -332,7 +338,7 @@ instance Mountable a => Mountable (Tree a) where getLabel (Tree p _) = getLabel p instance Actionable (Tree DeviceConfig) where - fmtEntry (Tree p@DeviceConfig {deviceData = d} _) = [getLabel p, target d] + fmtEntry (Tree p@DeviceConfig {deviceData = d} _) = (getLabel p :| [target d]) where target (CIFSConfig (CIFSData {cifsRemote = r})) = r target (SSHFSConfig (SSHFSData {sshfsRemote = r})) = r @@ -484,7 +490,7 @@ getAbsMountpoint :: MountConfig -> RofiMountIO FilePath getAbsMountpoint MountConfig {mpPath = m} = asks $ flip appendRoot (T.unpack m) . mountconfVolatilePath -getStaticActions :: RofiMountIO [(Header, ProtoAction [T.Text])] +getStaticActions :: RofiMountIO [(Header, ProtoAction)] getStaticActions = mountableToAction $ asks $ configToTree' . mountconfStaticDevs -------------------------------------------------------------------------------- @@ -568,7 +574,7 @@ instance Mountable Removable where getLabel Removable {removableLabel = l} = l instance Actionable Removable where - fmtEntry Removable {removablePath = d, removableLabel = l} = [l, d] + fmtEntry Removable {removablePath = d, removableLabel = l} = (l :| [d]) groupHeader _ = RemovableHeader @@ -591,7 +597,7 @@ getRemovableDevices = _ -> Nothing mk d l = Just $ Removable {removablePath = d, removableLabel = l} -getRemovableActions :: RofiMountIO [(Header, ProtoAction [T.Text])] +getRemovableActions :: RofiMountIO [(Header, ProtoAction)] getRemovableActions = mountableToAction getRemovableDevices -------------------------------------------------------------------------------- @@ -657,14 +663,14 @@ getMTPDevices = do | c == ' ' = Just '-' | otherwise = Just c -getMTPActions :: RofiMountIO [(Header, ProtoAction [T.Text])] +getMTPActions :: RofiMountIO [(Header, ProtoAction)] getMTPActions = mountableToAction getMTPDevices mtpExeInstalled :: IO Bool mtpExeInstalled = isJust <$> findExecutable mtpExe instance Actionable MTPFS where - fmtEntry d = [getLabel d] + fmtEntry d = (getLabel d :| []) groupHeader _ = MTPFSHeader