-----------------------------------------------------------------------------
-- |
-- Module  :  ForSyDe.Shallow.Core.Signal
-- Copyright   :  (c) ForSyDe Group, KTH 2007-2008
-- License     :  BSD-style (see the file LICENSE)
-- 
-- Maintainer  :  forsyde-dev@ict.kth.se
-- Stability   :  experimental
-- Portability :  portable
--
-- This module defines the shallow-embedded 'Signal' datatype and
-- functions operating on it.
-----------------------------------------------------------------------------
module ForSyDe.Shallow.Core.Signal(
  Signal (NullS, (:-)), (-:), (+-+), (!-), 
  signal, fromSignal,
  unitS, nullS, headS, tailS, atS, takeS, dropS,
  lengthS, infiniteS, copyS, selectS, writeS, readS, fanS,
  foldrS, allS
  ) where

infixr 5    :-
infixr 5    -:
infixr 5    +-+
infixr 5    !-


-- | A signal is defined as a list of events. An event has a tag and a value. The tag of an event is defined by the position in the list. A signal is defined as an instance of the classes 'Read' and 'Show'. The signal 1 :- 2 :- NullS is represented as \{1,2\}.
data Signal a = NullS
      | a :- Signal a deriving (Signal a -> Signal a -> Bool
(Signal a -> Signal a -> Bool)
-> (Signal a -> Signal a -> Bool) -> Eq (Signal a)
forall a. Eq a => Signal a -> Signal a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Signal a -> Signal a -> Bool
$c/= :: forall a. Eq a => Signal a -> Signal a -> Bool
== :: Signal a -> Signal a -> Bool
$c== :: forall a. Eq a => Signal a -> Signal a -> Bool
Eq)

-- | The function 'signal' converts a list into a signal.
signal     :: [a] -> Signal a 

-- | The function 'fromSignal' converts a signal into a list.
fromSignal     :: Signal a -> [a]

-- | The function 'unitS' creates a signal with one value.
unitS      :: a -> Signal a

-- | The function 'nullS' checks if a signal is empty.
nullS      :: Signal a -> Bool

-- | The function 'headS' gives the first value - the head -  of a signal.
headS      :: Signal a -> a

-- | The function 'tailS' gives the rest of the signal - the tail.
tailS      :: Signal a -> Signal a

-- | The function 'atS'  returns the n-th event in a signal. The numbering of events in a signal starts with 0. There is also an operator version of this function, '(!-)'.
atS        :: Int -> Signal a -> a

-- | The function 'takeS' returns the first n values of a signal.
takeS      :: Int -> Signal a -> Signal a

-- | The function 'dropS' drops the first $n$ values from a signal.
dropS      :: Int -> Signal a -> Signal a

-- | The function 'selectS' takes three parameters, an offset, a stepsize and a signal and returns some elements of the signal such as in the following example:
--
-- @
-- Signal> selectS 2 3 (signal[1,2,3,4,5,6,7,8,9,10])
-- {3,6,9} :: Signal Integer
-- @
selectS        :: Int -> Int -> Signal a -> Signal a

-- | The function 'lengthS' returns the length of a 'finite' signal.
lengthS        :: Signal b -> Int

-- | The function 'infiniteS' creates an infinite signal. The first argument 'f' is a function that is applied on the current value. The second argument 'x' gives the first value of the signal.
--
-- > Signal> takeS 5 (infiniteS (*3) 1)
-- > {1,3,9,27,81} :: Signal Integer
--
infiniteS      :: (a -> a) -> a -> Signal a

-- | The function 'writeS' transforms a signal into a string of the following format:
--
-- @ 
-- Signal> writeS (signal[1,2,3,4,5])
-- "1\n2\n3\n4\n5\n" :: [Char]
-- @
writeS     :: Show a => Signal a -> [Char]

-- | The function 'readS' transforms a formatted string into a signal.
--
-- @
-- Signal> readS "1\n2\n3\n4\n5\n" :: Signal Int
-- {1,2,3,4,5} :: Signal Int
-- @
readS      :: Read a => [Char] -> Signal a

