{-|
Module      : Atom
Description : temporal values
Copyright   : (c) David Janin, Simon Archipoff, 2016
License     : see the LICENSE file in the distribution
Maintainer  : janin@labri.fr
Stability   : experimental

An embedding of an arbitrary type into a the type of temporal values of that type

-}

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

{-# LANGUAGE MultiParamTypeClasses,
             FlexibleInstances #-}


module Tile.Atom where

import Tile.Tilable
import Reactive.Updatable
    
-- * temporal values

data Atom d iv v = Atom d v
       deriving (Show, Eq)

-- | On-the fly updates of atoms                     
instance Updatable (Atom d iv v) d iv where
  update (f,_) (Atom d v) = Atom (f d) v



--------------------------------------------------------------------
-- * Setters
--------------------------------------------------------------------

-- | Builds an atom from a value (with default duration 1)
fromValueA :: Tilable d v => v -> Atom d iv v
fromValueA v = Atom (duration v) v

-- | Sets the duration of the atoms to the specified duration
setDurA :: d -> Atom t t1 v -> Atom d iv v
setDurA d (Atom _ v) = Atom d v

-- | Stretches the atom by a given factor
stretchA :: Num d =>
                  d -> Atom d iv v -> Atom d iv v
stretchA df (Atom d v) = Atom (df*d) v

--------------------------------------------------------------------
-- * Getters
--------------------------------------------------------------------

-- | Gets the value of an atom
getValueA :: Atom d iv v -> v
getValueA (Atom _ v) = v

-- | Gets the duration of an atom
getDurA :: Atom d iv v -> d
getDurA (Atom d _) = d

-- | Gets both the duration and the value of an atom
getAllA :: Atom d iv v -> (d,v)
getAllA (Atom d v) = (d,v)

--------------------------------------------------------------------
-- * Functor like functions
--------------------------------------------------------------------


-- | Changing value
fmapA :: (v1 -> v2) -> Atom d iv v1 -> Atom d iv v2
fmapA f (Atom d v) = Atom d (f v)

-- | Changing duration
fmapDA :: (d1 -> d2) -> Atom d1 iv v -> Atom d2 iv v
fmapDA f (Atom d v) = Atom (f d) v


-- | Derived 'natural' partial order.
instance (Eq d, POrd v) => POrd (Atom d iv v) where
    partialCompare (Atom d1 v1) (Atom d2 v2)
        = case (d1 == d2, partialCompare v1 v2) of
            (True, r) -> r
            _ -> Nothing

instance  (Eq d, POrd v) => POrd [Atom d iv v] where
     pLeq = pMinLeq where
        pMinLeq ::  (POrd a) => [a] -> [a] -> Bool
        -- pMinLeq m1 m2 is True when every element of m2 is greater than
        -- or equal to an element of m1, it is False otherwise
        pMinLeq _ [] = True
        pMinLeq m (y:ys)
            = case (covered m y) of
                True -> pMinLeq m ys
                False -> False
        covered :: (POrd a) => [a] -> a -> Bool
        -- covered m y equals True when one element of m is smaller than or equal to y,
        -- it is False otherwise
        covered [] _  = False
        covered (x:xs) y 
            = case (partialCompare x y)  of 
                Just LT -> True
                Just EQ -> True
                _ -> covered xs y