{-# LANGUAGE CPP, TypeOperators #-}
module Frames.Frame where
import Data.Foldable
#if __GLASGOW_HASKELL__ < 804
import Data.Semigroup
#endif
import qualified Data.Vector as V
import Data.Vinyl.TypeLevel
import Frames.Rec (Record)
import Frames.RecF (rappend)
data Frame r = Frame { frameLength :: !Int
, frameRow :: Int -> r }
type FrameRec rs = Frame (Record rs)
instance Functor Frame where
fmap f (Frame len g) = Frame len (f . g)
boxedFrame :: Foldable f => f r -> Frame r
boxedFrame xs = Frame (V.length v) (v V.!)
where v = V.fromList (toList xs)
instance Eq r => Eq (Frame r) where
Frame l1 r1 == Frame l2 r2 =
l1 == l2 && all (\i -> r1 i == r2 i) [0 .. l1 - 1]
instance Monoid (Frame r) where
mempty = Frame 0 (const $ error "index out of bounds (empty frame)")
f1 `mappend` f2 = f1 <> f2
instance Semigroup (Frame r) where
Frame l1 f1 <> Frame l2 f2 =
Frame (l1+l2) $ \i -> if i < l1 then f1 i else f2 (i - l1)
instance Foldable Frame where
foldMap f (Frame n row) = foldMap (f . row) [0..n-1]
{-# INLINE foldMap #-}
foldl' f z (Frame n row) = foldl' ((. row) . f) z [0..n-1]
{-# INLINE foldl' #-}
instance Applicative Frame where
pure x = Frame maxBound (const x)
Frame l1 f1 <*> Frame l2 f2 = Frame (min l1 l2) $ ($) <$> f1 <*> f2
instance Monad Frame where
return = pure
Frame l f >>= fb = foldMap (fb . f) [0 .. l - 1]
zipFrames :: FrameRec rs -> FrameRec rs' -> FrameRec (rs ++ rs')
zipFrames (Frame l1 f1) (Frame l2 f2) =
Frame (min l1 l2) $ rappend <$> f1 <*> f2