REF remove partial lists from dev

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 $
+      fmap mkGroup $
-        L.groupBy (\(hx, _) (hy, _) -> hx == hy) $
+        NE.groupAllWith fst $
-          L.sortBy (\(hx, _) (hy, _) -> compare hx hy) $
+          concat actions
-            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 :: NE.NonEmpty (Header, ProtoAction) -> RofiGroup MountConf
-mkGroup [] = Nothing
 mkGroup as =
-  let ((h, _) : _) = as
+  let (h, _) = NE.head as
-   in Just $ titledGroup (T.pack $ show h) $ toRofiActions $ alignEntries $ fmap snd 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 :: NE.NonEmpty (ProtoAction) -> NE.NonEmpty (T.Text, RofiMountIO ())
-alignEntries ps = zip (align es) as
+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)
+      fmap (T.intercalate alignSep . NE.toList)
-        . L.transpose
+        . NE.transpose
-        . mapToLast pad
+        . fmap padAll
-        . L.transpose
+        -- . mapToLast pad
-    -- TODO not DRY (this is just a pad operation)
+        . NE.transpose
-    pad xs = let m = getMax xs in fmap (\x -> T.append x (T.replicate (m - T.length x) " ")) xs
+    -- padAll xs = let
-    getMax = LP.maximum . fmap T.length
+    padAll xs = let m = maxNE $ fmap T.length xs in fmap (rpad m ' ') xs
-    mapToLast _ [] = []
+    maxNE (x :| []) = x
-    mapToLast _ [x] = [x]
+    maxNE (x :| (y : ys)) = maxNE $ (max x y) :| ys
-    mapToLast f (x : xs) = f x : mapToLast f xs
+
+-- 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 :: a -> NE.NonEmpty T.Text
-  fmtEntry d = [getLabel d]
+  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