-- Copyright 2015 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-}
{- | Like Show, but designed to be easy to read rather than unambiguous and
    complete.
-}
module Util.Pretty (
    module Util.Format
    , Pretty, pretty, format, formatList
    , prettys
    , formatted, pprint
    , char
    , improperRatio, fraction

    -- * generic derivation
    , formatG, formatG_, formatGCamel, formatGPrefix

    -- * formatting
    , textList, formattedList, delimitedList, record, recordTitle
    , formatMap
    , constructor
    -- * standalone
    , duration
    , bytes
    -- * misc
    , readWord
) where
import qualified Data.ByteString as ByteString
import qualified Data.Char as Char
import qualified Data.Dynamic as Dynamic
import qualified Data.Int as Int
import qualified Data.IntMap as IntMap
import qualified Data.List as List
import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Map as Map
import qualified Data.Maybe as Maybe
import qualified Data.Ratio as Ratio
import qualified Data.Set as Set
import qualified Data.Text as Text
import           Data.Text (Text)
import qualified Data.Text.Encoding as Encoding
import qualified Data.Text.IO as Text.IO
import qualified Data.Text.Lazy as Lazy
import qualified Data.Time as Time
import qualified Data.Time.Calendar as Calendar
import qualified Data.Tree as Tree
import qualified Data.Vector as Vector
import qualified Data.Vector.Storable as Storable
import qualified Data.Vector.Unboxed as Unboxed
import qualified Data.Word as Word

import qualified Foreign
import qualified Foreign.C as C
import qualified GHC.Generics as Generics
import           GHC.Generics ((:*:)((:*:)))
import qualified Text.ParserCombinators.ReadP as ReadP
import qualified Text.Read as Read

