{-# LANGUAGE TypeOperators, TypeFamilies, FlexibleContexts, CPP #-}
module NoSlow.Util.Computation (
  DeepSeq(..), TestData(..), Computation(..),

  Nil(..), (:>)(..)
) where

import NoSlow.Util.Base ( Len(..) )

class DeepSeq a where
  deepSeq :: a -> b -> b
  deepSeq = seq

instance DeepSeq Len
instance DeepSeq Int
instance DeepSeq Float
instance DeepSeq Double

instance DeepSeq a => DeepSeq [a] where
  deepSeq xs b = foldr deepSeq b xs

class DeepSeq a => TestData a where
  testData :: Int -> a
  testList :: Int -> [a]

  testList n = replicate n (testData n)

instance TestData Len where
  testData n = Len n

instance TestData Int where
  testData _ = 1
  testList n = [1..n]

instance TestData Float where
  testData _ = 1
  testList n = [1..fromIntegral n]

instance TestData Double where
  testData _ = 1
  testList n = [1..fromIntegral n]

instance TestData a => TestData [a] where
  testData = testList

data x :> xs = x :> xs
data Nil = Nil

instance DeepSeq Nil where
  deepSeq Nil x = x

instance TestData Nil where
  testData _ = Nil

instance (DeepSeq x, DeepSeq xs) => DeepSeq (x :> xs) where
  deepSeq (x :> xs) y = deepSeq x $ deepSeq xs y

instance (TestData x, TestData xs) => TestData (x :> xs) where
  testData n = testData n :> testData n

class (TestData (Arg a), DeepSeq (Res a)) => Computation a where
  type Arg a
  type Res a

  apply :: a -> Arg a -> Res a

#define ComputationResult(ty) \
instance Computation (ty) where { \
  type Arg (ty) = Nil       \
; type Res (ty) = ty        \
; apply x _ = x             }

ComputationResult(Len)
ComputationResult(Int)
ComputationResult(Float)
ComputationResult(Double)

instance DeepSeq a => Computation [a] where
  type Arg [a] = Nil
  type Res [a] = [a]
  apply x _ = x

instance (TestData a, Computation b) => Computation (a -> b) where
  type Arg (a -> b) = a :> Arg b
  type Res (a -> b) = Res b

  apply f (x :> xs) = apply (f x) xs