{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}

-- |
-- Module      : Database.Relational.Pi.Unsafe
-- Copyright   : 2013-2019 Kei Hibino
-- License     : BSD3
--
-- Maintainer  : ex8k.hibino@gmail.com
-- Stability   : experimental
-- Portability : unknown
--
-- This module defines typed projection path objects.
-- Contains internal structure and unsafe interfaces.
module Database.Relational.Pi.Unsafe (
  -- * Projection path
  Pi,

  width', width,

  (<.>), (<?.>), (<?.?>),

  pi,

  definePi, defineDirectPi', defineDirectPi,

  expandIndexes', expandIndexes,

  -- * Deprecated
  unsafeExpandIndexes',
  unsafeExpandIndexes
  ) where

import Prelude hiding (pi, (.), id)
import Control.Category (Category (..), (>>>))
import Data.Array (listArray, (!))
import Data.Functor.ProductIsomorphic
  (ProductIsoFunctor, (|$|), ProductIsoApplicative, pureP, (|*|),
   ProductIsoEmpty, pureE, peRight, peLeft, )

import Database.Record.Persistable
  (PersistableRecordWidth, runPersistableRecordWidth, unsafePersistableRecordWidth,
   PersistableWidth (persistableWidth), maybeWidth)


-- | Projection path primary structure type.
data Pi' r0 r1 = Leftest Int
               | Map [Int]

unsafePiAppend' :: Pi' a b' -> Pi' b c' -> Pi' a c
unsafePiAppend' :: Pi' a b' -> Pi' b c' -> Pi' a c
unsafePiAppend' = Pi' a b' -> Pi' b c' -> Pi' a c
forall r0 r1 r0 r1 r0 r1. Pi' r0 r1 -> Pi' r0 r1 -> Pi' r0 r1
d  where
  d :: Pi' r0 r1 -> Pi' r0 r1 -> Pi' r0 r1