import qualified Util.Format as Format
import           Util.Format
    (Doc, indent, indentLine, indent_, render, string, text, withIndent,
     wrapWords, (<+/>), (<+>), (<//>), (</>))
import qualified Util.Num as Num
import qualified Util.Seq as Seq


defaultWidth :: Int
defaultWidth :: Int
defaultWidth = Int
75

-- | Format values in an eye-pleasing way.  Unlike Show, this isn't intended
-- to produce any kind of valid syntax, or even preserve information.
class Pretty a where
    {-# MINIMAL pretty | format #-}
    pretty :: a -> Text
    pretty = Text -> Text
Lazy.toStrict (Text -> Text) -> (a -> Text) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Text
Format.renderFlat (Doc -> Text) -> (a -> Doc) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Doc
forall a. Pretty a => a -> Doc
format
    format :: a -> Doc
    format = Text -> Doc
text (Text -> Doc) -> (a -> Text) -> a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. Pretty a => a -> Text
pretty
    formatList :: [a] -> Doc
    formatList = Char -> Char -> [a] -> Doc
forall a. Pretty a => Char -> Char -> [a] -> Doc
formattedList Char
'[' Char
']'

prettys :: Pretty a => a -> String
prettys :: forall a. Pretty a => a -> String
prettys = Text -> String
Text.unpack (Text -> String) -> (a -> Text) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. Pretty a => a -> Text
pretty

-- | Render a Pretty value to the default width.
formatted :: Pretty a => a -> Text
formatted :: forall a. Pretty a => a -> Text
formatted = Text -> Text
Lazy.toStrict (Text -> Text) -> (a -> Text) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int -> Doc -> Text
render Text
"    " Int
defaultWidth (Doc -> Text) -> (a -> Doc) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Doc
forall a. Pretty a => a -> Doc
format

pprint :: Pretty a => a -> IO ()
pprint :: forall a. Pretty a => a -> IO ()
pprint = Text -> IO ()
Text.IO.putStr (Text -> IO ()) -> (a -> Text) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. Pretty a => a -> Text
formatted

instance Pretty Doc where format :: Doc -> Doc
format = Doc -> Doc
forall a. a -> a
id

showt :: Show a => a -> Text
showt :: forall a. Show a => a -> Text
showt = String -> Text
Text.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

char :: Char -> Doc
char :: Char -> Doc
char = Text -> Doc
text (Text -> Doc) -> (Char -> Text) -> Char -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
Text.singleton


data GConfig = GConfig {
    GConfig -> String -> String
_modifyField :: String -> String
    }

gconfig :: GConfig
gconfig :: GConfig
gconfig = (String -> String) -> GConfig
GConfig String -> String
forall a. a -> a
id

dropPrefix :: String -> GConfig
dropPrefix :: String -> GConfig
dropPrefix String
prefix = GConfig
gconfig
    { _modifyField :: String -> String
_modifyField = \String
field ->
        String -> Maybe String -> String
forall a. a -> Maybe a -> a
Maybe.fromMaybe String
field (String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
List.stripPrefix String
prefix String
field)
    }

dropCamel :: GConfig
dropCamel :: GConfig
dropCamel = GConfig
gconfig
    { _modifyField :: String -> String
_modifyField = String -> String
lower (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
Char.isDigit (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
Char.isLower }
    where
    lower :: String -> String
lower (Char
c:String
cs) = Char -> Char
Char.toLower Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String
cs
    lower [] = String
"<no-capital>"

dropUnderscore :: GConfig
dropUnderscore :: GConfig
dropUnderscore =
    GConfig
gconfig { _modifyField :: String -> String
_modifyField = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'_') (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'_') }

class PrettyG f where
    prettyG :: GConfig -> f a -> [(Text, Doc)]

formatG :: (PrettyG (Generics.Rep a), Generics.Generic a) => a -> Doc
formatG :: forall a. (PrettyG (Rep a), Generic a) => a -> Doc
formatG = GConfig -> a -> Doc
forall a. (PrettyG (Rep a), Generic a) => GConfig -> a -> Doc
formatGWith GConfig
gconfig

formatG_ :: (PrettyG (Generics.Rep a), Generics.Generic a) => a -> Doc
formatG_ :: forall a. (PrettyG (Rep a), Generic a) => a -> Doc
formatG_ = GConfig -> a -> Doc
forall a. (PrettyG (Rep a), Generic a) => GConfig -> a -> Doc
formatGWith GConfig
dropUnderscore

formatGCamel :: (PrettyG (Generics.Rep a), Generics.Generic a) => a -> Doc
formatGCamel :: forall a. (PrettyG (Rep a), Generic a) => a -> Doc
formatGCamel = GConfig -> a -> Doc
forall a. (PrettyG (Rep a), Generic a) => GConfig -> a -> Doc
formatGWith GConfig
dropCamel

formatGPrefix :: (PrettyG (Generics.Rep a), Generics.Generic a)
    => String -> a -> Doc
formatGPrefix :: forall a. (PrettyG (Rep a), Generic a) => String -> a -> Doc
formatGPrefix String
prefix = GConfig -> a -> Doc
forall a. (PrettyG (Rep a), Generic a) => GConfig -> a -> Doc
formatGWith (String -> GConfig
dropPrefix String
prefix)

-- | Generic derivation for Pretty.  This works on single-constructor types,
-- records and positional.
formatGWith :: (PrettyG (Generics.Rep a), Generics.Generic a) => GConfig -> a
    -> Doc
formatGWith :: forall a. (PrettyG (Rep a), Generic a) => GConfig -> a -> Doc
formatGWith GConfig
config a
a = case GConfig -> Rep a Any -> [(Text, Doc)]
forall {k} (f :: k -> *) (a :: k).
PrettyG f =>
GConfig -> f a -> [(Text, Doc)]
prettyG GConfig
config (a -> Rep a Any
forall a x. Generic a => a -> Rep a x
Generics.from a
a) of
    [(Text
"", Doc
doc)] -> Doc
doc
    -- TODO what causes this?
    [(Text, Doc)]
fields -> Doc -> [(Text, Doc)] -> Doc
record Doc
"??" [(Text, Doc)]
fields

instance (PrettyG f) => PrettyG (Generics.M1 Generics.D d f) where
    prettyG :: forall (a :: k). GConfig -> M1 D d f a -> [(Text, Doc)]
prettyG GConfig
config (Generics.M1 f a
x) = GConfig -> f a -> [(Text, Doc)]
forall {k} (f :: k -> *) (a :: k).
PrettyG f =>
GConfig -> f a -> [(Text, Doc)]
prettyG GConfig
config f a
x

instance (PrettyG f, Generics.Constructor c) =>
        PrettyG (Generics.M1 Generics.C c f) where
    prettyG :: forall (a :: k). GConfig -> M1 C c f a -> [(Text, Doc)]
prettyG GConfig
config c :: M1 C c f a
c@(Generics.M1 f a
x)
        | M1 C c f a -> Bool
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> Bool
Generics.conIsRecord M1 C c f a
c =
            [(Text
"", Doc -> [(Text, Doc)] -> Doc
record (Text -> Doc
text (String -> Text
Text.pack String
name)) (GConfig -> f a -> [(Text, Doc)]
forall {k} (f :: k -> *) (a :: k).
PrettyG f =>
GConfig -> f a -> [(Text, Doc)]
prettyG GConfig
config f a
x))]
        | Bool
otherwise =
            [(Text
"", Text -> [Doc] -> Doc
constructor (String -> Text
Text.pack String
name) (((Text, Doc) -> Doc) -> [(Text, Doc)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Doc) -> Doc
forall a b. (a, b) -> b
snd (GConfig -> f a -> [(Text, Doc)]
forall {k} (f :: k -> *) (a :: k).
PrettyG f =>
GConfig -> f a -> [(Text, Doc)]
prettyG GConfig
config f a
x)))]
        where name :: String
name = M1 C c f a -> String
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
Generics.conName M1 C c f a
c

instance (PrettyG f, Generics.Selector s) =>
        PrettyG (Generics.M1 Generics.S s f) where
    prettyG :: forall (a :: k). GConfig -> M1 S s f a -> [(Text, Doc)]
prettyG GConfig
config it :: M1 S s f a
it@(Generics.M1 f a
x) =
        [Text] -> [Doc] -> [(Text, Doc)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Text -> [Text]
forall a. a -> [a]
repeat (String -> Text
Text.pack (GConfig -> String -> String
_modifyField GConfig
config (M1 S s f a -> String
forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
Generics.selName M1 S s f a
it))))
            (((Text, Doc) -> Doc) -> [(Text, Doc)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Doc) -> Doc
forall a b. (a, b) -> b
snd (GConfig -> f a -> [(Text, Doc)]
forall {k} (f :: k -> *) (a :: k).
PrettyG f =>
GConfig -> f a -> [(Text, Doc)]
prettyG GConfig
config f a
x))

instance Pretty a => PrettyG (Generics.K1 t a) where
    prettyG :: forall (a :: k). GConfig -> K1 t a a -> [(Text, Doc)]
prettyG GConfig
_config (Generics.K1 a
x) = [(Text
"", a -> Doc
forall a. Pretty a => a -> Doc
format a
x)]

-- instance PrettyG Generics.U1 where
--     prettyG Generics.U1 = []
instance (PrettyG f, PrettyG g) => PrettyG (f :*: g) where
    prettyG :: forall (a :: k). GConfig -> (:*:) f g a -> [(Text, Doc)]
prettyG GConfig
config (f a
xs :*: g a
ys) = GConfig -> f a -> [(Text, Doc)]
forall {k} (f :: k -> *) (a :: k).
PrettyG f =>
GConfig -> f a -> [(Text, Doc)]
prettyG GConfig
config f a
xs [(Text, Doc)] -> [(Text, Doc)] -> [(Text, Doc)]
forall a. [a] -> [a] -> [a]
++ GConfig -> g a -> [(Text, Doc)]
forall {k} (f :: k -> *) (a :: k).
PrettyG f =>
GConfig -> f a -> [(Text, Doc)]
prettyG GConfig
config g a
ys
-- instance (PrettyG f, PrettyG g) => PrettyG (f :+: g) where
--     prettyG (Generics.L1 x) = prettyG x
--     prettyG (Generics.R1 x) = prettyG x

-- * standard types

instance Pretty a => Pretty [a] where format :: [a] -> Doc
format = [a] -> Doc
forall a. Pretty a => [a] -> Doc
formatList
instance Pretty Char where
    format :: Char -> Doc
format Char
c = Text -> Doc
text (Text -> Doc) -> Text -> Doc
forall a b. (a -> b) -> a -> b
$ Text
"'" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text
Text.singleton Char
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'"
    formatList :: String -> Doc
formatList = Text -> Doc
forall a. Pretty a => a -> Doc
format (Text -> Doc) -> (String -> Text) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack

instance Pretty (a -> b) where pretty :: (a -> b) -> Text
pretty a -> b
_ = Text
"<function>"
instance Pretty () where pretty :: () -> Text
pretty () = Text
"()"
instance Pretty Bool where pretty :: Bool -> Text
pretty = Bool -> Text
forall a. Show a => a -> Text
showt
instance Pretty Int where pretty :: Int -> Text
pretty = Int -> Text
forall a. Show a => a -> Text
showt
instance Pretty Int.Int8 where pretty :: Int8 -> Text
pretty = Int8 -> Text
forall a. Show a => a -> Text
showt
instance Pretty Int.Int16 where pretty :: Int16 -> Text
pretty = Int16 -> Text
forall a. Show a => a -> Text
showt
instance Pretty Int.Int32 where pretty :: Int32 -> Text
pretty = Int32 -> Text
forall a. Show a => a -> Text
showt
instance Pretty Int.Int64 where pretty :: Int64 -> Text
pretty = Int64 -> Text
forall a. Show a => a -> Text
showt
instance Pretty Integer where pretty :: Integer -> Text
pretty = Integer -> Text
forall a. Show a => a -> Text
showt
instance Pretty Word.Word8 where pretty :: Word8 -> Text
pretty = Word8 -> Text
forall a. Show a => a -> Text
showt
instance Pretty Word.Word16 where pretty :: Word16 -> Text
pretty = Word16 -> Text
forall a. Show a => a -> Text
showt
instance Pretty Word.Word32 where pretty :: Word32 -> Text
pretty = Word32 -> Text
forall a. Show a => a -> Text
showt
instance Pretty Word.Word64 where pretty :: Word64 -> Text
pretty = Word64 -> Text
forall a. Show a => a -> Text
showt
instance Pretty Double where pretty :: Double -> Text
pretty = Bool -> Int -> Double -> Text
forall a. RealFloat a => Bool -> Int -> a -> Text
Num.showFloatP Bool
False Int
3
instance Pretty Float where pretty :: Float -> Text
pretty = Bool -> Int -> Float -> Text
forall a. RealFloat a => Bool -> Int -> a -> Text
Num.showFloatP Bool
False Int
3

instance Pretty C.CChar where pretty :: CChar -> Text
pretty = CChar -> Text
forall a. Show a => a -> Text
showt
instance Pretty C.CInt where pretty :: CInt -> Text
pretty = CInt -> Text
forall a. Show a => a -> Text
showt
instance Pretty C.CFloat where pretty :: CFloat -> Text
pretty (C.CFloat Float
a) = Float -> Text
forall a. Pretty a => a -> Text
pretty Float
a

instance (Integral a, Pretty a) => Pretty (Ratio.Ratio a) where
    pretty :: Ratio a -> Text
pretty Ratio a
r
        | Ratio a
r Ratio a -> Ratio a -> Bool
forall a. Eq a => a -> a -> Bool
== Ratio a
0 = Text
"0"
        | Ratio a
frac Ratio a -> Ratio a -> Bool
forall a. Eq a => a -> a -> Bool
== Ratio a
0 = Integer -> Text
forall a. Pretty a => a -> Text
pretty Integer
whole
        | Integer
whole Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 = Ratio a -> Text
forall {a}. Pretty a => Ratio a -> Text
ratio Ratio a
frac
        | Bool
otherwise = Integer -> Text
forall a. Pretty a => a -> Text
pretty Integer
whole Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"+" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Ratio a -> Text
forall {a}. Pretty a => Ratio a -> Text
ratio Ratio a
frac
        where
        whole :: Integer
        (Integer
whole, Ratio a
frac) = Ratio a -> (Integer, Ratio a)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction Ratio a
r
        ratio :: Ratio a -> Text
ratio Ratio a
r =
            a -> Text
forall a. Pretty a => a -> Text
pretty (Ratio a -> a
forall a. Ratio a -> a
Ratio.numerator Ratio a
r) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall a. Pretty a => a -> Text
pretty (Ratio a -> a
forall a. Ratio a -> a
Ratio.denominator Ratio a
r)

-- | The default Pretty instance for Ratio reduces the fraction to k+n/d, which
-- is not always right.  This formats an improper fraction.
improperRatio :: (Eq a, Num a, Pretty a) => Ratio.Ratio a -> Text
improperRatio :: forall a. (Eq a, Num a, Pretty a) => Ratio a -> Text
improperRatio Ratio a
r
    | a
denom a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
1 = a -> Text
forall a. Pretty a => a -> Text
pretty a
num
    | Bool
otherwise = a -> Text
forall a. Pretty a => a -> Text
pretty a
num Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall a. Pretty a => a -> Text
pretty a
denom
    where
    (a
num, a
denom) = (Ratio a -> a
forall a. Ratio a -> a
Ratio.numerator Ratio a
r, Ratio a -> a
forall a. Ratio a -> a
Ratio.denominator Ratio a
r)

-- | If it looks like a low fraction, display it thus, rather than as
-- a decimal.  This is useful because e.g. meters in three will have lots of
-- repeating decimals.  I also use fractions for power of two denominators
-- which are just fine in decimal, but the fraction still takes up less space.
fraction :: (RealFrac a, Pretty a) => Bool -> a
    -- ^ If true, try an ASCII fraction if there are no unicode ones, otherwise
    -- always use decimal.
    -> Text
fraction :: forall a. (RealFrac a, Pretty a) => Bool -> a -> Text
fraction Bool
asciiFraction a
d
    | a
d a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 = Text
"0"
    | Just Text
frac <- Rational -> Map Rational Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Rational
ratio Map Rational Text
fractions = Text
int_s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
frac
    | Bool
asciiFraction Bool -> Bool -> Bool
&& Rational -> Integer
forall a. Ratio a -> a
Ratio.denominator Rational
ratio Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
12 =
        Text
int_s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"+" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Rational -> Text
forall a. Pretty a => a -> Text
pretty Rational
ratio
    | Bool
otherwise = a -> Text
forall a. Pretty a => a -> Text
pretty a
d
    where
    (Integer
int, a
frac) = a -> (Integer, a)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction a
d
    int_s :: Text
int_s = if Integer
int Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 then Text
"" else String -> Text
Text.pack (Integer -> String
forall a. Show a => a -> String
show Integer
int)
    ratio :: Rational
ratio = a -> a -> Rational
forall a. RealFrac a => a -> a -> Rational
Ratio.approxRational a
frac a
0.0001
    fractions :: Map Rational Text
fractions = [(Rational, Text)] -> Map Rational Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        [ (Rational
0 Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
1, Text
"")
        , (Rational
1 Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
4, Text
"¼"), (Rational
1 Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
2, Text
"½"), (Rational
3 Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
4, Text
"¾")
        , (Rational
1 Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
3, Text
"⅓"), (Rational
2 Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
3, Text
"⅔")
        , (Rational
1 Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
5, Text
"⅕"), (Rational
2 Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
5, Text
"⅖"), (Rational
3 Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
5, Text
"⅗"), (Rational
4 Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
5, Text
"⅘")
        , (Rational
1 Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
6, Text
"⅙"), (Rational
5 Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
6, Text
"⅚")
        , (Rational
1 Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
8, Text
"⅛"), (Rational
3 Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
8, Text
"⅜"), (Rational
5 Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
8, Text
"⅝"), (Rational
7 Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
8, Text
"⅞")
        ]

instance Pretty a => Pretty (Maybe a) where
    format :: Maybe a -> Doc
format Maybe a
Nothing = Text -> Doc
text Text
"Nothing"
    format (Just a
a) = a -> Doc
forall a. Pretty a => a -> Doc
format a
a

instance (Pretty a, Pretty b) => Pretty (Either a b) where
    format :: Either a b -> Doc
format (Left a
a) = Text -> Doc
text Text
"Left" Doc -> Doc -> Doc
<+> a -> Doc
forall a. Pretty a => a -> Doc
format a
a
    format (Right b
b) = Text -> Doc
text Text
"Right" Doc -> Doc -> Doc
<+> b -> Doc
forall a. Pretty a => a -> Doc
format b
b

instance (Pretty a, Pretty b) => Pretty (a, b) where
    format :: (a, b) -> Doc
format (a
a, b
b) = Char -> Char -> [Doc] -> Doc
forall a. Pretty a => Char -> Char -> [a] -> Doc
formattedList Char
'(' Char
')' [a -> Doc
forall a. Pretty a => a -> Doc
format a
a, b -> Doc
forall a. Pretty a => a -> Doc
format b
b]
instance (Pretty a, Pretty b, Pretty c) => Pretty (a, b, c) where
    format :: (a, b, c) -> Doc
format (a
a, b
b, c
c) = Char -> Char -> [Doc] -> Doc
forall a. Pretty a => Char -> Char -> [a] -> Doc
formattedList Char
'(' Char
')' [a -> Doc
forall a. Pretty a => a -> Doc
format a
a, b -> Doc
forall a. Pretty a => a -> Doc
format b
b, c -> Doc
forall a. Pretty a => a -> Doc
format c
c]
instance (Pretty a, Pretty b, Pretty c, Pretty d) => Pretty (a, b, c, d) where
    format :: (a, b, c, d) -> Doc
format (a
a, b
b, c
c, d
d) = Char -> Char -> [Doc] -> Doc
forall a. Pretty a => Char -> Char -> [a] -> Doc
formattedList Char
'(' Char
')'
        [a -> Doc
forall a. Pretty a => a -> Doc
format a
a, b -> Doc
forall a. Pretty a => a -> Doc
format b
b, c -> Doc
forall a. Pretty a => a -> Doc
format c
c, d -> Doc
forall a. Pretty a => a -> Doc
format d
d]
instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e) =>
        Pretty (a, b, c, d, e) where
    format :: (a, b, c, d, e) -> Doc
format (a
a, b
b, c
c, d
d, e
e) = Char -> Char -> [Doc] -> Doc
forall a. Pretty a => Char -> Char -> [a] -> Doc
formattedList Char
'(' Char
')'
        [a -> Doc
forall a. Pretty a => a -> Doc
format a
a, b -> Doc
forall a. Pretty a => a -> Doc
format b
b, c -> Doc
forall a. Pretty a => a -> Doc
format c
c, d -> Doc
forall a. Pretty a => a -> Doc
format d
d, e -> Doc
forall a. Pretty a => a -> Doc
format e
e]
instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e, Pretty f) =>
        Pretty (a, b, c, d, e, f) where
    format :: (a, b, c, d, e, f) -> Doc
format (a
a, b
b, c
c, d
d, e
e, f
f) = Char -> Char -> [Doc] -> Doc
forall a. Pretty a => Char -> Char -> [a] -> Doc
formattedList Char
'(' Char
')'
        [a -> Doc
forall a. Pretty a => a -> Doc
format a
a, b -> Doc
forall a. Pretty a => a -> Doc
format b
b, c -> Doc
forall a. Pretty a => a -> Doc
format c
c, d -> Doc
forall a. Pretty a => a -> Doc
format d
d, e -> Doc
forall a. Pretty a => a -> Doc
format e
e, f -> Doc
forall a. Pretty a => a -> Doc
format f
f]

-- ** containers

instance Pretty a => Pretty (Set.Set a) where
    format :: Set a -> Doc
format = Char -> Char -> [a] -> Doc
forall a. Pretty a => Char -> Char -> [a] -> Doc
formattedList Char
'{' Char
'}' ([a] -> Doc) -> (Set a -> [a]) -> Set a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> [a]
forall a. Set a -> [a]
Set.toList

instance (Pretty k, Pretty v) => Pretty (Map.Map k v) where
    format :: Map k v -> Doc
format = [(Doc, Doc)] -> Doc
formatMap ([(Doc, Doc)] -> Doc)
-> (Map k v -> [(Doc, Doc)]) -> Map k v -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((k, v) -> (Doc, Doc)) -> [(k, v)] -> [(Doc, Doc)]
forall a b. (a -> b) -> [a] -> [b]
map (\(k
k, v
v) -> (k -> Doc
forall a. Pretty a => a -> Doc
format k
k, v -> Doc
forall a. Pretty a => a -> Doc
format v
v)) ([(k, v)] -> [(Doc, Doc)])
-> (Map k v -> [(k, v)]) -> Map k v -> [(Doc, Doc)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k v -> [(k, v)]
forall k a. Map k a -> [(k, a)]
Map.toList

instance Pretty v => Pretty (IntMap.IntMap v) where
    format :: IntMap v -> Doc
format = Char -> Char -> [Doc] -> Doc
forall a. Pretty a => Char -> Char -> [a] -> Doc
formattedList Char
'{' Char
'}' ([Doc] -> Doc) -> (IntMap v -> [Doc]) -> IntMap v -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, v) -> Doc) -> [(Int, v)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Int, v) -> Doc
forall a b. (Pretty a, Pretty b) => (a, b) -> Doc
pair ([(Int, v)] -> [Doc])
-> (IntMap v -> [(Int, v)]) -> IntMap v -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntMap v -> [(Int, v)]
forall a. IntMap a -> [(Int, a)]
IntMap.toList
        where pair :: (a, a) -> Doc
pair (a
k, a
v) = a -> Doc
forall a. Pretty a => a -> Doc
format a
k Doc -> Doc -> Doc
</> (Doc
":" Doc -> Doc -> Doc
<+> a -> Doc
forall a. Pretty a => a -> Doc
format a
v)

instance Pretty a => Pretty (Tree.Tree a) where
    format :: Tree a -> Doc
format (Tree.Node a
val [Tree a]
children) =
        Doc
"Node" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
indent_ (Doc
"(" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> a -> Doc
forall a. Pretty a => a -> Doc
format a
val Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
")" Doc -> Doc -> Doc
<+/> [Tree a] -> Doc
forall a. Pretty a => a -> Doc
format [Tree a]
children)

-- ** other base types

instance Pretty Time.UTCTime where pretty :: UTCTime -> Text
pretty = UTCTime -> Text
forall a. Show a => a -> Text
showt
instance Pretty Time.NominalDiffTime where
    pretty :: NominalDiffTime -> Text
pretty NominalDiffTime
s = Double -> Text
forall a. Pretty a => a -> Text
pretty (NominalDiffTime -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac NominalDiffTime
s :: Double) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"s"
instance Pretty Dynamic.Dynamic where pretty :: Dynamic -> Text
pretty = Dynamic -> Text
forall a. Show a => a -> Text
showt
instance Pretty Calendar.Day where pretty :: Day -> Text
pretty = Day -> Text
forall a. Show a => a -> Text
showt

instance Pretty (Foreign.Ptr a) where pretty :: Ptr a -> Text
pretty = Ptr a -> Text
forall a. Show a => a -> Text
showt
instance Pretty (Foreign.ForeignPtr a) where pretty :: ForeignPtr a -> Text
pretty = ForeignPtr a -> Text
forall a. Show a => a -> Text
showt

-- ** text

instance Pretty ByteString.ByteString where
    format :: ByteString -> Doc
format ByteString
bs = case ByteString -> Either UnicodeException Text
Encoding.decodeUtf8' ByteString
bs of
        -- If it's binary, quote like a string.  Unfortunately, show will add
        -- extra "s which format will then add again.
        Left UnicodeException
_ -> String -> Doc
forall a. Pretty a => a -> Doc
format (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ Int -> String -> String
forall a. Int -> [a] -> [a]
Seq.rdrop Int
1 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> String
forall a. Show a => a -> String
show ByteString
bs
        Right Text
txt -> Text -> Doc
forall a. Pretty a => a -> Doc
format Text
txt

instance Pretty Text where
    format :: Text -> Doc
format Text
t = Doc
"\"" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Doc
text Text
t Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"\""

instance Pretty Lazy.Text where
    format :: Text -> Doc
format = Text -> Doc
forall a. Pretty a => a -> Doc
format (Text -> Doc) -> (Text -> Text) -> Text -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Lazy.toStrict

-- * hackage types

instance Pretty a => Pretty (NonEmpty.NonEmpty a) where
    format :: NonEmpty a -> Doc
format = [a] -> Doc
forall a. Pretty a => [a] -> Doc
formatList ([a] -> Doc) -> (NonEmpty a -> [a]) -> NonEmpty a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
NonEmpty.toList

instance (Unboxed.Unbox a, Pretty a) => Pretty (Unboxed.Vector a) where
    format :: Vector a -> Doc
format = Char -> Char -> [a] -> Doc
forall a. Pretty a => Char -> Char -> [a] -> Doc
formattedList Char
'<' Char
'>' ([a] -> Doc) -> (Vector a -> [a]) -> Vector a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector a -> [a]
forall a. Unbox a => Vector a -> [a]
Unboxed.toList
instance (Pretty a) => Pretty (Vector.Vector a) where
    format :: Vector a -> Doc
format = Char -> Char -> [a] -> Doc
forall a. Pretty a => Char -> Char -> [a] -> Doc
formattedList Char
'<' Char
'>' ([a] -> Doc) -> (Vector a -> [a]) -> Vector a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector a -> [a]
forall a. Vector a -> [a]
Vector.toList
instance (Storable.Storable a, Pretty a) => Pretty (Storable.Vector a) where
    format :: Vector a -> Doc
format = Char -> Char -> [a] -> Doc
forall a. Pretty a => Char -> Char -> [a] -> Doc
formattedList Char
'<' Char
'>' ([a] -> Doc) -> (Vector a -> [a]) -> Vector a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector a -> [a]
forall a. Storable a => Vector a -> [a]
Storable.toList

-- * local types

instance (Pretty a, Pretty b) => Pretty (Seq.Paired a b) where
    format :: Paired a b -> Doc
format (Seq.First a
a) = Doc
"First" Doc -> Doc -> Doc
<+> a -> Doc
forall a. Pretty a => a -> Doc
format a
a
    format (Seq.Second b
b) = Doc
"Second" Doc -> Doc -> Doc
<+> b -> Doc
forall a. Pretty a => a -> Doc
format b
b
    format (Seq.Both a
a b
b) = Doc
"Both" Doc -> Doc -> Doc
<+> a -> Doc
forall a. Pretty a => a -> Doc
format a
a Doc -> Doc -> Doc
<+> b -> Doc
forall a. Pretty a => a -> Doc
format b
b


-- * formatters

-- | A list of strings, but without quotes around them.
textList :: [Text] -> Doc
textList :: [Text] -> Doc
textList = Bool -> Char -> Char -> [Doc] -> Doc
delimitedList Bool
False Char
'[' Char
']' ([Doc] -> Doc) -> ([Text] -> [Doc]) -> [Text] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Doc) -> [Text] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Doc
text

formattedList :: Pretty a => Char -> Char -> [a] -> Doc
formattedList :: forall a. Pretty a => Char -> Char -> [a] -> Doc
formattedList Char
left Char
right = Bool -> Char -> Char -> [Doc] -> Doc
delimitedList Bool
False Char
left Char
right ([Doc] -> Doc) -> ([a] -> [Doc]) -> [a] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc
forall a. Pretty a => a -> Doc
format

record :: Doc -> [(Text, Doc)] -> Doc
record :: Doc -> [(Text, Doc)] -> Doc
record Doc
title [(Text, Doc)]
fields =
    Doc
title Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
indent_ (Bool -> Char -> Char -> [Doc] -> Doc
delimitedList Bool
True Char
'{' Char
'}' (((Text, Doc) -> Doc) -> [(Text, Doc)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Doc) -> Doc
field [(Text, Doc)]
fields))
    where field :: (Text, Doc) -> Doc
field (Text
name, Doc
val) = Text -> Doc
text Text
name Doc -> Doc -> Doc
<+> Doc
"=" Doc -> Doc -> Doc
<+/> Doc
val
    -- The "name = val" is already indented due to delimitedList, so if it
    -- wraps it will already be at one level of indentation.

recordTitle :: Text -> [(Text, Doc)] -> Doc
recordTitle :: Text -> [(Text, Doc)] -> Doc
recordTitle = Doc -> [(Text, Doc)] -> Doc
record (Doc -> [(Text, Doc)] -> Doc)
-> (Text -> Doc) -> Text -> [(Text, Doc)] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc
text

formatMap :: [(Doc, Doc)] -> Doc
formatMap :: [(Doc, Doc)] -> Doc
formatMap = Char -> Char -> [Doc] -> Doc
forall a. Pretty a => Char -> Char -> [a] -> Doc
formattedList Char
'{' Char
'}' ([Doc] -> Doc) -> ([(Doc, Doc)] -> [Doc]) -> [(Doc, Doc)] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Doc, Doc) -> Doc) -> [(Doc, Doc)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Doc, Doc) -> Doc
pair
    where pair :: (Doc, Doc) -> Doc
