    {-# LANGUAGE CPP #-}
    {-# LANGUAGE Safe #-}
    #ifndef NO_GENERICS
    {-# LANGUAGE TypeOperators #-}
    {-# LANGUAGE FlexibleInstances, FlexibleContexts #-}
    {-# LANGUAGE DefaultSignatures #-}
    #endif
    module Text.Show.PrettyVal ( PrettyVal(prettyVal) ) where

    import Text.Show.Value
    import Data.Text(Text)
    import qualified Data.Text as Text
    import Data.Fixed (Fixed, HasResolution)

    #ifndef NO_GENERICS
    import Data.Ratio
    import Data.Word
    import Data.Int
    import GHC.Generics
    #endif

    -- | A class for types that may be reified into a value.
    -- Instances of this class may be derived automatically,
    -- for datatypes that support `Generics`.
    class PrettyVal a where
      prettyVal :: a -> Value
      listValue :: [a] -> Value

    #ifndef NO_GENERICS

      default prettyVal :: (GDump (Rep a), Generic a) => a -> Value
      prettyVal = [(Name, Value)] -> Value
    oneVal ([(Name, Value)] -> Value) -> (a -> [(Name, Value)]) -> a -> Value
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Rep a (ZonkAny 0) -> [(Name, Value)]
    forall a. Rep a a -> [(Name, Value)]
    forall (f :: * -> *) a. GDump f => f a -> [(Name, Value)]
    gdump (Rep a (ZonkAny 0) -> [(Name, Value)])
    -> (a -> Rep a (ZonkAny 0)) -> a -> [(Name, Value)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Rep a (ZonkAny 0)
    forall x. a -> Rep a x
    forall a x. Generic a => a -> Rep a x
    from

      default listValue :: [a] -> Value
      listValue = [Value] -> Value
    List ([Value] -> Value) -> ([a] -> [Value]) -> [a] -> Value
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a -> Value) -> [a] -> [Value]
    forall a b. (a -> b) -> [a] -> [b]
    map a -> Value
    forall a. PrettyVal a => a -> Value
    prettyVal

    class GDump f where
      gdump :: f a -> [(Name,Value)]

    instance GDump U1 where
      gdump :: forall a. U1 a -> [(Name, Value)]
    gdump U1 a
    U1 = []

    instance (GDump f, GDump g) => GDump (f :*: g) where
      gdump :: forall a. (:*:) f g a -> [(Name, Value)]
    gdump (f a
    xs :*: g a
    ys) = f a -> [(Name, Value)]
    forall a. f a -> [(Name, Value)]
    forall (f :: * -> *) a. GDump f => f a -> [(Name, Value)]
    gdump f a
    xs [(Name, Value)] -> [(Name, Value)] -> [(Name, Value)]
    forall a. [a] -> [a] -> [a]
    ++ g a -> [(Name, Value)]
    forall a. g a -> [(Name, Value)]
    forall (f :: * -> *) a. GDump f => f a -> [(Name, Value)]
    gdump g a
    ys

    instance (GDump f, GDump g) => GDump (f :+: g) where
      gdump :: forall a. (:+:) f g a -> [(Name, Value)]
    gdump (L1 f a
    x) = f a -> [(Name, Value)]
    forall a. f a -> [(Name, Value)]
    forall (f :: * -> *) a. GDump f => f a -> [(Name, Value)]
    gdump f a
    x
      gdump (R1 g a
    x) = g a -> [(Name, Value)]
    forall a. g a -> [(Name, Value)]
    forall (f :: * -> *) a. GDump f => f a -> [(Name, Value)]
    gdump g a
    x

    instance PrettyVal a => GDump (K1 t a) where
      gdump :: forall a. K1 t a a -> [(Name, Value)]
    gdump (K1 a
    x) = [ (Name
    "", a -> Value
    forall a. PrettyVal a => a -> Value
    prettyVal a
    x) ]

    instance (GDump f, Datatype d) => GDump (M1 D d f) where
      gdump :: forall a. M1 D d f a -> [(Name, Value)]
    gdump (M1 f a
    x) = f a -> [(Name, Value)]
    forall a. f a -> [(Name, Value)]
    forall (f :: * -> *) a. GDump f => f a -> [(Name, Value)]
    gdump f a
    x

    instance (GDump f, Constructor c) => GDump (M1 C c f) where
      gdump :: forall a. M1 C c f a -> [(Name, Value)]
    gdump c :: M1 C c f a
    c@(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
    forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
           (a :: k1).
    t c f a -> Bool
    conIsRecord M1 C c f a
    c = [ (Name
    "", Name -> [(Name, Value)] -> Value
    Rec   Name
    name (f a -> [(Name, Value)]
    forall a. f a -> [(Name, Value)]
    forall (f :: * -> *) a. GDump f => f a -> [(Name, Value)]
    gdump f a
    x)) ]
        | Name -> Bool
    isTuple Name
    name  = [ (Name
    "", [Value] -> Value
    Tuple (((Name, Value) -> Value) -> [(Name, Value)] -> [Value]
    forall a b. (a -> b) -> [a] -> [b]
    map (Name, Value) -> Value
    forall a b. (a, b) -> b
    snd (f a -> [(Name, Value)]
    forall a. f a -> [(Name, Value)]
    forall (f :: * -> *) a. GDump f => f a -> [(Name, Value)]
    gdump f a
    x))) ]
        | Bool
    otherwise     = [ (Name
    "", Name -> [Value] -> Value
    Con   Name
    name (((Name, Value) -> Value) -> [(Name, Value)] -> [Value]
    forall a b. (a -> b) -> [a] -> [b]
    map (Name, Value) -> Value
    forall a b. (a, b) -> b
    snd (f a -> [(Name, Value)]
    forall a. f a -> [(Name, Value)]
    forall (f :: * -> *) a. GDump f => f a -> [(Name, Value)]
    gdump f a
    x))) ]

        where
        name :: Name
    name = M1 C c f a -> Name
    forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
           (f :: k1 -> *) (a :: k1).
    Constructor c =>
    t c f a -> Name
    forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
           (a :: k1).
    t c f a -> Name
    conName M1 C c f a
    c

        isTuple :: Name -> Bool
    isTuple (Char
    '(' : Name
    cs) = case (Char -> Bool) -> Name -> (Name, Name)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    span (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    ',') Name
    cs of
                               (Name
    _,Name
    ")") -> Bool
    True
                               (Name, Name)
    _ -> Bool
    False
        isTuple Name
    _          = Bool
    False

    instance (GDump f, Selector s) => GDump (M1 S s f) where
      gdump :: forall a. M1 S s f a -> [(Name, Value)]
    gdump it :: M1 S s f a
    it@(M1 f a
    x) = Name -> [Name]
    forall a. a -> [a]
    repeat (M1 S s f a -> Name
    forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
           (f :: k1 -> *) (a :: k1).
    Selector s =>
    t s f a -> Name
    forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
           (a :: k1).
    t s f a -> Name
    selName M1 S s f a
    it) [Name] -> [Value] -> [(Name, Value)]
    forall a b. [a] -> [b] -> [(a, b)]
    `zip` ((Name, Value) -> Value) -> [(Name, Value)] -> [Value]
    forall a b. (a -> b) -> [a] -> [b]
    map (Name, Value) -> Value
    forall a b. (a, b) -> b
    snd (f a -> [(Name, Value)]
    forall a. f a -> [(Name, Value)]
    forall (f :: * -> *) a. GDump f => f a -> [(Name, Value)]
    gdump f a
    x)
    #endif

    oneVal :: [(Name,Value)] -> Value
    oneVal :: [(Name, Value)] -> Value
    oneVal [(Name, Value)]
    x =
      case [(Name, Value)]
    x of
        [ (Name
    "",Value
    v) ]               -> Value
    v
        [(Name, Value)]
    fs | ((Name, Value) -> Bool) -> [(Name, Value)] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (Name -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null (Name -> Bool) -> ((Name, Value) -> Name) -> (Name, Value) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Name, Value) -> Name
    forall a b. (a, b) -> a
    fst) [(Name, Value)]
    fs -> Name -> [Value] -> Value
    Con Name
    "?" (((Name, Value) -> Value) -> [(Name, Value)] -> [Value]
    forall a b. (a -> b) -> [a] -> [b]
    map (Name, Value) -> Value
    forall a b. (a, b) -> b
    snd [(Name, Value)]
    fs)
           | Bool
    otherwise           -> Name -> [(Name, Value)] -> Value
    Rec Name
    "?" [(Name, Value)]
    fs

    mkNum :: (Ord a, Num a, Show a) => (String -> Value) -> a -> Value
    mkNum :: forall a. (Ord a, Num a, Show a) => (Name -> Value) -> a -> Value
    mkNum Name -> Value
    c a
    x
      | a
    x a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    >= a
    0    = Name -> Value
    c (a -> Name
    forall a. Show a => a -> Name
    show a
    x)
      | Bool
    otherwise = Value -> Value
    Neg (Name -> Value
    c (a -> Name
    forall a. Show a => a -> Name
    show (a -> a
    forall a. Num a => a -> a
    negate a
    x)))

    instance PrettyVal Int     where prettyVal :: Int -> Value
    prettyVal   = (Name -> Value) -> Int -> Value
    forall a. (Ord a, Num a, Show a) => (Name -> Value) -> a -> Value
    mkNum Name -> Value
    Integer
    instance PrettyVal Integer where prettyVal :: Integer -> Value
    prettyVal   = (Name -> Value) -> Integer -> Value
    forall a. (Ord a, Num a, Show a) => (Name -> Value) -> a -> Value
    mkNum Name -> Value
    Integer
    instance PrettyVal Float   where prettyVal :: Float -> Value
    prettyVal Float
    x = Name -> Value
    Float (Float -> Name
    forall a. Show a => a -> Name
    show Float
    x)
    instance PrettyVal Double  where prettyVal :: Double -> Value
    prettyVal Double
    x = Name -> Value
    Float (Double -> Name
    forall a. Show a => a -> Name
    show Double
    x)

    instance PrettyVal Word8   where prettyVal :: Word8 -> Value
    prettyVal Word8
    x = Name -> Value
    Integer (Word8 -> Name
    forall a. Show a => a -> Name
    show Word8
    x)
    instance PrettyVal Word16  where prettyVal :: Word16 -> Value
    prettyVal Word16
    x = Name -> Value
    Integer (Word16 -> Name
    forall a. Show a => a -> Name
    show Word16
    x)
    instance PrettyVal Word32  where prettyVal :: Word32 -> Value
    prettyVal Word32
    x = Name -> Value
    Integer (Word32 -> Name
    forall a. Show a => a -> Name
    show Word32
    x)
    instance PrettyVal Word64  where prettyVal :: Word64 -> Value
    prettyVal Word64
    x = Name -> Value
    Integer (Word64 -> Name
    forall a. Show a => a -> Name
    show Word64
    x)

    instance PrettyVal Int8    where prettyVal :: Int8 -> Value
    prettyVal   = (Name -> Value) -> Int8 -> Value
    forall a. (Ord a, Num a, Show a) => (Name -> Value) -> a -> Value
    mkNum Name -> Value
    Integer
    instance PrettyVal Int16   where prettyVal :: Int16 -> Value
    prettyVal   = (Name -> Value) -> Int16 -> Value
    forall a. (Ord a, Num a, Show a) => (Name -> Value) -> a -> Value
    mkNum Name -> Value
    Integer
    instance PrettyVal Int32   where prettyVal :: Int32 -> Value
    prettyVal   = (Name -> Value) -> Int32 -> Value
    forall a. (Ord a, Num a, Show a) => (Name -> Value) -> a -> Value
    mkNum Name -> Value
    Integer
    instance PrettyVal Int64   where prettyVal :: Int64 -> Value
    prettyVal   = (Name -> Value) -> Int64 -> Value
    forall a. (Ord a, Num a, Show a) => (Name -> Value) -> a -> Value
    mkNum Name -> Value
    Integer

    instance PrettyVal Char    where
      prettyVal :: Char -> Value
    prettyVal Char
    x    = Name -> Value
    Char (Char -> Name
    forall a. Show a => a -> Name
    show Char
    x)
      listValue :: Name -> Value
    listValue Name
    xs = Name -> Value
    String Name
    xs

    instance PrettyVal a => PrettyVal [a] where
      prettyVal :: [a] -> Value
    prettyVal [a]
    xs   = [a] -> Value
    forall a. PrettyVal a => [a] -> Value
    listValue [a]
    xs

    instance (PrettyVal a, Integral a) => PrettyVal (Ratio a) where
      prettyVal :: Ratio a -> Value
    prettyVal Ratio a
    r = Value -> Value -> Value
    Ratio (a -> Value
    forall a. PrettyVal a => a -> Value
    prettyVal (Ratio a -> a
    forall a. Ratio a -> a
    numerator Ratio a
    r)) (a -> Value
    forall a. PrettyVal a => a -> Value
    prettyVal (Ratio a -> a
    forall a. Ratio a -> a
    denominator Ratio a
    r))

    instance HasResolution p => PrettyVal (Fixed p) where prettyVal :: Fixed p -> Value
    prettyVal Fixed p
    x = Name -> Value
    Float (Fixed p -> Name
    forall a. Show a => a -> Name
    show Fixed p
    x)

    instance (PrettyVal a1, PrettyVal a2) => PrettyVal (a1,a2)
    instance (PrettyVal a1, PrettyVal a2, PrettyVal a3) => PrettyVal (a1,a2,a3)
    instance (PrettyVal a1, PrettyVal a2, PrettyVal a3, PrettyVal a4) =>
      PrettyVal (a1,a2,a3,a4)

    instance (PrettyVal a1, PrettyVal a2, PrettyVal a3,
              PrettyVal a4, PrettyVal a5) => PrettyVal (a1,a2,a3,a4,a5)

    instance (PrettyVal a1, PrettyVal a2, PrettyVal a3,
              PrettyVal a4, PrettyVal a5, PrettyVal a6) =>
      PrettyVal (a1,a2,a3,a4,a5,a6)

    instance (PrettyVal a1, PrettyVal a2, PrettyVal a3,
              PrettyVal a4, PrettyVal a5, PrettyVal a6, PrettyVal a7) =>
      PrettyVal (a1,a2,a3,a4,a5,a6,a7)

    instance PrettyVal Bool
    instance PrettyVal Ordering
    instance PrettyVal a => PrettyVal (Maybe a)
    instance (PrettyVal a, PrettyVal b) => PrettyVal (Either a b)

    instance PrettyVal Text where
      prettyVal :: Text -> Value
    prettyVal = Name -> Value
    String (Name -> Value) -> (Text -> Name) -> Text -> Value
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Name
    Text.unpack