d (Leftest Int
i) (Leftest Int
j) = Int -> Pi' r0 r1
forall r0 r1. Int -> Pi' r0 r1
Leftest (Int -> Pi' r0 r1) -> Int -> Pi' r0 r1
forall a b. (a -> b) -> a -> b
$ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
j
  d (Leftest Int
i) (Map [Int]
js)    = [Int] -> Pi' r0 r1
forall r0 r1. [Int] -> Pi' r0 r1
Map ([Int] -> Pi' r0 r1) -> [Int] -> Pi' r0 r1
forall a b. (a -> b) -> a -> b
$ (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+) [Int]
js
  d (Map [Int]
is)    (Leftest Int
j) = [Int] -> Pi' r0 r1
forall r0 r1. [Int] -> Pi' r0 r1
Map ([Int] -> Pi' r0 r1) -> [Int] -> Pi' r0 r1
forall a b. (a -> b) -> a -> b
$ Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
drop Int
j [Int]
is
  d (Map [Int]
is)    (Map [Int]
js)    = [Int] -> Pi' r0 r1
forall r0 r1. [Int] -> Pi' r0 r1
Map   [ Array Int Int
is' Array Int Int -> Int -> Int
forall i e. Ix i => Array i e -> i -> e
! Int
j | Int
j <- [Int]
js ]  where
    is' :: Array Int Int
is' = (Int, Int) -> [Int] -> Array Int Int
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0, [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
is) [Int]
is

-- | Projection path from type 'r0' into type 'r1'.
--   This type also indicate key object which type is 'r1' for record type 'r0'.
newtype Pi r0 r1 = Pi { Pi r0 r1
-> PersistableRecordWidth r0
-> (Pi' r0 r1, PersistableRecordWidth r1)
runPi :: PersistableRecordWidth r0 -> (Pi' r0 r1, PersistableRecordWidth r1) }

instance PersistableWidth r0 => Show (Pi r0 r1) where
  show :: Pi r0 r1 -> String
show Pi r0 r1
p = [String] -> String
unwords [String
"Pi", [Int] -> String
forall a. Show a => a -> String
show ([Int] -> String) -> [Int] -> String
forall a b. (a -> b) -> a -> b
$ Pi r0 r1 -> [Int]
forall a b. PersistableWidth a => Pi a b -> [Int]
unsafeExpandIndexes Pi r0 r1
p]

unsafePiAppend :: (PersistableRecordWidth b' -> PersistableRecordWidth b)
               -> (PersistableRecordWidth c' -> PersistableRecordWidth c)
               -> Pi a b' -> Pi b c' -> Pi a c
unsafePiAppend :: (PersistableRecordWidth b' -> PersistableRecordWidth b)
-> (PersistableRecordWidth c' -> PersistableRecordWidth c)
-> Pi a b'
-> Pi b c'
-> Pi a c
unsafePiAppend PersistableRecordWidth b' -> PersistableRecordWidth b
wbf PersistableRecordWidth c' -> PersistableRecordWidth c
wcf (Pi PersistableRecordWidth a -> (Pi' a b', PersistableRecordWidth b')
f) (Pi PersistableRecordWidth b -> (Pi' b c', PersistableRecordWidth c')
g) = (PersistableRecordWidth a -> (Pi' a c, PersistableRecordWidth c))
-> Pi a c
forall r0 r1.
(PersistableRecordWidth r0
 -> (Pi' r0 r1, PersistableRecordWidth r1))
-> Pi r0 r1
Pi ((PersistableRecordWidth a -> (Pi' a c, PersistableRecordWidth c))
 -> Pi a c)
-> (PersistableRecordWidth a
    -> (Pi' a c, PersistableRecordWidth c))
-> Pi a c
forall a b. (a -> b) -> a -> b
$ \PersistableRecordWidth a
wa ->
  let (Pi' a b'
pab, PersistableRecordWidth b'
wb) = PersistableRecordWidth a -> (Pi' a b', PersistableRecordWidth b')
f PersistableRecordWidth a
wa
      (Pi' b c'
pbc, PersistableRecordWidth c'
wc) = PersistableRecordWidth b -> (Pi' b c', PersistableRecordWidth c')
g (PersistableRecordWidth b -> (Pi' b c', PersistableRecordWidth c'))
-> PersistableRecordWidth b
-> (Pi' b c', PersistableRecordWidth c')
forall a b. (a -> b) -> a -> b
$ PersistableRecordWidth b' -> PersistableRecordWidth b
wbf PersistableRecordWidth b'
wb
  in (Pi' a b'
pab Pi' a b' -> Pi' b c' -> Pi' a c
forall a b' b c' c. Pi' a b' -> Pi' b c' -> Pi' a c
`unsafePiAppend'` Pi' b c'
pbc, PersistableRecordWidth c' -> PersistableRecordWidth c
wcf PersistableRecordWidth c'
wc)

-- | Expand indexes from key.
expandIndexes' :: PersistableRecordWidth a -> Pi a b -> [Int]
expandIndexes' :: PersistableRecordWidth a -> Pi a b -> [Int]
expandIndexes' PersistableRecordWidth a
wa (Pi PersistableRecordWidth a -> (Pi' a b, PersistableRecordWidth b)
f) = (Pi' a b, PersistableRecordWidth b) -> [Int]
forall r0 r1 a. (Pi' r0 r1, PersistableRecordWidth a) -> [Int]
d ((Pi' a b, PersistableRecordWidth b) -> [Int])
-> (Pi' a b, PersistableRecordWidth b) -> [Int]
forall a b. (a -> b) -> a -> b
$ PersistableRecordWidth a -> (Pi' a b, PersistableRecordWidth b)
f PersistableRecordWidth a
wa where
  d :: (Pi' r0 r1, PersistableRecordWidth a) -> [Int]
d (Map [Int]
is, PersistableRecordWidth a
_)    = [Int]
is
  d (Leftest Int
i, PersistableRecordWidth a
w) = [ Int
i .. Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
w' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 ]  where
    w' :: Int
w' = PersistableRecordWidth a -> Int
forall a. PersistableRecordWidth a -> Int
runPersistableRecordWidth PersistableRecordWidth a
w

unsafeExpandIndexes' :: PersistableRecordWidth a -> Pi a b -> [Int]
unsafeExpandIndexes' :: PersistableRecordWidth a -> Pi a b -> [Int]
unsafeExpandIndexes' = PersistableRecordWidth a -> Pi a b -> [Int]
forall a b. PersistableRecordWidth a -> Pi a b -> [Int]
expandIndexes'
{-# DEPRECATED unsafeExpandIndexes' "Use expandIndexes' instead of this." #-}

-- | Expand indexes from key. Infered width version.
expandIndexes :: PersistableWidth a => Pi a b -> [Int]
expandIndexes :: Pi a b -> [Int]
expandIndexes = PersistableRecordWidth a -> Pi a b -> [Int]
forall a b. PersistableRecordWidth a -> Pi a b -> [Int]
expandIndexes' PersistableRecordWidth a
forall a. PersistableWidth a => PersistableRecordWidth a
persistableWidth

unsafeExpandIndexes :: PersistableWidth a => Pi a b -> [Int]
unsafeExpandIndexes :: Pi a b -> [Int]
unsafeExpandIndexes = Pi a b -> [Int]
forall a b. PersistableWidth a => Pi a b -> [Int]
expandIndexes
{-# DEPRECATED unsafeExpandIndexes "use expandIndexes instead of this." #-}

-- | Unsafely cast width proof object of record. Result record must be same width.
unsafeCastRecordWidth :: PersistableRecordWidth a -> PersistableRecordWidth a'
unsafeCastRecordWidth :: PersistableRecordWidth a -> PersistableRecordWidth a'
unsafeCastRecordWidth =  Int -> PersistableRecordWidth a'
forall a. Int -> PersistableRecordWidth a
unsafePersistableRecordWidth (Int -> PersistableRecordWidth a')
-> (PersistableRecordWidth a -> Int)
-> PersistableRecordWidth a
-> PersistableRecordWidth a'
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. PersistableRecordWidth a -> Int
forall a. PersistableRecordWidth a -> Int
runPersistableRecordWidth

unsafeCast :: Pi a b' -> Pi a b
unsafeCast :: Pi a b' -> Pi a b
unsafeCast =  Pi a b' -> Pi a b
forall r0 a r1. Pi r0 a -> Pi r0 r1
c  where
  d :: Pi' r0 r1 -> Pi' r0 r1
d (Leftest Int
i) = Int -> Pi' r0 r1
forall r0 r1. Int -> Pi' r0 r1
Leftest Int
i
  d (Map [Int]
m)     = [Int] -> Pi' r0 r1
forall r0 r1. [Int] -> Pi' r0 r1
Map [Int]
m
  c :: Pi r0 a -> Pi r0 r1
c (Pi PersistableRecordWidth r0 -> (Pi' r0 a, PersistableRecordWidth a)
f)    = (PersistableRecordWidth r0
 -> (Pi' r0 r1, PersistableRecordWidth r1))
-> Pi r0 r1
forall r0 r1.
(PersistableRecordWidth r0
 -> (Pi' r0 r1, PersistableRecordWidth r1))
-> Pi r0 r1
Pi ((PersistableRecordWidth r0
  -> (Pi' r0 r1, PersistableRecordWidth r1))
 -> Pi r0 r1)
-> (PersistableRecordWidth r0
    -> (Pi' r0 r1, PersistableRecordWidth r1))
-> Pi r0 r1
forall a b. (a -> b) -> a -> b
$ \PersistableRecordWidth r0
wa ->
    let (Pi' r0 a
pb, PersistableRecordWidth a
wb) = PersistableRecordWidth r0 -> (Pi' r0 a, PersistableRecordWidth a)
f PersistableRecordWidth r0
wa in
    (Pi' r0 a -> Pi' r0 r1
forall r0 r1 r0 r1. Pi' r0 r1 -> Pi' r0 r1
d Pi' r0 a
pb, PersistableRecordWidth a -> PersistableRecordWidth r1
forall a a'. PersistableRecordWidth a -> PersistableRecordWidth a'
unsafeCastRecordWidth PersistableRecordWidth a
wb)

-- | 'Pi' with zero width which projects to unit
pzero :: Pi a ()
pzero :: Pi a ()
pzero = (PersistableRecordWidth a -> (Pi' a (), PersistableRecordWidth ()))
-> Pi a ()
forall r0 r1.
(PersistableRecordWidth r0
 -> (Pi' r0 r1, PersistableRecordWidth r1))
-> Pi r0 r1
Pi ((PersistableRecordWidth a
  -> (Pi' a (), PersistableRecordWidth ()))
 -> Pi a ())
-> (PersistableRecordWidth a
    -> (Pi' a (), PersistableRecordWidth ()))
-> Pi a ()
forall a b. (a -> b) -> a -> b
$ \PersistableRecordWidth a
_ -> ([Int] -> Pi' a ()
forall r0 r1. [Int] -> Pi' r0 r1
Map [], PersistableRecordWidth ()
forall a. PersistableWidth a => PersistableRecordWidth a
persistableWidth)

-- | Map projection path 'Pi' which has record result type.
instance ProductIsoFunctor (Pi a) where
  a -> b
_ |$| :: (a -> b) -> Pi a a -> Pi a b
|$| Pi a a
p = Pi a a -> Pi a b
forall r0 a r1. Pi r0 a -> Pi r0 r1
unsafeCast Pi a a
p

-- | Compose projection path 'Pi' which has record result type using applicative style.
instance ProductIsoApplicative (Pi a) where
  pureP :: a -> Pi a a
pureP a
_ = Pi a () -> Pi a a
forall r0 a r1. Pi r0 a -> Pi r0 r1
unsafeCast Pi a ()
forall a. Pi a ()
pzero
  Pi a (a -> b)
pab |*| :: Pi a (a -> b) -> Pi a a -> Pi a b
|*| Pi a a
pb =
    (PersistableRecordWidth a -> (Pi' a b, PersistableRecordWidth b))
-> Pi a b
forall r0 r1.
(PersistableRecordWidth r0
 -> (Pi' r0 r1, PersistableRecordWidth r1))
-> Pi r0 r1
Pi ((PersistableRecordWidth a -> (Pi' a b, PersistableRecordWidth b))
 -> Pi a b)
-> (PersistableRecordWidth a
    -> (Pi' a b, PersistableRecordWidth b))
-> Pi a b
forall a b. (a -> b) -> a -> b
$ \PersistableRecordWidth a
wr ->
           let (Pi' a (a -> b)
_, PersistableRecordWidth (a -> b)
wab) = Pi a (a -> b)
-> PersistableRecordWidth a
-> (Pi' a (a -> b), PersistableRecordWidth (a -> b))
forall r0 r1.
Pi r0 r1
-> PersistableRecordWidth r0
-> (Pi' r0 r1, PersistableRecordWidth r1)
runPi Pi a (a -> b)
pab PersistableRecordWidth a
wr
               (Pi' a a
_, PersistableRecordWidth a
wb)  = Pi a a
-> PersistableRecordWidth a -> (Pi' a a, PersistableRecordWidth a)
forall r0 r1.
Pi r0 r1
-> PersistableRecordWidth r0
-> (Pi' r0 r1, PersistableRecordWidth r1)
runPi Pi a a
pb  PersistableRecordWidth a
wr in
             ([Int] -> Pi' a b
forall r0 r1. [Int] -> Pi' r0 r1
Map ([Int] -> Pi' a b) -> [Int] -> Pi' a b
forall a b. (a -> b) -> a -> b
$ PersistableRecordWidth a -> Pi a (a -> b) -> [Int]
forall a b. PersistableRecordWidth a -> Pi a b -> [Int]
unsafeExpandIndexes' PersistableRecordWidth a
wr Pi a (a -> b)
pab [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ PersistableRecordWidth a -> Pi a a -> [Int]
forall a b. PersistableRecordWidth a -> Pi a b -> [Int]
unsafeExpandIndexes' PersistableRecordWidth a
wr Pi a a
pb,
              PersistableRecordWidth (a -> b)
wab PersistableRecordWidth (a -> b)
-> PersistableRecordWidth a -> PersistableRecordWidth b
forall (f :: * -> *) a b.
ProductIsoApplicative f =>
f (a -> b) -> f a -> f b
|*| PersistableRecordWidth a
wb)

instance ProductIsoEmpty (Pi a) () where
  pureE :: Pi a ()
pureE   = Pi a ()
forall a. Pi a ()
pzero
  peRight :: Pi a (a, ()) -> Pi a a
peRight = Pi a (a, ()) -> Pi a a
forall r0 a r1. Pi r0 a -> Pi r0 r1
unsafeCast
  peLeft :: Pi a ((), a) -> Pi a a
peLeft  = Pi a ((), a) -> Pi a a
forall r0 a r1. Pi r0 a -> Pi r0 r1
unsafeCast

-- | Get record width proof object.
width' :: PersistableWidth r => Pi r ct -> PersistableRecordWidth ct
width' :: Pi r ct -> PersistableRecordWidth ct
width' (Pi PersistableRecordWidth r -> (Pi' r ct, PersistableRecordWidth ct)
f) = (Pi' r ct, PersistableRecordWidth ct) -> PersistableRecordWidth ct
forall a b. (a, b) -> b
snd ((Pi' r ct, PersistableRecordWidth ct)
 -> PersistableRecordWidth ct)
-> (Pi' r ct, PersistableRecordWidth ct)
-> PersistableRecordWidth ct
forall a b. (a -> b) -> a -> b
$ PersistableRecordWidth r -> (Pi' r ct, PersistableRecordWidth ct)
f PersistableRecordWidth r
forall a. PersistableWidth a => PersistableRecordWidth a
persistableWidth

-- | Get record width.
width :: PersistableWidth r => Pi r a -> Int
width :: Pi r a -> Int
width =  PersistableRecordWidth a -> Int
forall a. PersistableRecordWidth a -> Int
runPersistableRecordWidth (PersistableRecordWidth a -> Int)
-> (Pi r a -> PersistableRecordWidth a) -> Pi r a -> Int
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Pi r a -> PersistableRecordWidth a
forall r ct.
PersistableWidth r =>
Pi r ct -> PersistableRecordWidth ct
width'

justWidth :: PersistableRecordWidth (Maybe a) -> PersistableRecordWidth a
justWidth :: PersistableRecordWidth (Maybe a) -> PersistableRecordWidth a
justWidth = PersistableRecordWidth (Maybe a) -> PersistableRecordWidth a
forall a a'. PersistableRecordWidth a -> PersistableRecordWidth a'
unsafeCastRecordWidth


instance Category Pi where
  id :: Pi a a
id = (PersistableRecordWidth a -> (Pi' a a, PersistableRecordWidth a))
-> Pi a a
forall r0 r1.
(PersistableRecordWidth r0
 -> (Pi' r0 r1, PersistableRecordWidth r1))
-> Pi r0 r1
Pi ((PersistableRecordWidth a -> (Pi' a a, PersistableRecordWidth a))
 -> Pi a a)
-> (PersistableRecordWidth a
    -> (Pi' a a, PersistableRecordWidth a))
-> Pi a a
forall a b. (a -> b) -> a -> b
$ \PersistableRecordWidth a
pw -> (Int -> Pi' a a
forall r0 r1. Int -> Pi' r0 r1
Leftest Int
0, PersistableRecordWidth a
pw)
  Pi PersistableRecordWidth b -> (Pi' b c, PersistableRecordWidth c)
fb . :: Pi b c -> Pi a b -> Pi a c
. Pi PersistableRecordWidth a -> (Pi' a b, PersistableRecordWidth b)
fa = (PersistableRecordWidth a -> (Pi' a c, PersistableRecordWidth c))
-> Pi a c
forall r0 r1.
(PersistableRecordWidth r0
 -> (Pi' r0 r1, PersistableRecordWidth r1))
-> Pi r0 r1
Pi ((PersistableRecordWidth a -> (Pi' a c, PersistableRecordWidth c))
 -> Pi a c)
-> (PersistableRecordWidth a
    -> (Pi' a c, PersistableRecordWidth c))
-> Pi a c
forall a b. (a -> b) -> a -> b
$ \PersistableRecordWidth a
wa ->
    let (Pi' a b
pb, PersistableRecordWidth b
wb) = PersistableRecordWidth a -> (Pi' a b, PersistableRecordWidth b)
fa PersistableRecordWidth a
wa
        (Pi' b c
pc, PersistableRecordWidth c
wc) = PersistableRecordWidth b -> (Pi' b c, PersistableRecordWidth c)
fb PersistableRecordWidth b
wb
    in (Pi' a b -> Pi' b c -> Pi' a c
forall a b' b c' c. Pi' a b' -> Pi' b c' -> Pi' a c
unsafePiAppend' Pi' a b
pb Pi' b c
pc, PersistableRecordWidth c
wc)

-- | Compose projection path.
(<.>) :: Pi a b -> Pi b c -> Pi a c
<.> :: Pi a b -> Pi b c -> Pi a c
(<.>) = Pi a b -> Pi b c -> Pi a c
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
(>>>)

-- | Compose projection path. 'Maybe' phantom functor is 'map'-ed.
(<?.>) :: Pi a (Maybe b) -> Pi b c -> Pi a (Maybe c)
<?.> :: Pi a (Maybe b) -> Pi b c -> Pi a (Maybe c)
(<?.>) = (PersistableRecordWidth (Maybe b) -> PersistableRecordWidth b)
-> (PersistableRecordWidth c -> PersistableRecordWidth (Maybe c))
-> Pi a (Maybe b)
-> Pi b c
-> Pi a (Maybe c)
forall b' b c' c a.
(PersistableRecordWidth b' -> PersistableRecordWidth b)
-> (PersistableRecordWidth c' -> PersistableRecordWidth c)
-> Pi a b'
-> Pi b c'
-> Pi a c
unsafePiAppend PersistableRecordWidth (Maybe b) -> PersistableRecordWidth b
forall a.
PersistableRecordWidth (Maybe a) -> PersistableRecordWidth a
justWidth PersistableRecordWidth c -> PersistableRecordWidth (Maybe c)
forall a.
PersistableRecordWidth a -> PersistableRecordWidth (Maybe a)
maybeWidth

-- | Compose projection path. 'Maybe' phantom functors are 'join'-ed like '>=>'.
(<?.?>) :: Pi a (Maybe b) -> Pi b (Maybe c) -> Pi a (Maybe c)
<?.?> :: Pi a (Maybe b) -> Pi b (Maybe c) -> Pi a (Maybe c)
(<?.?>) = (PersistableRecordWidth (Maybe b) -> PersistableRecordWidth b)
-> (PersistableRecordWidth (Maybe c)
    -> PersistableRecordWidth (Maybe c))
-> Pi a (Maybe b)
-> Pi b (Maybe c)
-> Pi a (Maybe c)
forall b' b c' c a.
(PersistableRecordWidth b' -> PersistableRecordWidth b)
-> (PersistableRecordWidth c' -> PersistableRecordWidth c)
-> Pi a b'
-> Pi b c'
-> Pi a c
unsafePiAppend PersistableRecordWidth (Maybe b) -> PersistableRecordWidth b
forall a.
PersistableRecordWidth (Maybe a) -> PersistableRecordWidth a
justWidth PersistableRecordWidth (Maybe c)
-> PersistableRecordWidth (Maybe c)
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id

infixl 8 <.>, <?.>, <?.?>

-- | Unsafely project untyped value list.
pi :: PersistableRecordWidth r0 -> Pi r0 r1 -> [a] -> [a]
pi :: PersistableRecordWidth r0 -> Pi r0 r1 -> [a] -> [a]
pi PersistableRecordWidth r0
w0 (Pi PersistableRecordWidth r0 -> (Pi' r0 r1, PersistableRecordWidth r1)
f) [a]
cs = Pi' r0 r1 -> [a]
forall r0 r1. Pi' r0 r1 -> [a]
d Pi' r0 r1
p'  where
  (Pi' r0 r1
p', PersistableRecordWidth r1
w1) = PersistableRecordWidth r0 -> (Pi' r0 r1, PersistableRecordWidth r1)
f PersistableRecordWidth r0
w0
  d :: Pi' r0 r1 -> [a]
d (Leftest Int
i) = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take (PersistableRecordWidth r1 -> Int
forall a. PersistableRecordWidth a -> Int
runPersistableRecordWidth PersistableRecordWidth r1
w1) ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
i ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ [a]
cs
  d (Map [Int]
is)    = [Array Int a
cs' Array Int a -> Int -> a
forall i e. Ix i => Array i e -> i -> e
! Int
i | Int
i <- [Int]
is]
  cs' :: Array Int a
cs' = (Int, Int) -> [a] -> Array Int a
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0, [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
cs) [a]
cs

-- | Unsafely define projection path from type 'r0' into type 'r1'.
definePi' :: PersistableRecordWidth r1
          -> Int      -- ^ Index of flat SQL value list
          -> Pi r0 r1 -- ^ Result projection path
definePi' :: PersistableRecordWidth r1 -> Int -> Pi r0 r1
definePi' PersistableRecordWidth r1
pw Int
i = (PersistableRecordWidth r0
 -> (Pi' r0 r1, PersistableRecordWidth r1))
-> Pi r0 r1
forall r0 r1.
(PersistableRecordWidth r0
 -> (Pi' r0 r1, PersistableRecordWidth r1))
-> Pi r0 r1
Pi ((PersistableRecordWidth r0
  -> (Pi' r0 r1, PersistableRecordWidth r1))
 -> Pi r0 r1)
-> (PersistableRecordWidth r0
    -> (Pi' r0 r1, PersistableRecordWidth r1))
-> Pi r0 r1
forall a b. (a -> b) -> a -> b
$ \PersistableRecordWidth r0
_ -> (Int -> Pi' r0 r1
forall r0 r1. Int -> Pi' r0 r1
Leftest Int
i, PersistableRecordWidth r1
pw)

-- | Unsafely define projection path from type 'r0' into type 'r1'.
--   Use inferred 'PersistableRecordWidth'.
definePi :: PersistableWidth r1
         => Int      -- ^ Index of flat SQL value list
         -> Pi r0 r1 -- ^ Result projection path
definePi :: Int -> Pi r0 r1
definePi = PersistableRecordWidth r1 -> Int -> Pi r0 r1
forall r1 r0. PersistableRecordWidth r1 -> Int -> Pi r0 r1
definePi' PersistableRecordWidth r1
forall a. PersistableWidth a => PersistableRecordWidth a
persistableWidth

-- | Unsafely define projection path from type 'r0' into type 'r1'.
defineDirectPi' :: PersistableRecordWidth r1
                -> [Int]    -- ^ Indexes of flat SQL value list
                -> Pi r0 r1 -- ^ Result projection path
defineDirectPi' :: PersistableRecordWidth r1 -> [Int] -> Pi r0 r1
defineDirectPi' PersistableRecordWidth r1
pw [Int]
is = (PersistableRecordWidth r0
 -> (Pi' r0 r1, PersistableRecordWidth r1))
-> Pi r0 r1
forall r0 r1.
(PersistableRecordWidth r0
 -> (Pi' r0 r1, PersistableRecordWidth r1))
-> Pi r0 r1
Pi ((PersistableRecordWidth r0
  -> (Pi' r0 r1, PersistableRecordWidth r1))
 -> Pi r0 r1)
-> (PersistableRecordWidth r0
    -> (Pi' r0 r1, PersistableRecordWidth r1))
-> Pi r0 r1
forall a b. (a -> b) -> a -> b
$ \PersistableRecordWidth r0
_ -> ([Int] -> Pi' r0 r1
forall r0 r1. [Int] -> Pi' r0 r1
Map [Int]
is, PersistableRecordWidth r1
pw)

-- | Unsafely define projection path from type 'r0' into type 'r1'.
--   Use inferred 'PersistableRecordWidth'.
defineDirectPi :: PersistableWidth r1
               => [Int]    -- ^ Indexes of flat SQL value list
               -> Pi r0 r1 -- ^ Result projection path
defineDirectPi :: [Int] -> Pi r0 r1
defineDirectPi = PersistableRecordWidth r1 -> [Int] -> Pi r0 r1
forall r1 r0. PersistableRecordWidth r1 -> [Int] -> Pi r0 r1
defineDirectPi' PersistableRecordWidth r1
forall a. PersistableWidth a => PersistableRecordWidth a
persistableWidth