{-# LANGUAGE Strict #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

-- | This module provides an efficient value representation as well as
-- parsing and comparison functions.
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 = forall a ann. Pretty a => a -> Doc ann
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Text
valueText

instance Pretty ValueType where
  pretty :: forall ann. ValueType -> Doc ann
pretty = forall a ann. Pretty a => a -> Doc ann
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueType -> Text
valueTypeText

-- | The structure of a compound value, parameterised over the actual
-- values.  For most cases you probably want 'CompoundValue'.
data Compound v
  = ValueRecord (M.Map T.Text (Compound v))
  | -- | Must not be single value.
    ValueTuple [Compound v]
  | ValueAtom v
  deriving (Compound v -> Compound v -> Bool
forall v. Eq v => Compound v -> Compound v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Compound v -> Compound v -> Bool
$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
Eq, Compound v -> Compound v -> Bool
Compound v -> Compound v -> Ordering
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
min :: Compound v -> Compound v -> Compound v
$cmin :: forall v. Ord v => Compound v -> Compound v -> Compound v
max :: Compound v -> Compound v -> Compound v
$cmax :: forall v. Ord v => Compound v -> Compound v -> Compound v
>= :: 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
$c< :: forall v. Ord v => Compound v -> Compound v -> Bool
compare :: Compound v -> Compound v -> Ordering
$ccompare :: forall v. Ord v => Compound v -> Compound v -> Ordering
Ord, Int -> Compound v -> ShowS
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
showList :: [Compound v] -> ShowS
$cshowList :: forall v. Show v => [Compound v] -> ShowS
show :: Compound v -> String
$cshow :: forall v. Show v => Compound v -> String
showsPrec :: Int -> Compound v -> ShowS
$cshowsPrec :: forall v. Show v => Int -> Compound v -> ShowS
Show)

instance Functor Compound where
  fmap :: forall a b. (a -> b) -> Compound a -> Compound b
fmap = 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 = 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) = forall v. v -> Compound v
ValueAtom 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) = forall v. [Compound v] -> Compound v
ValueTuple forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f) [Compound a]
vs
  traverse a -> f b
f (ValueRecord Map Text (Compound a)
m) = forall v. Map Text (Compound v) -> Compound v
ValueRecord forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t 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) = forall a ann. Pretty a => a -> Doc ann
pretty v
v
  pretty (ValueTuple [Compound v]
vs) = forall ann. Doc ann -> Doc ann
parens forall a b. (a -> b) -> a -> b
$ forall a. [Doc a] -> Doc a
commasep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [Compound v]
vs
  pretty (ValueRecord Map Text (Compound v)
m) = forall ann. Doc ann -> Doc ann
braces forall a b. (a -> b) -> a -> b
$ forall a. [Doc a] -> Doc a
commasep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {a} {a} {ann}. (Pretty a, Pretty a) => (a, a) -> Doc ann
field forall a b. (a -> b) -> a -> b
$ 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) = forall a ann. Pretty a => a -> Doc ann
pretty a
k forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
equals forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty a
v

-- | Create a tuple for a non-unit list, and otherwise a 'ValueAtom'
mkCompound :: [Compound v] -> Compound v
mkCompound :: forall v. [Compound v] -> Compound v
mkCompound [Compound v
v] = Compound v
v
mkCompound [Compound v]
vs = forall v. [Compound v] -> Compound v
ValueTuple [Compound v]
vs

-- | If the value is a tuple, extract the components, otherwise return
-- a singleton list of the value.
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]

-- | Like a 'Value', but also grouped in compound ways that are not
-- supported by raw values.  You cannot parse or read these in
-- standard ways, and they cannot be elements of arrays.
type CompoundValue = Compound Value