This is so ugly

This commit is contained in:
pingu 2023-10-16 18:47:09 +02:00
parent 7f9eaf5621
commit 2b72c64cb3

View File

@ -76,6 +76,20 @@ attributeMap = const $ attrMap defAttr
select :: Widget () -> Widget () select :: Widget () -> Widget ()
select = withAttr (attrName "selected") select = withAttr (attrName "selected")
unitSize :: Integer -> String
unitSize s
| fromInteger s / (k2^(3 :: Int)) >= 1 / 2 =
show (f $ fromInteger s / (k2^(3 :: Int))) ++ " GB"
| fromInteger s / (k2^(2 :: Int)) >= 1 / 2 =
show (f $ fromInteger s / (k2^(2 :: Int))) ++ " MB"
| fromInteger s / k2 >= 1 / 2 =
show (f $ fromInteger s / k2 ) ++ " KB"
| otherwise =
show s ++ " B"
where k2 = 1024 :: Double
f :: Double -> Double
f q = fromInteger (truncate $ q * 100) / 100
browse :: AppS -> Widget () browse :: AppS -> Widget ()
browse s = browse s =
str "Path" <+> padLeft Max (str "Size") <=> str "Path" <+> padLeft Max (str "Size") <=>
@ -88,7 +102,7 @@ widgetCons s w@(f,_) ws =
pathWidget w pathWidget w
pathWidget :: (FilePath, Integer) -> Widget () pathWidget :: (FilePath, Integer) -> Widget ()
pathWidget (f, s) = str (show f) <+> padLeft Max (str (show s)) pathWidget (f, s) = str (show f) <+> padLeft Max (str (unitSize s))
sizeDir :: AppS -> IO AppS sizeDir :: AppS -> IO AppS
sizeDir s = do sizeDir s = do