{-# LANGUAGE Strict #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Futhark.Test.Values
( module Futhark.Data,
module Futhark.Data.Compare,
module Futhark.Data.Reader,
Compound (..),
CompoundValue,
mkCompound,
unCompound,
)
where
import Data.Map qualified as M
import Data.Text qualified as T
import Data.Traversable
import Futhark.Data
import Futhark.Data.Compare
import Futhark.Data.Reader
import Futhark.Util.Pretty
instance Pretty Value where
pretty :: forall ann. Value -> Doc ann
pretty = Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Text -> Doc ann) -> (Value -> Text) -> Value -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Text
valueText
instance Pretty ValueType where
pretty :: forall ann. ValueType -> Doc ann
pretty = Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Text -> Doc ann) -> (ValueType -> Text) -> ValueType -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueType -> Text
valueTypeText
data Compound v
= ValueRecord (M.Map T.Text (Compound v))
|
ValueTuple [Compound v]
| ValueAtom v
deriving (Compound v -> Compound v -> Bool
(Compound v -> Compound v -> Bool)
-> (Compound v -> Compound v -> Bool) -> Eq (Compound v)
forall v. Eq v => Compound v -> Compound v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall v. Eq v => Compound v -> Compound v -> Bool
== :: Compound v -> Compound v -> Bool
$c/= :: forall v. Eq v => Compound v -> Compound v -> Bool
/= :: Compound v -> Compound v -> Bool
Eq, Eq (Compound v)
Eq (Compound v)
-> (Compound v -> Compound v -> Ordering)
-> (Compound v -> Compound v -> Bool)
-> (Compound v -> Compound v -> Bool)
-> (Compound v -> Compound v -> Bool)
-> (Compound v -> Compound v -> Bool)
-> (Compound v -> Compound v -> Compound v)
-> (Compound v -> Compound v -> Compound v)
-> Ord (Compound v)
Compound v -> Compound v -> Bool
Compound v -> Compound v -> Ordering
Compound v -> Compound v -> Compound v
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {v}. Ord v => Eq (Compound v)
forall v. Ord v => Compound v -> Compound v -> Bool
forall v. Ord v => Compound v -> Compound v -> Ordering
forall v. Ord v => Compound v -> Compound v -> Compound v
$ccompare :: forall v. Ord v => Compound v -> Compound v -> Ordering
compare :: Compound v -> Compound v -> Ordering
$c< :: forall v. Ord v => Compound v -> Compound v -> Bool
< :: Compound v -> Compound v -> Bool
$c<= :: forall v. Ord v => Compound v -> Compound v -> Bool
<= :: Compound v -> Compound v -> Bool
$c> :: forall v. Ord v => Compound v -> Compound v -> Bool
> :: Compound v -> Compound v -> Bool
$c>= :: forall v. Ord v => Compound v -> Compound v -> Bool
>= :: Compound v -> Compound v -> Bool
$cmax :: forall v. Ord v => Compound v -> Compound v -> Compound v
max :: Compound v -> Compound v -> Compound v
$cmin :: forall v. Ord v => Compound v -> Compound v -> Compound v
min :: Compound v -> Compound v -> Compound v
Ord, Int -> Compound v -> ShowS
[Compound v] -> ShowS
Compound v -> String
(Int -> Compound v -> ShowS)
-> (Compound v -> String)
-> ([Compound v] -> ShowS)
-> Show (Compound v)
forall v. Show v => Int -> Compound v -> ShowS
forall v. Show v => [Compound v] -> ShowS
forall v. Show v => Compound v -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall v. Show v => Int -> Compound v -> ShowS
showsPrec :: Int -> Compound v -> ShowS
$cshow :: forall v. Show v => Compound v -> String
show :: Compound v -> String
$cshowList :: forall v. Show v => [Compound v] -> ShowS
showList :: [Compound v] -> ShowS
Show)
instance Functor Compound where
fmap :: forall a b. (a -> b) -> Compound a -> Compound b
fmap = (a -> b) -> Compound a -> Compound b
forall (t :: * -> *) a b. Traversable t => (a -> b) -> t a -> t b
fmapDefault
instance Foldable Compound where
foldMap :: forall m a. Monoid m => (a -> m) -> Compound a -> m
foldMap = (a -> m) -> Compound a -> m
forall (t :: * -> *) m a.
(Traversable t, Monoid m) =>
(a -> m) -> t a -> m
foldMapDefault
instance Traversable Compound where
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Compound a -> f (Compound b)
traverse a -> f b
f (ValueAtom a
v) = b -> Compound b
forall v. v -> Compound v
ValueAtom (b -> Compound b) -> f b -> f (Compound b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
v
traverse a -> f b
f (ValueTuple [Compound a]
vs) = [Compound b] -> Compound b
forall v. [Compound v] -> Compound v
ValueTuple ([Compound b] -> Compound b) -> f [Compound b] -> f (Compound b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Compound a -> f (Compound b)) -> [Compound a] -> f [Compound b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((a -> f b) -> Compound a -> f (Compound b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Compound a -> f (Compound b)
traverse a -> f b
f) [Compound a]
vs
traverse a -> f b
f (ValueRecord Map Text (Compound a)
m) = Map Text (Compound b) -> Compound b
forall v. Map Text (Compound v) -> Compound v
ValueRecord (Map Text (Compound b) -> Compound b)
-> f (Map Text (Compound b)) -> f (Compound b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Compound a -> f (Compound b))
-> Map Text (Compound a) -> f (Map Text (Compound b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Map Text a -> f (Map Text b)
traverse ((a -> f b) -> Compound a -> f (Compound b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Compound a -> f (Compound b)
traverse a -> f b
f) Map Text (Compound a)
m
instance (Pretty v) => Pretty (Compound v) where
pretty :: forall ann. Compound v -> Doc ann
pretty (ValueAtom v
v) = v -> Doc ann
forall ann. v -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty v
v
pretty (ValueTuple [Compound v]
vs) = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ [Doc ann] -> Doc ann
forall a. [Doc a] -> Doc a
commasep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ (Compound v -> Doc ann) -> [Compound v] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Compound v -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Compound v -> Doc ann
pretty [Compound v]
vs
pretty (ValueRecord Map Text (Compound v)
m) = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
braces (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ [Doc ann] -> Doc ann
forall a. [Doc a] -> Doc a
commasep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ ((Text, Compound v) -> Doc ann)
-> [(Text, Compound v)] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Compound v) -> Doc ann
forall {a} {a} {ann}. (Pretty a, Pretty a) => (a, a) -> Doc ann
field ([(Text, Compound v)] -> [Doc ann])
-> [(Text, Compound v)] -> [Doc ann]
forall a b. (a -> b) -> a -> b
$ Map Text (Compound v) -> [(Text, Compound v)]
forall k a. Map k a -> [(k, a)]
M.toList Map Text (Compound v)
m
where
field :: (a, a) -> Doc ann
field (a
k, a
v) = a -> Doc ann
forall ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
k Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
equals Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> a -> Doc ann
forall ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
v
mkCompound :: [Compound v] -> Compound v
mkCompound :: forall v. [Compound v] -> Compound v
mkCompound [Compound v
v] = Compound v
v
mkCompound [Compound v]
vs = [Compound v] -> Compound v
forall v. [Compound v] -> Compound v
ValueTuple [Compound v]
vs
unCompound :: Compound v -> [Compound v]
unCompound :: forall v. Compound v -> [Compound v]
unCompound (ValueTuple [Compound v]
vs) = [Compound v]
vs
unCompound Compound v
v = [Compound v
v]
type CompoundValue = Compound Value