-- | The operator '-:' adds at an element to a signal at the tail.
(-:)       :: Signal a -> a -> Signal a

-- | The operator '+-+' concatinates two signals into one signal.  
(+-+)      :: Signal a -> Signal a -> Signal a 


-- | The function 'copyS' creates a signal with n values 'x'.
copyS :: (Num a, Eq a) => a -> b -> Signal b


-- | The combinator 'fanS' takes two processes 'p1' and 'p2' and and generates a process network, where a signal is split and processed by the processes 'p1' and 'p2'.
fanS :: (Signal a -> Signal b) -> (Signal a -> Signal c) 
      -> Signal a -> (Signal b, Signal c)

-- | Folds all events in a signal to one value based on a reduction
-- function.
foldrS :: (t -> p -> p) -> p -> Signal t -> p

-- | Checks if all events in a signal are satisfying a predicate
-- function.
allS :: (a -> Bool) -> Signal a -> Bool

-- Implementation

instance (Show a) => Show (Signal a) where
  showsPrec :: Int -> Signal a -> ShowS
showsPrec Int
p Signal a
NullS = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
9) (String -> ShowS
showString String
"{}")
  showsPrec Int
p Signal a
xs    = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
9) (Char -> ShowS
showChar Char
'{' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signal a -> ShowS
forall a. Show a => Signal a -> ShowS
showSignal1 Signal a
xs)
    where
      showSignal1 :: Signal a -> ShowS
showSignal1 Signal a
NullS      = Char -> ShowS
showChar Char
'}'
      showSignal1 (a
y:-Signal a
NullS) = a -> ShowS
forall a. Show a => a -> ShowS
shows a
y ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'}'
      showSignal1 (a
y:-Signal a
ys)    = a -> ShowS
forall a. Show a => a -> ShowS
shows a
y ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
',' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signal a -> ShowS
showSignal1 Signal a
ys

instance Read a => Read (Signal a) where
  readsPrec :: Int -> ReadS (Signal a)
readsPrec Int
_ String
s = ReadS (Signal a)
forall a. Read a => ReadS (Signal a)
readsSignal String
s

readsSignal    :: (Read a) => ReadS (Signal a)
readsSignal :: ReadS (Signal a)
readsSignal String
s
  =  [((a
xa -> Signal a -> Signal a
forall a. a -> Signal a -> Signal a
:-Signal a
forall a. Signal a
NullS), String
rest)
     | (String
"{", String
r2)   <- ReadS String
lex String
s,
       (a
x, String
r3)     <- ReadS a
forall a. Read a => ReadS a
reads String
r2,
       (String
"}", String
rest) <- ReadS String
lex String
r3]
     [(Signal a, String)]
-> [(Signal a, String)] -> [(Signal a, String)]
forall a. [a] -> [a] -> [a]
++ [(Signal a
forall a. Signal a
NullS, String
r4)       
        | (String
"{", String
r5) <- ReadS String
lex String
s,
          (String
"}", String
r4) <- ReadS String
lex String
r5]
     [(Signal a, String)]
-> [(Signal a, String)] -> [(Signal a, String)]
forall a. [a] -> [a] -> [a]
++ [((a
xa -> Signal a -> Signal a
forall a. a -> Signal a -> Signal a
:-Signal a
xs), String
r6)     
        | (String
"{", String
r7) <- ReadS String
lex String
s,
          (a
x, String
r8)   <- ReadS a
forall a. Read a => ReadS a
reads String
r7,
          (String
",", String
r9) <- ReadS String
lex String
r8,
          (Signal a
xs, String
r6)  <- ReadS (Signal a)
forall a. Read a => ReadS (Signal a)
readsValues String
r9]

readsValues    :: (Read a) => ReadS (Signal a)
readsValues :: ReadS (Signal a)
readsValues String
s
  =  [((a
xa -> Signal a -> Signal a
forall a. a -> Signal a -> Signal a
:-Signal a
forall a. Signal a
NullS), String
r1) 
     | (a
x, String
r2)   <- ReadS a
forall a. Read a => ReadS a
reads String
s,
       (String
"}", String
r1) <- ReadS String
lex String
r2]
     [(Signal a, String)]
