-- Copyright (c) 2010, Diego Souza -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without -- modification, are permitted provided that the following conditions are met: -- -- * Redistributions of source code must retain the above copyright notice, -- this list of conditions and the following disclaimer. -- * Redistributions in binary form must reproduce the above copyright notice, -- this list of conditions and the following disclaimer in the documentation -- and/or other materials provided with the distribution. -- * Neither the name of the nor the names of its contributors -- may be used to endorse or promote products derived from this software -- without specific prior written permission. -- -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND -- ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED -- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE -- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE -- FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR -- SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER -- CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, -- OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. module Yql.Core.LocalFunction ( Database , Pipeline() , Exec(..) , man , pipeline , ld' , execBefore , execAfter , execTransform , execBefore_ , execAfter_ , execTransform_ ) where import Yql.Core.Types import Network.OAuth.Http.Request import Network.OAuth.Http.Response import qualified Data.Map as M import Control.Monad type Database = M.Map String Exec newtype Pipeline = Pipeline { runPipeline :: Exec } -- | Local functions that may change a given yql query data Exec = Before (String -> String) ([(String,Value)] -> Request -> Request) | After (String -> String) ([(String,Value)] -> Response -> Response) | Transform (String -> String) ([(String,Value)] -> String -> String) | Seq Exec Exec | NOp -- | The documentation of a given function man :: Exec -> String -> String man (Before doc _) = doc man (After doc _) = doc man (Transform doc _) = doc man _ = error "man: not found" -- | Transforms a list of functions into a pipeline using a given linker. pipeline :: Monad m => Database -> [Function] -> m Pipeline pipeline db funcs = do exec <- pipeline' funcs return (Pipeline exec) where pipeline' [] = return NOp pipeline' (f:fs) = case (M.lookup (name f) db) of Nothing -> fail $ "unknown function: " ++ name f Just ex -> liftM (bind (args f) ex `Seq`) (pipeline' fs) bind argv (Before d f) = Before d (const $ f argv) bind argv (After d f) = After d (const $ f argv) bind argv (Transform d f) = Transform d (const $ f argv) bind _ x = x -- | Extracts the local functions from the statement and creates a pipeline. ld' :: (Monad m) => Database -> Expression -> m Pipeline ld' l stmt = let fs = filter local (functions stmt) in pipeline l fs execTransform :: [(String,Value)] -> Exec -> String -> String execTransform argv (Transform _ f) s = f argv s execTransform argv (Seq fa fb) s = execTransform argv fb (execTransform argv fa s) execTransform _ _ s = s execTransform_ :: Pipeline -> String -> String execTransform_ = execTransform [] . runPipeline execBefore :: [(String,Value)] -> Exec -> Request -> Request execBefore argv (Before _ f) r = f argv r execBefore argv (Seq fa fb) r = execBefore argv fb (execBefore argv fa r) execBefore _ _ r = r execBefore_ :: Pipeline -> Request -> Request execBefore_ = execBefore [] . runPipeline execAfter :: [(String,Value)] -> Exec -> Response -> Response execAfter argv (After _ f) r = f argv r execAfter argv (Seq fa fb) r = execAfter argv fb (execAfter argv fa r) execAfter _ _ r = r execAfter_ :: Pipeline -> Response -> Response execAfter_ = execAfter [] . runPipeline