content: 
  -- | HLS describes state with history and a half-life. The decay is
  -- pseudo-random on a flat buffer. Developers can set three parameters:
  --
  --   halflife - determines how much state is kept
  --   join function - determines how old states collapse
  --
  -- One full halflife is kept without loss. So if the halflife is 30, 
  -- you'll always have at least the last 30 frames. The default half
  -- life is an approximation of e.
  --
  -- An alternative implementation might use multiple ring buffers for
  -- state, dropping the occasional state as it moves from buffer to
  -- buffer. However, this is not used at the moment.
  module HLS
      ( HLS
      , hls_full_init
      , hls_init
      , hls_put, hls_get, hls_modify
      , hls_getHist
      , hls_undo
      ) where
  
  import qualified Data.Sequence as S
  import qualified Data.Foldable as S
  import qualified System.Random as R
  
  -- states with exponential decay of history
  data HLS s = HLS 
      { hls_halflife :: {-# UNPACK #-} !Double 
      , hls_rgen     :: !R.StdGen
      , hls_state    :: !s
      , hls_hist     :: !(S.Seq s)
      , hls_join     :: !(s -> s -> s)
      }
  
  -- | Initialize with halflife and join function.
  --
  -- The join function is applied whenever two states are collapsed;
  -- the newer state is joined with the older state, somewhere deep
  -- in the history. 
  hls_full_init :: Double -> (s -> s -> s) -> s -> HLS s
  hls_full_init hl jf s0 = HLS
      { hls_halflife = hl
      , hls_rgen = R.mkStdGen 60091
      , hls_state = s0
      , hls_hist = S.empty
      , hls_join = jf
      }
  
  -- | default half-life (e) and default join-function (const)
  hls_init :: s -> HLS s
  hls_init = hls_full_init 2.71828 const 
  
  -- | obtain incomplete history (including current state)
  hls_getHist :: HLS s -> [s]
  hls_getHist hls = S.toList (hls_state hls S.<| hls_hist hls)
  
  -- | step back a little
  hls_undo :: HLS s -> HLS s
  hls_undo hls = case S.viewl (hls_hist hls) of
      S.EmptyL -> hls
      (s S.:< h) -> hls { hls_state = s, hls_hist = h }
  
  -- | put a value into the state
  hls_put :: s -> HLS s -> HLS s
  hls_put s hls =
      let (r,g') = R.random (hls_rgen hls) in
      let hl = hls_halflife hls in
      let decayTgt = negate $ log (1.0 - r) * hl in
      let n = ceiling $ hl + decayTgt in
      let h' = dropHLS (hls_join hls) n (hls_state hls S.<| hls_hist hls) in
      h' `seq` s `seq`
      hls { hls_rgen = g', hls_state = s, hls_hist = h' }
  
  -- | get current value from the state
  hls_get :: HLS s -> s
  hls_get = hls_state
  
  hls_modify :: (s -> s) -> HLS s -> HLS s
  hls_modify f hls = hls_put (f (hls_get hls)) hls
  
  -- dropHLS will join two items in a list at the given position
  -- This operation is strict in the join function because it is
  -- important to avoid a memory leak. 
  dropHLS :: (s -> s -> s) -> Int -> S.Seq s -> S.Seq s
  dropHLS jf n hist =
      let (before,after) = S.splitAt n hist in
      case (S.viewr before, S.viewl after) of
          (S.EmptyR, _) -> after
          (_, S.EmptyL) -> before
          (hNew S.:> sNew, sOld S.:< hOld) ->
              let sJ = jf sNew sOld in
              sJ `seq` ((hNew S.|> sJ) S.>< hOld)
  