From 607bdbbbd830ab0efdf968e0f0bb1b5d63118e68 Mon Sep 17 00:00:00 2001 From: Kei Hibino Date: Sun, 9 Jun 2013 22:27:13 +0900 Subject: [PATCH] Update document of projection operators which need GHC extensions. --- .../Relational/Query/ProjectableExtended.hs | 69 +++++++++++++++---- 1 file changed, 57 insertions(+), 12 deletions(-) diff --git a/relational-join/src/Database/Relational/Query/ProjectableExtended.hs b/relational-join/src/Database/Relational/Query/ProjectableExtended.hs index 6f6fa329..a45dc610 100644 --- a/relational-join/src/Database/Relational/Query/ProjectableExtended.hs +++ b/relational-join/src/Database/Relational/Query/ProjectableExtended.hs @@ -2,7 +2,19 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} +-- | +-- Module : Database.Relational.Query.ProjectableExtended +-- Copyright : 2013 Kei Hibino +-- License : BSD3 +-- +-- Maintainer : ex8k.hibino@gmail.com +-- Stability : experimental +-- Portability : unknown +-- +-- This module defines operators on various polymorphic projections +-- which needs extended GHC features. module Database.Relational.Query.ProjectableExtended ( + -- * Projection for nested 'Maybe's ProjectableFlattenMaybe (flatten), piMaybeFlatten, @@ -12,6 +24,7 @@ module Database.Relational.Query.ProjectableExtended ( piMaybeAggregation', (), (), (), (), + -- * Zipping projection type trick ProjectableGeneralizedZip (generalizedZip), (>?<) ) where @@ -26,26 +39,45 @@ import Database.Relational.Query.Projectable ProjectableMaybe (flattenMaybe), ProjectableZip(projectZip)) import Database.Relational.Query.Pi (Pi) + +-- | Interface to compose phantom 'Maybe' nested type. class ProjectableFlattenMaybe a b where flatten :: ProjectableMaybe p => p a -> p b +-- | Compose 'Maybe' type in projection phantom type. instance ProjectableFlattenMaybe (Maybe a) b => ProjectableFlattenMaybe (Maybe (Maybe a)) b where flatten = flatten . flattenMaybe +-- | Not 'Maybe' type is not processed. instance ProjectableFlattenMaybe (Maybe a) (Maybe a) where flatten = id -(!) :: (PersistableWidth b, Projectable p) => Projection a -> Pi a b -> p b +-- | Get narrower projection along with projection path +-- and project into result projection type. +(!) :: (PersistableWidth b, Projectable p) + => Projection a -- ^ Source projection + -> Pi a b -- ^ Projection path + -> p b -- ^ Narrower projected object p ! pi' = project $ Projection.pi p pi' +-- | Get narrower projection along with projection path +-- and project into result projection type. +-- Phantom 'Maybe' type is propagated. (?!) :: (PersistableWidth b, Projectable p) - => Projection (Maybe a) -> Pi a b -> p (Maybe b) + => Projection (Maybe a) -- ^ Source 'Projection'. 'Maybe' type + -> Pi a b -- ^ Projection path + -> p (Maybe b) -- ^ Narrower projected object. 'Maybe' type result p ?! pi' = project $ Projection.piMaybe p pi' +-- | Get narrower projection along with projection path +-- and project into result projection type. +-- Phantom 'Maybe' type is propagated. Projection path leaf is 'Maybe' case. (?!?) :: (PersistableWidth b, Projectable p) - => Projection (Maybe a) -> Pi a (Maybe b) -> p (Maybe b) + => Projection (Maybe a) -- ^ Source 'Projection'. 'Maybe' type + -> Pi a (Maybe b) -- ^ Projection path. 'Maybe' type leaf + -> p (Maybe b) -- ^ Narrower projected object. 'Maybe' type result p ?!? pi' = project $ Projection.piMaybe' p pi' piMaybeFlatten :: (PersistableWidth b, ProjectableFlattenMaybe c (Maybe a)) @@ -62,22 +94,30 @@ piMaybeAggregation' :: (PersistableWidth b, ProjectableFlattenMaybe c (Maybe a)) => Aggregation c -> Pi a b -> Aggregation (Maybe b) piMaybeAggregation' = Aggregation.piMaybe . flatten +-- | Get narrower aggregated projection along with projection path +-- and project into result projection type. () :: (PersistableWidth b, Projectable p) - => Aggregation a - -> Pi a b - -> p b + => Aggregation a -- ^ Source 'Aggregation' + -> Pi a b -- ^ Projection path + -> p b -- ^ Narrower projected object () a = projectAggregation . Aggregation.pi a +-- | Get narrower aggregated projection along with projection path +-- and project into result projection type. +-- Phantom 'Maybe' type is propagated. () :: (PersistableWidth b, Projectable p) - => Aggregation (Maybe a) - -> Pi a b - -> p (Maybe b) + => Aggregation (Maybe a) -- ^ Source 'Aggregation'. 'Maybe' type + -> Pi a b -- ^ Projection path + -> p (Maybe b) -- ^ Narrower projected object. 'Maybe' type result () a = projectAggregation . Aggregation.piMaybe a +-- | Get narrower aggregated projection along with projection path +-- and project into result projection type. +-- Phantom 'Maybe' type is propagated. Projection path leaf is 'Maybe' case. () :: (PersistableWidth b, Projectable p) - => Aggregation (Maybe a) - -> Pi a (Maybe b) - -> p (Maybe b) + => Aggregation (Maybe a) -- ^ Source 'Aggregation'. 'Maybe' type + -> Pi a (Maybe b) -- ^ Projection path. 'Maybe' type leaf + -> p (Maybe b) -- ^ Narrower projected object. 'Maybe' type result () a = projectAggregation . Aggregation.piMaybe' a () :: (PersistableWidth b, Projectable p, ProjectableFlattenMaybe c (Maybe a)) @@ -87,18 +127,23 @@ piMaybeAggregation' = Aggregation.piMaybe . flatten () a = projectAggregation . piMaybeAggregation' a +-- | Interface for Zipping type trick. class ProjectableGeneralizedZip a b c where generalizedZip :: ProjectableZip p => p a -> p b -> p c +-- | Zip right unit as zero width. instance ProjectableGeneralizedZip a () a where generalizedZip = const +-- | Zip left unit as zero width. instance ProjectableGeneralizedZip () a a where generalizedZip = const id +-- | Ordinary Zipping into tuple. instance ProjectableGeneralizedZip a b (a, b) where generalizedZip = projectZip +-- | Binary operator version of generalizedZip. (>?<) :: (ProjectableGeneralizedZip a b c, ProjectableZip p) => p a -> p b -> p c (>?<) = generalizedZip