{-# LANGUAGE Safe #-}
module Text.Show.Value ( Name, Value(..), hideCon ) where
import Data.Maybe(fromMaybe,isNothing)
type Name = String
data Value = Con Name [Value]
| InfixCons Value [(Name,Value)]
| Rec Name [ (Name,Value) ]
| Tuple [Value]
| List [Value]
| Neg Value
| Ratio Value Value
| Integer String
| Float String
| Char String
| String String
| Date String
| Time String
| Quote String
deriving (Value -> Value -> Bool
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 -> Name
forall a.
(Int -> a -> ShowS) -> (a -> Name) -> ([a] -> ShowS) -> Show a
showList :: [Value] -> ShowS
$cshowList :: [Value] -> ShowS
show :: Value -> Name
$cshow :: Value -> Name
showsPrec :: Int -> Value -> ShowS
$cshowsPrec :: Int -> Value -> ShowS
Show)
hideCon :: Bool -> (Name -> Bool) -> Value -> Value
hideCon :: Bool -> (Name -> Bool) -> Value -> Value
hideCon Bool
collapse Name -> Bool
hidden = Maybe Value -> Value
toVal 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 = forall a. a -> Maybe a -> a
fromMaybe Value
hiddenV
delMany :: [Value] -> Maybe [Value]
delMany [Value]
vals
| Bool
collapse Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all forall a. Maybe a -> Bool
isNothing [Maybe Value]
newVals = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just (forall a b. (a -> b) -> [a] -> [b]
map Maybe Value -> Value
toVal [Maybe Value]
newVals)
where
newVals :: [Maybe Value]
newVals = 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 -> forall a. Maybe a
Nothing
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Value]
vs -> forall a. a -> Maybe a
Just Value
val
| Bool
otherwise -> Name -> [Value] -> Value
Con Name
x 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 -> forall a. Maybe a
Nothing
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Name, Value)]
fs -> forall a. a -> Maybe a
Just Value
val
| Bool
collapse Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all forall a. Maybe a -> Bool
isNothing [Maybe Value]
mbs -> forall a. Maybe a
Nothing
| Bool
otherwise -> forall a. a -> Maybe a
Just (Name -> [(Name, Value)] -> Value
Rec Name
x [ (Name
f,Value
v) | (Name
f,Just Value
v) <- forall a b. [a] -> [b] -> [(a, b)]
zip [Name]
ls [Maybe Value]
mbs ])
where ([Name]
ls,[Value]
vs) = forall a b. [(a, b)] -> ([a], [b])
unzip [(Name, Value)]
fs
mbs :: [Maybe Value]
mbs = forall a b. (a -> b) -> [a] -> [b]
map Value -> Maybe Value
delMaybe [Value]
vs
InfixCons Value
v [(Name, Value)]
ys
| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Name -> Bool
hidden [Name]
cs -> forall a. Maybe a
Nothing
| Bool
otherwise -> do ~(Value
v1:[Value]
vs1) <- [Value] -> Maybe [Value]
delMany (Value
vforall a. a -> [a] -> [a]
:[Value]
vs)
forall a. a -> Maybe a
Just (Value -> [(Name, Value)] -> Value
InfixCons Value
v1 (forall a b. [a] -> [b] -> [(a, b)]
zip [Name]
cs [Value]
vs1))
where ([Name]
cs,[Value]
vs) = forall a b. [(a, b)] -> ([a], [b])
unzip [(Name, Value)]
ys
Tuple [Value]
vs | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Value]
vs -> forall a. a -> Maybe a
Just Value
val
| Bool
otherwise -> [Value] -> Value
Tuple forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` [Value] -> Maybe [Value]
delMany [Value]
vs
List [Value]
vs | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Value]
vs -> forall a. a -> Maybe a
Just Value
val
| Bool
otherwise -> [Value] -> Value
List 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 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]
forall a. a -> Maybe a
Just (Value -> Value -> Value
Ratio Value
a Value
b)
Integer {} -> forall a. a -> Maybe a
Just Value
val
Float {} -> forall a. a -> Maybe a
Just Value
val
Char {} -> forall a. a -> Maybe a
Just Value
val
String {} -> forall a. a -> Maybe a
Just Value
val
Date {} -> forall a. a -> Maybe a
Just Value
val
Time {} -> forall a. a -> Maybe a
Just Value
val
Quote {} -> forall a. a -> Maybe a
Just Value
val