ENH clean up code
This commit is contained in:
parent
7ed00c0987
commit
d352e4d49b
|
@ -176,12 +176,12 @@ mountByAlias unmountFlag alias = do
|
||||||
mkGroup :: NE.NonEmpty (Header, ProtoAction) -> RofiGroup MountConf
|
mkGroup :: NE.NonEmpty (Header, ProtoAction) -> RofiGroup MountConf
|
||||||
mkGroup as = titledGroup h $ toRofiActions $ NE.toList $ alignEntries $ snd <$> as
|
mkGroup as = titledGroup h $ toRofiActions $ NE.toList $ alignEntries $ snd <$> as
|
||||||
where
|
where
|
||||||
h = (T.pack $ show $ fst $ NE.head as)
|
h = T.pack $ show $ fst $ NE.head as
|
||||||
|
|
||||||
alignSep :: T.Text
|
alignSep :: T.Text
|
||||||
alignSep = " | "
|
alignSep = " | "
|
||||||
|
|
||||||
alignEntries :: NE.NonEmpty (ProtoAction) -> NE.NonEmpty (T.Text, MIO ())
|
alignEntries :: NE.NonEmpty ProtoAction -> NE.NonEmpty (T.Text, MIO ())
|
||||||
alignEntries ps = NE.zip (align es) as
|
alignEntries ps = NE.zip (align es) as
|
||||||
where
|
where
|
||||||
(es, as) = NE.unzip $ fmap (\(ProtoAction e a) -> (e, a)) ps
|
(es, as) = NE.unzip $ fmap (\(ProtoAction e a) -> (e, a)) ps
|
||||||
|
@ -190,10 +190,10 @@ alignEntries ps = NE.zip (align es) as
|
||||||
. NE.transpose
|
. NE.transpose
|
||||||
. fmap1 padAll
|
. fmap1 padAll
|
||||||
. NE.transpose
|
. NE.transpose
|
||||||
fmap1 f (x :| xs) = (f x) :| xs
|
fmap1 f (x :| xs) = f x :| xs
|
||||||
padAll xs = let m = maxNE $ fmap T.length xs in fmap (rpad m ' ') xs
|
padAll xs = let m = maxNE $ fmap T.length xs in fmap (rpad m ' ') xs
|
||||||
maxNE (x :| []) = x
|
maxNE (x :| []) = x
|
||||||
maxNE (x :| (y : ys)) = maxNE $ (max x y) :| ys
|
maxNE (x :| (y : ys)) = maxNE $ max x y :| ys
|
||||||
|
|
||||||
rpad :: Int -> Char -> T.Text -> T.Text
|
rpad :: Int -> Char -> T.Text -> T.Text
|
||||||
rpad n c s = T.append s $ T.replicate (n - T.length s) $ T.singleton c
|
rpad n c s = T.append s $ T.replicate (n - T.length s) $ T.singleton c
|
||||||
|
@ -270,7 +270,7 @@ class Mountable a where
|
||||||
class Mountable a => Actionable a where
|
class Mountable a => Actionable a where
|
||||||
-- | Return a string to go in the Rofi menu for the given type
|
-- | Return a string to go in the Rofi menu for the given type
|
||||||
fmtEntry :: a -> NE.NonEmpty T.Text
|
fmtEntry :: a -> NE.NonEmpty T.Text
|
||||||
fmtEntry d = (getLabel d :| [])
|
fmtEntry d = getLabel d :| []
|
||||||
|
|
||||||
groupHeader :: a -> Header
|
groupHeader :: a -> Header
|
||||||
|
|
||||||
|
@ -283,7 +283,7 @@ class Mountable a => Actionable a where
|
||||||
let h = groupHeader dev
|
let h = groupHeader dev
|
||||||
let action = when i $ mountMaybe dev $ mountedState m
|
let action = when i $ mountMaybe dev $ mountedState m
|
||||||
let entry = case fmtEntry dev of
|
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)
|
return (h, ProtoAction entry action)
|
||||||
where
|
where
|
||||||
mountedPrefix _ False = "! "
|
mountedPrefix _ False = "! "
|
||||||
|
@ -346,7 +346,7 @@ instance Mountable a => Mountable (Tree a) where
|
||||||
getLabel (Tree p _) = getLabel p
|
getLabel (Tree p _) = getLabel p
|
||||||
|
|
||||||
instance Actionable (Tree DeviceConfig) where
|
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
|
where
|
||||||
target (CIFSConfig (CIFSData {cifsRemote = r})) = r
|
target (CIFSConfig (CIFSData {cifsRemote = r})) = r
|
||||||
target (SSHFSConfig (SSHFSData {sshfsRemote = r})) = r
|
target (SSHFSConfig (SSHFSData {sshfsRemote = r})) = r
|
||||||
|
@ -551,7 +551,7 @@ runPromptLoop n pwd = do
|
||||||
configToPwd :: (HasLogFunc c, MonadReader c m, MonadUnliftIO m) => PasswordConfig -> PasswordGetter m
|
configToPwd :: (HasLogFunc c, MonadReader c m, MonadUnliftIO m) => PasswordConfig -> PasswordGetter m
|
||||||
configToPwd (PwdBW (BitwardenConfig {bwKey = k, bwTries = n})) =
|
configToPwd (PwdBW (BitwardenConfig {bwKey = k, bwTries = n})) =
|
||||||
runPromptLoop n $ runBitwarden k
|
runPromptLoop n $ runBitwarden k
|
||||||
configToPwd (PwdLS s) = runSecret $ M.fromList $ fmap (\(SecretMap k v) -> (k, v)) $ secretAttributes s
|
configToPwd (PwdLS s) = runSecret $ M.fromList $ (\(SecretMap k v) -> (k, v)) <$> secretAttributes s
|
||||||
configToPwd (PwdPr p) = flip runPromptLoop readPassword $ promptTries p
|
configToPwd (PwdPr p) = flip runPromptLoop readPassword $ promptTries p
|
||||||
|
|
||||||
withPasswordGetter
|
withPasswordGetter
|
||||||
|
@ -593,7 +593,7 @@ instance Mountable Removable where
|
||||||
getLabel Removable {removableLabel = l} = l
|
getLabel Removable {removableLabel = l} = l
|
||||||
|
|
||||||
instance Actionable Removable where
|
instance Actionable Removable where
|
||||||
fmtEntry Removable {removablePath = d, removableLabel = l} = (l :| [d])
|
fmtEntry Removable {removablePath = d, removableLabel = l} = l :| [d]
|
||||||
|
|
||||||
groupHeader _ = RemovableHeader
|
groupHeader _ = RemovableHeader
|
||||||
|
|
||||||
|
@ -689,7 +689,7 @@ mtpExeInstalled :: MonadIO m => m Bool
|
||||||
mtpExeInstalled = isJust <$> findExecutable mtpExe
|
mtpExeInstalled = isJust <$> findExecutable mtpExe
|
||||||
|
|
||||||
instance Actionable MTPFS where
|
instance Actionable MTPFS where
|
||||||
fmtEntry d = (getLabel d :| [])
|
fmtEntry d = getLabel d :| []
|
||||||
|
|
||||||
groupHeader _ = MTPFSHeader
|
groupHeader _ = MTPFSHeader
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue