    --------------------------------------------------------------------------------
    -- |
    -- Module      :  Text.Show.Value
    -- Copyright   :  (c) Iavor S. Diatchki 2009
    -- License     :  MIT
    --
    -- Maintainer  :  iavor.diatchki@gmail.com
    -- Stability   :  provisional
    -- Portability :  Haskell 98
    --
    -- Generic representation of Showable values.
    --------------------------------------------------------------------------------

    {-# LANGUAGE Safe #-}
    module Text.Show.Value ( Name, Value(..), hideCon ) where

    import Data.Maybe(fromMaybe,isNothing)

    -- | A name.
    type Name     = String

    -- | Generic Haskell values.
    -- 'NaN' and 'Infinity' are represented as constructors.
    -- The 'String' in the literals is the text for the literals \"as is\".
    --
    -- A chain of infix constructors means that they appeared in the input string
    -- without parentheses, i.e
    --
    -- @1 :+: 2 :*: 3@ is represented with @InfixCons 1 [(":+:",2),(":*:",3)]@, whereas
    --
    -- @1 :+: (2 :*: 3)@ is represented with @InfixCons 1 [(":+:",InfixCons 2 [(":*:",3)])]@.
    data Value    = Con Name [Value]               -- ^ Data constructor
                  | InfixCons Value [(Name,Value)] -- ^ Infix data constructor chain
                  | Rec Name [ (Name,Value) ]      -- ^ Record value
                  | Tuple [Value]                  -- ^ Tuple
                  | List [Value]                   -- ^ List
                  | Neg Value                      -- ^ Negated value
                  | Ratio Value Value              -- ^ Rational
                  | Integer String                 -- ^ Non-negative integer
                  | Float String                   -- ^ Non-negative floating num.
                  | Char String                    -- ^ Character
                  | String String                  -- ^ String
                  | Date String                    -- ^ 01-02-2003
                  | Time String                    -- ^ 08:30:21
                  | Quote String                   -- ^ [time|2003-02-01T08:30:21Z|]
                    deriving (Value -> Value -> Bool
    (Value -> Value -> Bool) -> (Value -> Value -> Bool) -> Eq Value
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Value -> Value -> Bool
    == :: Value -> Value -> Bool
    $c/= :: Value -> Value -> Bool
    /= :: Value -> Value -> Bool
    Eq,Int -> Value -> ShowS
    [Value] -> ShowS
    Value -> Name
    (Int -> Value -> ShowS)
    -> (Value -> Name) -> ([Value] -> ShowS) -> Show Value
    forall a.
    (Int -> a -> ShowS) -> (a -> Name) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Value -> ShowS
    showsPrec :: Int -> Value -> ShowS
    $cshow :: Value -> Name
    show :: Value -> Name
    $cshowList :: [Value] -> ShowS
    showList :: [Value] -> ShowS
    Show)

    {- | Hide constrcutros matching the given predicate.
    If the hidden value is in a record, we also hide
    the corresponding record field.

    If the boolean flag is true, then we also hide
    constructors all of whose fields were hidden. -}
    hideCon :: Bool -> (Name -> Bool) -> Value -> Value
    hideCon :: Bool -> (Name -> Bool) -> Value -> Value
    hideCon Bool
    collapse Name -> Bool
    hidden = Maybe Value -> Value
    toVal (Maybe Value -> Value) -> (Value -> Maybe Value) -> Value -> Value
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Value -> Maybe Value
    delMaybe
      where
      hiddenV :: Value
    hiddenV = Name -> [Value] -> Value
    Con Name
    "_" []

      toVal :: Maybe Value -> Value
    toVal = Value -> Maybe Value -> Value
    forall a. a -> Maybe a -> a
    fromMaybe Value
    hiddenV

      delMany :: [Value] -> Maybe [Value]
    delMany [Value]
    vals
        | Bool
    collapse Bool -> Bool -> Bool
    && (Maybe Value -> Bool) -> [Maybe Value] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Maybe Value -> Bool
    forall a. Maybe a -> Bool
    isNothing [Maybe Value]
    newVals = Maybe [Value]
    forall a. Maybe a
    Nothing
        | Bool
    otherwise                         = [Value] -> Maybe [Value]
    forall a. a -> Maybe a
    Just ((Maybe Value -> Value) -> [Maybe Value] -> [Value]
    forall a b. (a -> b) -> [a] -> [b]
    map Maybe Value -> Value
    toVal [Maybe Value]
    newVals)
        where
        newVals :: [Maybe Value]
    newVals = (Value -> Maybe Value) -> [Value] -> [Maybe Value]
    forall a b. (a -> b) -> [a] -> [b]
    map Value -> Maybe Value
    delMaybe [Value]
    vals

      delMaybe :: Value -> Maybe Value
    delMaybe Value
    val =
        case Value
    val of
          Con Name
    x [Value]
    vs
            | Name -> Bool
    hidden Name
    x  -> Maybe Value
    forall a. Maybe a
    Nothing
            | [Value] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Value]
    vs   -> Value -> Maybe Value
    forall a. a -> Maybe a
    Just Value
    val
            | Bool
    otherwise -> Name -> [Value] -> Value
    Con Name
    x ([Value] -> Value) -> Maybe [Value] -> Maybe Value
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` [Value] -> Maybe [Value]
    delMany [Value]
    vs

          Rec Name
    x [(Name, Value)]
    fs
            | Name -> Bool
    hidden Name
    x  -> Maybe Value
    forall a. Maybe a
    Nothing
            | [(Name, Value)] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [(Name, Value)]
    fs   -> Value -> Maybe Value
    forall a. a -> Maybe a
    Just Value
    val
            | Bool
    collapse Bool -> Bool -> Bool
    && (Maybe Value -> Bool) -> [Maybe Value] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Maybe Value -> Bool
    forall a. Maybe a -> Bool
    isNothing [Maybe Value]
    mbs -> Maybe Value
    forall a. Maybe a
    Nothing
            | Bool
    otherwise -> Value -> Maybe Value
    forall a. a -> Maybe a
    Just (Name -> [(Name, Value)] -> Value
    Rec Name
    x [ (Name
    f,Value
    v) | (Name
    f,Just Value
    v) <- [Name] -> [Maybe Value] -> [(Name, Maybe Value)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Name]
    ls [Maybe Value]
    mbs ])
            where ([Name]
    ls,[Value]
    vs) = [(Name, Value)] -> ([Name], [Value])
    forall a b. [(a, b)] -> ([a], [b])
    unzip [(Name, Value)]
    fs
                  mbs :: [Maybe Value]
    mbs     = (Value -> Maybe Value) -> [Value] -> [Maybe Value]
    forall a b. (a -> b) -> [a] -> [b]
    map Value -> Maybe Value
    delMaybe [Value]
    vs

          InfixCons Value
    v [(Name, Value)]
    ys
            | (Name -> Bool) -> [Name] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any Name -> Bool
    hidden [Name]
    cs -> Maybe Value
    forall a. Maybe a
    Nothing
            | Bool
    otherwise -> do ~(Value
    v1:[Value]
    vs1) <- [Value] -> Maybe [Value]
    delMany (Value
    vValue -> [Value] -> [Value]
    forall a. a -> [a] -> [a]
    :[Value]
    vs)
                              Value -> Maybe Value
    forall a. a -> Maybe a
    Just (Value -> [(Name, Value)] -> Value
    InfixCons Value
    v1 ([Name] -> [Value] -> [(Name, Value)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Name]
    cs [Value]
    vs1))
              where ([Name]
    cs,[Value]
    vs) = [(Name, Value)] -> ([Name], [Value])
    forall a b. [(a, b)] -> ([a], [b])
    unzip [(Name, Value)]
    ys

          Tuple [Value]
    vs | [Value] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Value]
    vs   -> Value -> Maybe Value
    forall a. a -> Maybe a
    Just Value
    val
                   | Bool
    otherwise -> [Value] -> Value
    Tuple ([Value] -> Value) -> Maybe [Value] -> Maybe Value
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` [Value] -> Maybe [Value]
    delMany [Value]
    vs
          List [Value]
    vs  | [Value] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Value]
    vs -> Value -> Maybe Value
    forall a. a -> Maybe a
    Just Value
    val
                   | Bool
    otherwise -> [Value] -> Value
    List ([Value] -> Value) -> Maybe [Value] -> Maybe Value
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` [Value] -> Maybe [Value]
    delMany [Value]
    vs
          Neg Value
    v       -> Value -> Value
    Neg (Value -> Value) -> Maybe Value -> Maybe Value
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` Value -> Maybe Value
    delMaybe Value
    v
          Ratio Value
    v1 Value
    v2 -> do ~[Value
    a,Value
    b] <- [Value] -> Maybe [Value]
    delMany [Value
    v1,Value
    v2]
                            Value -> Maybe Value
    forall a. a -> Maybe a
    Just (Value -> Value -> Value
    Ratio Value
    a Value
    b)
          Integer {}  -> Value -> Maybe Value
    forall a. a -> Maybe a
    Just Value
    val
          Float {}    -> Value -> Maybe Value
    forall a. a -> Maybe a
    Just Value
    val
          Char {}     -> Value -> Maybe Value
    forall a. a -> Maybe a
    Just Value
    val
          String {}   -> Value -> Maybe Value
    forall a. a -> Maybe a
    Just Value
    val
          Date {}     -> Value -> Maybe Value
    forall a. a -> Maybe a
    Just Value
    val
          Time {}     -> Value -> Maybe Value
    forall a. a -> Maybe a
    Just Value
    val
          Quote {}    -> Value -> Maybe Value
    forall a. a -> Maybe a
    Just Value
    val