Hi John,

  1 {-# LANGUAGE Arrows, GeneralizedNewtypeDeriving, FlexibleContexts #-}
  2
  3 module Filter (
  4     FilterState
  5   , Filter
  6   , applyFilter
  7   , convT
  8 ) where
  9
 10 import EitherT
 11 import Control.Monad
 12 import Control.Monad.State
 13 import Control.Arrow
 14 import Control.Arrow.Operations
 15 import Control.Arrow.Transformer
 16 import Control.Arrow.Transformer.All
 17 import Data.Stream as DS (fromList, toList)
 18
 19 -- tap weights, `as' and `bs', are being made part of the filter state, in
 20 -- order to accomodate adaptive filters (i.e. - DFEs).
 21 data FilterState a = FilterState {
 22     as   :: [a] -- transfer function denominator coefficients
 23   , bs   :: [a] -- transfer function numerator coefficients
 24   , taps :: [a] -- current delay tap stored values
 25   }
 26
 27 -- Future proofing the implementation, using the `newtype' trick.
 28 newtype Filter b c = F {
 29     runFilter :: (b, FilterState b) -> (c, FilterState b)
 31   }
 32
 33 -- Time domain convolution filter (FIR or IIR),
 34 -- expressed in direct form 2
 35 convT :: (Num b) => Filter b b
 36 convT = F $ \(x, s) ->
 37     let wk = (x - sum [a * t | (a, t) <- zip (tail $ as s) (taps s)])
 38         newTaps = wk : ((reverse . tail . reverse) $ taps s)
 39         s' = s {taps = newTaps}
 40         y  = sum [b * w | (b, w) <- zip (bs s) (wk : (taps s))]
 41     in (y, s')
 42
 43 -- Turn a filter into an Automaton, in order to use the built in plubming
 44 -- of Arrows to run the filter on an input.
 45 filterAuto :: (ArrowApply a) => Filter b c -> FilterState b -> Automaton a (e, b) c
 46 filterAuto f s = Automaton a where
 47     a = proc (e, x) -> do
 48         (y, s') <- arr (runFilter f) -< (x, s)
 49         returnA -< (y, filterAuto f s')
 50
 53 applyFilter :: Filter b c -> FilterState b -> [b] -> ([c], FilterState b)
 54 applyFilter f s =
 55     let a = filterAuto f s
 56     in proc xs -> do
 57         ys <- runAutomaton a -< ((), DS.fromList xs)
 58         s' <- (|fetch|)
 59         returnA -< (DS.toList ys, s')
 60

which gave me this compile error:

Filter.hs:58:16:
    Could not deduce (ArrowState (FilterState b) (->))
      from the context ()
      arising from a use of `fetch' at Filter.hs:58:16-20
    Possible fix:
      add (ArrowState (FilterState b) (->)) to the context of
        the type signature for `applyFilter'
      or add an instance declaration for
         (ArrowState (FilterState b) (->))
    In the expression: fetch
    In the expression:
        proc xs -> do { ys <- runAutomaton a -< ((), fromList xs);
                        s' <- (|fetch |);
                        returnA -< (toList ys, s') }
    In the expression:
        let a = filterAuto f s
        in
          proc xs -> do { ys <- runAutomaton a -< ((), fromList xs);
                          s' <- (|fetch |);
                          .... }

So, I made this change:

 51 applyFilter :: (ArrowState (FilterState b) (->)) => Filter b c -> FilterState b -> [b] ->
 52                                                     ([c], FilterState b)

And that compiled. However, when I tried to test my new filter with:

> let s = FilterState [1,0,0] [0.7, 0.2, 0.1] [0, 0, 0]
> applyFilter convT s [1,0,0,0,0]

I got:

<interactive>:1:0:
    No instance for (ArrowState (FilterState Double) (->))
      arising from a use of `applyFilter' at <interactive>:1:0-30
    Possible fix:
      add an instance declaration for
      (ArrowState (FilterState Double) (->))
    In the expression: applyFilter convT s [1, 0, 0, 0, ....]
    In the definition of `it': it = applyFilter convT s [1, 0, 0, ....]

I thought, "maybe, I need to derive from ArrowState in my Filter type definition."
So, I tried making this change to the code:

28 newtype Filter b c = F {
29     runFilter :: (b, FilterState b) -> (c, FilterState b)
30   } deriving (ArrowState (FilterState x))

but then I was back to no compile:

Filter.hs:30:14:
    Can't make a derived instance of
      `ArrowState (FilterState x) Filter'
      (even with cunning newtype deriving):
      cannot eta-reduce the representation type enough
    In the newtype declaration for `Filter'

Do you have any advice?

Thanks,
-db