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

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