{-# 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 { forall r. Frame r -> Int
frameLength :: !Int
, forall r. Frame r -> Int -> r
frameRow :: Int -> r }
type FrameRec rs = Frame (Record rs)
instance Functor Frame where
fmap :: forall a b. (a -> b) -> Frame a -> Frame b
fmap a -> b
f (Frame Int
len Int -> a
g) = forall r. Int -> (Int -> r) -> Frame r
Frame Int
len (a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a
g)
boxedFrame :: Foldable f => f r -> Frame r
boxedFrame :: forall (f :: * -> *) r. Foldable f => f r -> Frame r
boxedFrame f r
xs = forall r. Int -> (Int -> r) -> Frame r
Frame (forall a. Vector a -> Int
V.length Vector r
v) (Vector r
v forall a. Vector a -> Int -> a
V.!)
where v :: Vector r
v = forall a. [a] -> Vector a
V.fromList (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f r
xs)
instance Eq r => Eq (Frame r) where
Frame Int
l1 Int -> r
r1 == :: Frame r -> Frame r -> Bool
== Frame Int
l2 Int -> r
r2 =
Int
l1 forall a. Eq a => a -> a -> Bool
== Int
l2 Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Int
i -> Int -> r
r1 Int
i forall a. Eq a => a -> a -> Bool
== Int -> r
r2 Int
i) [Int
0 .. Int
l1 forall a. Num a => a -> a -> a
- Int
1]
instance Monoid (Frame r) where
mempty :: Frame r
mempty = forall r. Int -> (Int -> r) -> Frame r
Frame Int
0 (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => [Char] -> a
error [Char]
"index out of bounds (empty frame)")
instance Semigroup (Frame r) where
Frame Int
l1 Int -> r
f1 <> :: Frame r -> Frame r -> Frame r
<> Frame Int
l2 Int -> r
f2 =
forall r. Int -> (Int -> r) -> Frame r
Frame (Int
l1forall a. Num a => a -> a -> a
+Int
l2) forall a b. (a -> b) -> a -> b
$ \Int
i -> if Int
i forall a. Ord a => a -> a -> Bool
< Int
l1 then Int -> r
f1 Int
i else Int -> r
f2 (Int
i forall a. Num a => a -> a -> a
- Int
l1)
instance Foldable Frame where
foldMap :: forall m a. Monoid m => (a -> m) -> Frame a -> m
foldMap a -> m
f (Frame Int
n Int -> a
row) = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (a -> m
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a
row) [Int
0..Int
nforall a. Num a => a -> a -> a
-Int
1]
{-# INLINE foldMap #-}
foldl' :: forall b a. (b -> a -> b) -> b -> Frame a -> b
foldl' b -> a -> b
f b
z (Frame Int
n Int -> a
row) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a
row) forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a -> b
f) b
z [Int
0..Int
nforall a. Num a => a -> a -> a
-Int
1]
{-# INLINE foldl' #-}
instance Applicative Frame where
pure :: forall a. a -> Frame a
pure a
x = forall r. Int -> (Int -> r) -> Frame r
Frame forall a. Bounded a => a
maxBound (forall a b. a -> b -> a
const a
x)
Frame Int
l1 Int -> a -> b
f1 <*> :: forall a b. Frame (a -> b) -> Frame a -> Frame b
<*> Frame Int
l2 Int -> a
f2 = forall r. Int -> (Int -> r) -> Frame r
Frame (forall a. Ord a => a -> a -> a
min Int
l1 Int
l2) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> a -> b
($) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> a -> b
f1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> a
f2
instance Monad Frame where
return :: forall a. a -> Frame a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
Frame Int
l Int -> a
f >>= :: forall a b. Frame a -> (a -> Frame b) -> Frame b
>>= a -> Frame b
fb = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (a -> Frame b
fb forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a
f) [Int
0 .. Int
l forall a. Num a => a -> a -> a
- Int
1]
zipFrames :: FrameRec rs -> FrameRec rs' -> FrameRec (rs ++ rs')
zipFrames :: forall (rs :: [(Symbol, *)]) (rs' :: [(Symbol, *)]).
FrameRec rs -> FrameRec rs' -> FrameRec (rs ++ rs')
zipFrames (Frame Int
l1 Int -> Record rs
f1) (Frame Int
l2 Int -> Record rs'
f2) =
forall r. Int -> (Int -> r) -> Frame r
Frame (forall a. Ord a => a -> a -> a
min Int
l1 Int
l2) forall a b. (a -> b) -> a -> b
$ forall {k} (f :: k -> *) (as :: [k]) (bs :: [k]).
Rec f as -> Rec f bs -> Rec f (as ++ bs)
rappend forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Record rs
f1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Record rs'
f2