-> [(Signal a, String)] -> [(Signal a, String)]
forall a. [a] -> [a] -> [a]
++ [((a
xa -> Signal a -> Signal a
forall a. a -> Signal a -> Signal a
:-Signal a
xs), String
r3)    
        | (a
x, String
r4)   <- ReadS a
forall a. Read a => ReadS a
reads String
s,
          (String
",", String
r5) <- ReadS String
lex String
r4,
          (Signal a
xs, String
r3)  <- ReadS (Signal a)
forall a. Read a => ReadS (Signal a)
readsValues String
r5]

signal :: [a] -> Signal a
signal []          =  Signal a
forall a. Signal a
NullS
signal (a
x:[a]
xs)      =  a
x a -> Signal a -> Signal a
forall a. a -> Signal a -> Signal a
:- [a] -> Signal a
forall a. [a] -> Signal a
signal [a]
xs 

fromSignal :: Signal a -> [a]
fromSignal Signal a
NullS   =  []
fromSignal (a
x:-Signal a
xs) =  a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Signal a -> [a]
forall a. Signal a -> [a]
fromSignal Signal a
xs

unitS :: a -> Signal a
unitS a
x =  a
x a -> Signal a -> Signal a
forall a. a -> Signal a -> Signal a
:- Signal a
forall a. Signal a
NullS

nullS :: Signal a -> Bool
nullS Signal a
NullS =  Bool
True
nullS Signal a
_     =  Bool
False

headS :: Signal a -> a
headS Signal a
NullS  = String -> a
forall a. HasCallStack => String -> a
error String
"headS : Signal is empty"
headS (a
x:-Signal a
_) = a
x

tailS :: Signal a -> Signal a
tailS Signal a
NullS   = String -> Signal a
forall a. HasCallStack => String -> a
error String
"tailS : Signal is empty"
tailS (a
_:-Signal a
xs) = Signal a
xs

