{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE Strict #-}
{-# LANGUAGE Trustworthy #-}
{-# 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 qualified Data.Map as M
import qualified Data.Text as T
import Data.Traversable
import Futhark.Data
import Futhark.Data.Compare
import Futhark.Data.Reader
import Futhark.Util.Pretty

instance Pretty Value where
  ppr :: Value -> Doc
ppr = Text -> Doc
strictText (Text -> Doc) -> (Value -> Text) -> Value -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Text
valueText

instance Pretty ValueType where
  ppr :: ValueType -> Doc
ppr = Text -> Doc
strictText (Text -> Doc) -> (ValueType -> Text) -> ValueType -> Doc
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
(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
/= :: 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, 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
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
$cp1Ord :: forall v. Ord v => Eq (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
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 :: (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 :: (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 :: (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)
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)
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)
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)
traverse a -> f b
f) Map Text (Compound a)
m

instance Pretty v => Pretty (Compound v) where
  ppr :: Compound v -> Doc
ppr (ValueAtom v
v) = v -> Doc
forall a. Pretty a => a -> Doc
ppr v
v
  ppr (ValueTuple [Compound v]
vs) = Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
commasep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Compound v -> Doc) -> [Compound v] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Compound v -> Doc
forall a. Pretty a => a -> Doc
ppr [Compound v]
vs
  ppr (ValueRecord Map Text (Compound v)
m) = Doc -> Doc
braces (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
commasep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ ((Text, Compound v) -> Doc) -> [(Text, Compound v)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Compound v) -> Doc
forall a a. (Pretty a, Pretty a) => (a, a) -> Doc
field ([(Text, Compound v)] -> [Doc]) -> [(Text, Compound v)] -> [Doc]
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
field (a
k, a
v) = a -> Doc
forall a. Pretty a => a -> Doc
ppr a
k Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
equals Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> a -> Doc
forall a. Pretty a => a -> Doc
ppr a
v

-- | Create a tuple for a non-unit list, and otherwise a 'ValueAtom'
mkCompound :: [Compound v] -> Compound v
mkCompound :: [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

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