module Sound.Audacity.Project.Track.Wave.Summary (
   State(State),
   Monad,
   eval,
   Handle,
   createHandle,
   deleteHandle,
   withHandle,
   usingHandle,
   T(Cons, length_, limits_, content_),
   fromBlock,
   attachStarts,
   sequenceFromStorableVector,
   reserve,
   Limits(Limits, min_, max_, rms_),
   defltLimits,
   storeLimits,
   summary,
   ) where

import qualified Data.StorableVector.Lazy as SVL
import qualified Data.StorableVector as SV
import Foreign.Storable.Record as Store
import Foreign.Storable (Storable (..), )

import qualified Data.List.HT as ListHT
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
import Data.Tuple.HT (mapPair)

import qualified Control.Monad.Trans.State as MS
import qualified Control.Monad.Trans.Reader as MR
import qualified Control.Monad.Trans.Class as MT
import qualified Control.Monad as M
import Control.DeepSeq (NFData, rnf, ($!!), )
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Applicative (liftA3, )

import Prelude hiding (Monad, )


newtype State = State Int
type Monad m = MR.ReaderT FilePath (MS.StateT State m)

eval :: (M.Monad m) => FilePath -> Monad m a -> m a
eval path =
   flip MS.evalStateT (State 0) . flip MR.runReaderT path


data Handle = Handle FilePath (IORef State)

createHandle :: FilePath -> IO Handle
createHandle path =
   fmap (Handle path) $ newIORef $ State 0

deleteHandle :: Handle -> IO ()
deleteHandle _ = return ()

withHandle :: FilePath -> (Handle -> IO a) -> IO a
withHandle path act =
   createHandle path >>= act

usingHandle :: (MonadIO io) => Handle -> Monad io a -> io a
usingHandle (Handle path stateRef) act = do
   oldState <- liftIO $ readIORef stateRef
   (a, newState) <- flip MS.runStateT oldState $ flip MR.runReaderT path act
   liftIO $ writeIORef stateRef newState
   return a


data T =
   Cons {
      length_ :: Int,
      limits_ :: Limits,
      content_ :: SVL.Vector Limits
   }
   deriving Show

instance NFData T where
   rnf (Cons len limits dat) = rnf (len, limits, dat)


fromBlock :: SVL.Vector Float -> T
fromBlock block =
   let sum256 = map accumulate $ SVL.sliceVertical 256 block
       sum65536 = map reduce $ ListHT.sliceVertical 256 sum256
       accumTmp@(_, (_, len)) = reduce sum65536
   in  Cons {
          length_ = len,
          limits_ = limitsFromAccumulators accumTmp,
          content_ =
             SVL.fromChunks $
                (SV.pack $ map limitsFromAccumulators sum256) :
                (SV.pack $ map limitsFromAccumulators sum65536) :
                []
       }


attachStarts :: [T] -> [(Int, T)]
attachStarts xs =
   zipWith
      (\ start block -> ((,) $!! start) block)
      (scanl (+) 0 $ map length_ xs) xs

sequenceFromStorableVector :: Int -> SVL.Vector Float -> [T]
sequenceFromStorableVector blockSize =
   map fromBlock . SVL.sliceVertical blockSize


reserve :: (M.Monad m) => Monad m State
reserve = MT.lift $ do
   s@(State n) <- MS.get
   MS.put $ State (n+1)
   return s



data Limits = Limits {min_, max_, rms_ :: Float}
   deriving Show

instance NFData Limits where
   rnf (Limits ymin ymax yrms) = rnf (ymin, ymax, yrms)

defltLimits :: Limits
defltLimits = Limits {min_ = -1, max_ = 1, rms_ = 0.2}

storeLimits :: Store.Dictionary Limits
storeLimits =
   Store.run $
   liftA3 Limits
      (Store.element min_)
      (Store.element max_)
      (Store.element rms_)

instance Storable Limits where
   sizeOf = Store.sizeOf storeLimits
   alignment = Store.alignment storeLimits
   peek = Store.peek storeLimits
   poke = Store.poke storeLimits



summary :: Int -> SVL.Vector Float -> SV.Vector Limits
summary chunkSize =
   SV.pack . map (limitsFromAccumulators . accumulate) .
   SVL.sliceVertical chunkSize

reduce :: [((Float, Float), (Float, Int))] -> ((Float, Float), (Float, Int))
reduce xs =
   let ((xmin, xmax), (xsqr, len)) = mapPair (unzip, unzip) $ unzip xs
   in  ((minimum xmin, maximum xmax), (sum xsqr, sum len))

limitsFromAccumulators :: ((Float, Float), (Float, Int)) -> Limits
limitsFromAccumulators ((xmin, xmax), (xsqr, len)) =
   Limits xmin xmax (sqrt (xsqr / fromIntegral len))

accumulate :: SVL.Vector Float -> ((Float, Float), (Float, Int))
accumulate chunk =
   ((SVL.foldl' min 1 chunk, SVL.foldl' max (-1) chunk),
    (SVL.foldl' (+) 0 (SVL.map (^(2::Int)) chunk), SVL.length chunk))