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