diff --git a/relational-join/src/Database/Relational/Query/Pi.hs b/relational-join/src/Database/Relational/Query/Pi.hs index 1fa4ce74..e25413cf 100644 --- a/relational-join/src/Database/Relational/Query/Pi.hs +++ b/relational-join/src/Database/Relational/Query/Pi.hs @@ -1,12 +1,26 @@ +-- | +-- Module : Database.Relational.Query.Pi +-- Copyright : 2013 Kei Hibino +-- License : BSD3 +-- +-- Maintainer : ex8k.hibino@gmail.com +-- Stability : experimental +-- Portability : unknown +-- +-- This module defines typed projection path objects. +-- Contains normal interfaces. module Database.Relational.Query.Pi ( - PiUnit, - pairPiFstUnit, pairPiSndUnit, - - fst'', snd'', - fst', snd', - + -- * Projection path Pi((:*)), leafIndex, + + fst', snd', + + -- * Projection path unit + PiUnit, offset, + pairPiFstUnit, pairPiSndUnit, + + fst'', snd'' ) where import Database.Record @@ -18,30 +32,38 @@ import Database.Relational.Query.Pi.Unsafe (PiUnit, offset, Pi ((:*), Leaf), definePiUnit) +-- | Get index of flat SQL value list from typed projection path. leafIndex :: Pi r f -> Int leafIndex = rec where rec :: Pi r f -> Int rec (Leaf pi0) = offset pi0 rec (pi0 :* x) = offset pi0 + rec x +-- | Projection path unit like fst of tuple. pairPiFstUnit :: PiUnit (c a b) a pairPiFstUnit = definePiUnit 0 +-- | Devivation rule of projection path unit like snd of tuple. pairPiSndUnit' :: PersistableRecordWidth a -> PiUnit (c a b) b pairPiSndUnit' pw = definePiUnit (runPersistableRecordWidth pw) +-- | Devivated projection path unit like snd of tuple. pairPiSndUnit :: PersistableWidth a => PiUnit (c a b) b pairPiSndUnit = pairPiSndUnit' persistableWidth +-- | Projection path unit for fst of tuple. fst'' :: PiUnit (a, b) a fst'' = pairPiFstUnit +-- | Projection path unit for snd of tuple. snd'' :: PersistableWidth a => PiUnit (a, b) b snd'' = pairPiSndUnit +-- | Projection path for fst of tuple. fst' :: Pi (a, b) a fst' = Leaf fst'' +-- | Projection path for snd of tuple. snd' :: PersistableWidth a => Pi (a, b) b snd' = Leaf snd'' diff --git a/relational-join/src/Database/Relational/Query/Pi/Unsafe.hs b/relational-join/src/Database/Relational/Query/Pi/Unsafe.hs index cc476772..dba9cce0 100644 --- a/relational-join/src/Database/Relational/Query/Pi/Unsafe.hs +++ b/relational-join/src/Database/Relational/Query/Pi/Unsafe.hs @@ -1,30 +1,50 @@ {-# LANGUAGE ExistentialQuantification #-} +-- | +-- Module : Database.Relational.Query.Pi.Unsafe +-- Copyright : 2013 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.Query.Pi.Unsafe ( + -- * Projection path unit PiUnit, offset, definePiUnit, + -- * Projection path Pi ((:*), Leaf), defineColumn ) where -newtype PiUnit r ft = PiUnit Int --- data PiUnit r ft = PiUnit +-- | Projection path unit from record type 'r' into column type 'ct'. +newtype PiUnit r ct = PiUnit Int +-- data PiUnit r ct = PiUnit -- { offset :: Int --- , column :: Column r ft +-- , column :: Column r ct -- } -offset :: PiUnit r ft -> Int +-- | Get index of flat SQL value list from typed projection path unit. +offset :: PiUnit r ct -> Int offset (PiUnit off) = off -data Pi r ft = forall r' . PiUnit r r' :* Pi r' ft - | Leaf (PiUnit r ft) +-- | Projection path from record type 'r' into column type 'ct'. +data Pi r ct = forall r' . PiUnit r r' :* Pi r' ct + | Leaf (PiUnit r ct) infixr 9 :* -defineColumn :: Int -> Pi r ft +-- | Unsafely define projection path from record type 'r' into column type 'ct'. +defineColumn :: Int -- ^ Index of flat SQL value list + -> Pi r ct -- ^ Result projection path defineColumn = Leaf . PiUnit -definePiUnit :: Int -> PiUnit r ft +-- | Unsafely define projection path unit from record type 'r' into column type 'ct'. +definePiUnit :: Int -- ^ Index of flat SQL value list + -> PiUnit r ct -- ^ Result projection path definePiUnit = PiUnit