pair (Doc
k, Doc
v) = Doc
k Doc -> Doc -> Doc
</> (Doc
":" Doc -> Doc -> Doc
<+> Doc
v)

constructor :: Text -> [Doc] -> Doc
constructor :: Text -> [Doc] -> Doc
constructor Text
name [] = Text -> Doc
text Text
name
constructor Text
name [Doc]
fields =
    Text -> Doc
text Text
name Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
indent_ ([Doc] -> Doc
wrapWords ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Doc -> Doc) -> [Doc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Char -> Char -> Doc -> Doc
surround Char
'(' Char
')') [Doc]
fields)
    where surround :: Char -> Char -> Doc -> Doc
surround Char
left Char
right Doc
x = Char -> Doc
char Char
left Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
x Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
right
    -- TODO only surround ()s if it has spaces in it

-- | Format a comma-separated list.  Try to put it on one line, but break
-- before commas if that's not possible.
delimitedList :: Bool -- ^ Always spaces around the delimiters.  Otherwise,
    -- they only get spaces if the list wraps.
    -> Char -> Char -> [Doc] -> Doc
delimitedList :: Bool -> Char -> Char -> [Doc] -> Doc
delimitedList Bool
spacedDelimiter Char
leftc Char
rightc [Doc]
xs = case [Doc]
xs of
    [] -> Doc
