{-|
Module      : Tilable
Description : Describe elementary functions needed to tile a value type
Copyright   : (c) David Janin, Simon Archipoff, 2016
License     : see the LICENSE file in the distribution
Maintainer  : janin@labri.fr
Stability   : experimental

The type class Tilable allows to embed value types with non trivial duration 
into tiles in a much more efficient and uniform way.

-}

{-# OPTIONS_GHC -Wall -fno-warn-name-shadowing #-}

{-# LANGUAGE MultiParamTypeClasses,
             FlexibleInstances,
             TypeFamilies
             #-}

module Tile.Tilable (Tilable (..), module Duration.Lattice) where

import Duration.Lattice

-- | Class Tilable that group some properties (and default behaviors) we want
-- for values to be in tiles.
--
-- The following property should be statisfied:
-- prop> duration (stretch d a) = d*(duration a)
class (Eq d,Num d, Lattice d) => Tilable d a where
    duration :: a -> d
    duration = const 1
    stretch :: d -> a -> a
    stretch _ = id

instance (Eq d, Num d, Lattice d) => Tilable d Integer
instance (Eq d, Num d, Lattice d) => Tilable d Rational
instance (Eq d, Num d, Lattice d) => Tilable d Int
instance (Eq d, Num d, Lattice d) => Tilable d Char
instance (Eq d, Num d, Lattice d) => Tilable d ()

-- | Functions have default duration +infty (top)
instance (Eq d, Num d, Lattice d) => (Tilable d (v1 -> v2)) where
    duration _ = top
                 
instance  (Tilable d a,Tilable d b) => (Tilable d (Either a b)) where
    duration (Left a) = duration a
    duration (Right b) = duration b
    stretch d (Left a) = Left $ stretch d a
    stretch d (Right b) = Right $ stretch d b
                         

instance  (Tilable d a,Tilable d b) => (Tilable d (a,b)) where
    duration (a,b) = duration a + duration b
    stretch d (a,b) = (stretch d a, stretch d b)

instance  (Tilable d a) => (Tilable d [a]) where
    duration = foldr (\a d -> duration a +d) 0
        -- getListDuration where
        -- getListDuration [] = 0
        -- getListDuration (x:xs) = duration x + getListDuration xs
    stretch d l = map (stretch d) l