--------------------------------------------------------------------------------
-- |
-- 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
/= :: Value -> Value -> Bool
$c/= :: Value -> Value -> Bool
== :: Value -> Value -> Bool
$c== :: Value -> Value -> Bool
Eq,Int -> Value -> ShowS
[Value] -> ShowS
Value -> String
(Int -> Value -> ShowS)
-> (Value -> String) -> ([Value] -> ShowS) -> Show Value
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Value] -> ShowS
$cshowList :: [Value] -> ShowS
show :: Value -> String
$cshow :: Value -> String
showsPrec :: Int -> Value -> ShowS
$cshowsPrec :: Int -> 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 -> (String -> Bool) -> Value -> Value
hideCon Bool
collapse String -> 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 = String -> [Value] -> Value
Con String
"_" []

  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 String
x [Value]
vs
        | String -> Bool
hidden String
x  -> Maybe Value
forall a. Maybe a
Nothing
        | [Value] -> 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 -> String -> [Value] -> Value
Con String
x ([Value] -> Value) -> Maybe [Value] -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` [Value] -> Maybe [Value]
delMany [Value]
vs

      Rec String
x [(String, Value)]
fs
        | String -> Bool
hidden String
x  -> Maybe Value
forall a. Maybe a
Nothing
        | [(String, Value)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, 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 (String -> [(String, Value)] -> Value
Rec String
x [ (String
f,Value
v) | (String
f,Just Value
v) <- [String] -> [Maybe Value] -> [(String, Maybe Value)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
ls [Maybe Value]
mbs ])
        where ([String]
ls,[Value]
vs) = [(String, Value)] -> ([String], [Value])
forall a b. [(a, b)] -> ([a], [b])
unzip [(String, 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 [(String, Value)]
ys
        | (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any String -> Bool
hidden [String]
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 -> [(String, Value)] -> Value
InfixCons Value
v1 ([String] -> [Value] -> [(String, Value)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
cs [Value]
vs1))
          where ([String]
cs,[Value]
vs) = [(String, Value)] -> ([String], [Value])
forall a b. [(a, b)] -> ([a], [b])
unzip [(String, Value)]
ys

      Tuple [Value]
vs | [Value] -> 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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` [Value] -> Maybe [Value]
delMany [Value]
vs
      List [Value]
vs  | [Value] -> 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 (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 (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