left Doc -> Doc -> Doc
<-> Doc
right
    Doc
x : [Doc]
xs -> Doc -> Doc -> Doc
Format.shortForm
        (Doc
left Doc -> Doc -> Doc
<-> Doc
x Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat ((Doc -> Doc) -> [Doc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Doc
","<+>) [Doc]
xs) Doc -> Doc -> Doc
<-> Doc
right) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
        (Doc
left Doc -> Doc -> Doc
<+> Doc -> Doc
withIndent Doc
x) Doc -> Doc -> Doc
</> [Doc] -> Doc
Format.wrap ((Doc -> Doc) -> [Doc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Doc -> Doc
element [Doc]
xs)
            Doc -> Doc -> Doc
<//> Doc
right Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"\n"
    where
    element :: Doc -> Doc
element Doc
x = Doc
"," Doc -> Doc -> Doc
<+> Doc -> Doc
withIndent Doc
x
    <-> :: Doc -> Doc -> Doc
(<->) = if Bool
spacedDelimiter then Doc -> Doc -> Doc
(<+>) else Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
(<>)
    left :: Doc
left = Text -> Doc
text (Text -> Doc) -> Text -> Doc
forall a b. (a -> b) -> a -> b
$ Char -> Text
Text.singleton Char
leftc
    right :: Doc
right = Text -> Doc
text (Text -> Doc) -> Text -> Doc
forall a b. (a -> b) -> a -> b
$ Char -> Text
Text.singleton Char
rightc


-- * standalone

duration :: Time.NominalDiffTime -> Text
duration :: NominalDiffTime -> Text
duration NominalDiffTime
secs0 = [Text] -> Text
Text.unwords ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ [Integer -> Text
forall a. Show a => a -> Text
showt Integer
days Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"d" | Integer
days Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0]
    , [Integer -> Text
forall a. Show a => a -> Text
showt Integer
hours Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"h" | Integer
hours Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0]
    , [Integer -> Text
forall a. Show a => a -> Text
showt Integer
mins Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"m" | Integer
mins Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0]
    , [NominalDiffTime -> Text
forall a. Pretty a => a -> Text
pretty NominalDiffTime
secs3]
    ]
    where
    (Integer
days, NominalDiffTime
secs1) = NominalDiffTime -> NominalDiffTime -> (Integer, NominalDiffTime)
forall div mod.
(Integral div, RealFrac mod) =>
mod -> mod -> (div, mod)
Num.fDivMod NominalDiffTime
secs0 (NominalDiffTime
60NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
*NominalDiffTime
60NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
*NominalDiffTime
24)
    (Integer
hours, NominalDiffTime
secs2) = NominalDiffTime -> NominalDiffTime -> (Integer, NominalDiffTime)
forall div mod.
(Integral div, RealFrac mod) =>
mod -> mod -> (div, mod)
Num.fDivMod NominalDiffTime
secs1 (NominalDiffTime
60NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
*NominalDiffTime
60)
    (Integer
mins, NominalDiffTime
secs3) = NominalDiffTime -> NominalDiffTime -> (Integer, NominalDiffTime)
forall div mod.
(Integral div, RealFrac mod) =>
mod -> mod -> (div, mod)
Num.fDivMod NominalDiffTime
secs2 NominalDiffTime
60