atS :: Int -> Signal a -> a
atS Int
_ Signal a
NullS   = String -> a
forall a. HasCallStack => String -> a
error String
"atS: Signal has not enough elements"
atS Int
0 (a
x:-Signal a
_)  = a
x
atS Int
n (a
_:-Signal a
xs) = Int -> Signal a -> a
forall a. Int -> Signal a -> a
atS (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Signal a
xs

(!-) :: Signal a -> Int -> a
!- :: Signal a -> Int -> a
(!-) Signal a
xs Int
n = Int -> Signal a -> a
forall a. Int -> Signal a -> a
atS Int
n Signal a
xs

takeS :: Int -> Signal a -> Signal a
takeS Int
0 Signal a
_      = Signal a
forall a. Signal a
NullS
takeS Int
_ Signal a
NullS  = Signal a
forall a. Signal a
NullS
takeS Int
n (a
x:-Signal a
xs)
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0     = Signal a
forall a. Signal a
NullS
  | Bool
otherwise  = a
x a -> Signal a -> Signal a
forall a. a -> Signal a -> Signal a
:- Int -> Signal a -> Signal a
forall a. Int -> Signal a -> Signal a
takeS (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Signal a
xs

dropS :: Int -> Signal a -> Signal a
dropS Int
0 Signal a
NullS  = Signal a
forall a. Signal a
NullS
dropS Int
_ Signal a
NullS  = Signal a
forall a. Signal a
NullS 
dropS Int
n (a
x:-Signal a
xs)
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0     = a
xa -> Signal a -> Signal a
forall a. a -> Signal a -> Signal a
:-Signal a
xs
  | Bool
otherwise  = Int -> Signal a -> Signal a
forall a. Int -> Signal a -> Signal a
dropS (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Signal a
xs


selectS :: Int -> Int -> Signal a -> Signal a
selectS Int
offset Int
step Signal a
xs = Int -> Signal a -> Signal a
forall a. Int -> Signal a -> Signal a
select1S Int
step (Int -> Signal a -> Signal a
forall a. Int -> Signal a -> Signal a
dropS Int
offset Signal a
xs) 
  where
    select1S :: Int -> Signal a -> Signal a
select1S Int
_  Signal a
NullS   = Signal a
forall a. Signal a
NullS
    select1S Int
st (a
y:-Signal a
ys) = a
y a -> Signal a -> Signal a
forall a. a -> Signal a -> Signal a
:- Int -> Signal a -> Signal a
select1S Int
st (Int -> Signal a -> Signal a
forall a. Int -> Signal a -> Signal a
dropS (Int
stInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Signal a
ys) 

-: :: Signal a -> a -> Signal a
(-:) Signal a
xs a
x = Signal a
xs Signal a -> Signal a -> Signal a
forall a. Signal a -> Signal a -> Signal a
+-+ (a
x a -> Signal a -> Signal a
forall a. a -> Signal a -> Signal a
:- Signal a
forall a. Signal a
NullS)

+-+ :: Signal a -> Signal a -> Signal a
(+-+) Signal a
NullS   Signal a
ys = Signal a
ys
(+-+) (a
x:-Signal a
xs) Signal a
ys = a
x a -> Signal a -> Signal a
forall a. a -> Signal a -> Signal a
:- (Signal a
xs Signal a -> Signal a -> Signal a
forall a. Signal a -> Signal a -> Signal a
+-+ Signal a
ys)

lengthS :: Signal b -> Int
lengthS Signal b
NullS   = Int
0
lengthS (b
_:-Signal b
xs) = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Signal b -> Int
forall b. Signal b -> Int
lengthS Signal b
xs

infiniteS :: (a -> a) -> a -> Signal a
infiniteS a -> a
f a
x = a
x a -> Signal a -> Signal a
forall a. a -> Signal a -> Signal a
:- (a -> a) -> a -> Signal a
forall a. (a -> a) -> a -> Signal a
infiniteS a -> a
f (a -> a
f a
x)

copyS :: a -> b -> Signal b
copyS a
0 b
_ = Signal b
forall a. Signal a
NullS
copyS a
n b
x = b
x b -> Signal b -> Signal b
forall a. a -> Signal a -> Signal a
:- a -> b -> Signal b
forall a b. (Num a, Eq a) => a -> b -> Signal b
copyS (a
na -> a -> a
forall a. Num a => a -> a -> a
-a
1) b
x

fanS :: (Signal a -> Signal b)
-> (Signal a -> Signal c) -> Signal a -> (Signal b, Signal c)
fanS Signal a -> Signal b
p1 Signal a -> Signal c
p2 Signal a
xs = (Signal a -> Signal b
p1 Signal a
xs, Signal a -> Signal c
p2 Signal a
xs)

writeS :: Signal a -> String
writeS Signal a
NullS   = []
writeS (a
x:-Signal a
xs) = a -> String
forall a. Show a => a -> String
show a
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Signal a -> String
forall a. Show a => Signal a -> String
writeS Signal a
xs

readS :: String -> Signal a
readS String
xs             = [String] -> Signal a
forall a. Read a => [String] -> Signal a
readS' (String -> [String]
words String
xs)
  where
    readS' :: [String] -> Signal a
readS' []        = Signal a
forall a. Signal a
NullS
    readS' (String
"\n":[String]
ys) = [String] -> Signal a
readS' [String]
ys
    readS' (String
y:[String]
ys)    = String -> a
forall a. Read a => String -> a
read String
y a -> Signal a -> Signal a
forall a. a -> Signal a -> Signal a
:- [String] -> Signal a
readS' [String]
ys

foldrS :: (t -> p -> p) -> p -> Signal t -> p
foldrS t -> p -> p
k p
z = Signal t -> p
go
  where
    go :: Signal t -> p
go Signal t
NullS   = p
z
    go (t
y:-Signal t
ys) = t
y t -> p -> p
`k` Signal t -> p
go Signal t
ys

allS :: (a -> Bool) -> Signal a -> Bool
allS a -> Bool
p = (a -> Bool -> Bool) -> Bool -> Signal a -> Bool
forall t p. (t -> p -> p) -> p -> Signal t -> p
foldrS (\a
a Bool
prev -> a -> Bool
p a
a Bool -> Bool -> Bool
&& Bool
prev) Bool
True