bytes :: Int -> Int -> Text
bytes :: Int -> Int -> Text
bytes Int
precision Int
bs = case ((Double, Text) -> Bool)
-> [(Double, Text)] -> Maybe (Double, Text)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find ((Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>=Double
1) (Double -> Bool)
-> ((Double, Text) -> Double) -> (Double, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double, Text) -> Double
forall a b. (a, b) -> a
fst) [(Double, Text)]
sizes of
    Just (Double
v, Text
s) -> Int -> Double -> Text
forall a. RealFloat a => Int -> a -> Text
Num.showFloat Int
precision Double
v Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s
    Maybe (Double, Text)
Nothing -> Int -> Text
forall a. Show a => a -> Text
showt Int
bs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"b"
    where
    sizes :: [(Double, Text)]
sizes = [(Double
gb, Text
"gb"), (Double
mb, Text
"mb"), (Double
kb, Text
"kb")]
    kb :: Double
kb = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bs Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1024
    mb :: Double
mb = Double
kb Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1024
    gb :: Double
gb = Double
mb Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1024

-- * Read

-- These don't really belong here, but this module has to do with reading and
-- showing, and as long as only have a few Read utilities I might as well put
-- them here.

-- | Read a space separated word.
readWord :: Read.ReadPrec String
readWord :: ReadPrec String
readWord = ReadP String -> ReadPrec String
forall a. ReadP a -> ReadPrec a
Read.lift (ReadP String -> ReadPrec String)
-> ReadP String -> ReadPrec String
forall a b. (a -> b) -> a -> b
$ do
    ReadP ()
ReadP.skipSpaces
    String
w <- ReadP Char -> ReadP String
forall a. ReadP a -> ReadP [a]
ReadP.many1 ((Char -> Bool) -> ReadP Char
ReadP.satisfy (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
Char.isSpace))
    ReadP ()
ReadP.skipSpaces
    String -> ReadP String
forall (m :: * -> *) a. Monad m => a -> m a
return String
w