diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright George Giorgidze and Nils Schweinsberg 2010 - 2011 + +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 names of the authors nor the names of other + 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 +OWNER 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. diff --git a/Pathfinder.cabal b/Pathfinder.cabal new file mode 100644 --- /dev/null +++ b/Pathfinder.cabal @@ -0,0 +1,40 @@ +Name: Pathfinder +Version: 0.4 +Synopsis: Relational optimiser and code generator +Description: + The library provides FFI bindings to the Pathfinder relational optimiser and + code generator. Specifically, the provided functions allow for + . + * optimisation of table algebra (a variant of relational algebra) expressions + . + * and compilation of table algebra expressions into SQL:1999 queries + . + More information about Pathfinder is available from the following web page: + . + * +License: BSD3 +License-file: LICENSE +Author: George Giorgidze and Nils Schweinsberg +Maintainer: giorgidze@gmail.com +Stability: Experimental +Category: Database, FFI +Build-type: Custom + +Cabal-version: >= 1.8 + +Extra-source-files: pathfinder.tar.gz, + include/pathfinder.h + +Extra-tmp-files: pathfinder, + pathfinder_pre_build.sh, + pathfinder_post_build.sh + +Library + Build-depends: base >= 4.2 && < 5, + text >= 0.10, + bytestring >= 0.9.1.7 + Hs-source-dirs: src + GHC-options: -Wall -O3 + Include-dirs: include + Extra-libraries: xml2 + Exposed-modules: Database.Pathfinder diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,111 @@ +import Distribution.Simple +import Distribution.Simple.Program +import Distribution.Simple.Setup +import Distribution.Simple.LocalBuildInfo +import Distribution.Verbosity +import Distribution.PackageDescription +import Distribution.Text +import Distribution.System + +import System.Directory (doesFileExist) + + +main :: IO () +main = defaultMainWithHooks dshHooks + + +dshHooks :: UserHooks +dshHooks = simpleUserHooks { + preConf = dshPreConf + , preBuild = dshPreBuild + , postBuild = dshPostBuild + } + + +dshPreConf :: Args -> ConfigFlags -> IO HookedBuildInfo +dshPreConf args flags = do + db <- configureAllKnownPrograms silent defaultProgramConfiguration + _ <- requireProgram verbose (simpleProgram "sh") db + _ <- requireProgram verbose (simpleProgram "rm") db + _ <- requireProgram verbose (simpleProgram "cp") db + _ <- requireProgram verbose (simpleProgram "tar") db + _ <- requireProgram verbose (simpleProgram "pwd") db + _ <- requireProgram verbose (simpleProgram "make") db + _ <- requireProgram verbose (simpleProgram "ar") db + _ <- requireProgram verbose (simpleProgram "ld") db + + (preConf simpleUserHooks) args flags + + +dshPreBuild :: Args -> BuildFlags -> IO HookedBuildInfo +dshPreBuild args flags = do + db <- configureAllKnownPrograms silent defaultProgramConfiguration + (sh,_) <- requireProgram verbose (simpleProgram "sh") db + + let cflags = case buildArch of + I386 -> "-m32" + X86_64 -> "-m64" + PPC -> "-m32" + PPC64 -> "-m64" + Sparc -> "-m64" + Arm -> "-m32" + Mips -> "-m64" + SH -> "-m32" + IA64 -> "-m64" + S390 -> "-m32" + Alpha -> "-m64" + Hppa -> "-m64" + Rs6000 -> "-m64" + M68k -> "-m32" + Vax -> "-m32" + _ -> "" + + let script = [ "rm -r -f pathfinder" + , "tar xzf pathfinder.tar.gz" + , "cd pathfinder" + , "export CFLAGS=' " ++ cflags ++ " -fPIC -fno-jump-tables'" + , "sh configure --prefix=`pwd` --enable-static --disable-shared --with-pic" + , "make" + , "make install" + , "cd lib" + , "ar x libpf_ferry.a" + , "ld -r *.o -o CC_Pathfinder.o" + ] + + writeFile "pathfinder_pre_build.sh" (unlines script) + runProgramInvocation verbose (programInvocation sh ["pathfinder_pre_build.sh"]) + + (preBuild simpleUserHooks) args flags + + +dshPostBuild :: Args -> BuildFlags -> PackageDescription -> LocalBuildInfo -> IO () +dshPostBuild args flags desc info = do + (postBuild simpleUserHooks) args flags desc info + + let dshBuildDir = buildDir info + let dshVersion = display (pkgVersion (package desc)) + + db <- configureAllKnownPrograms silent defaultProgramConfiguration + (sh,_) <- requireProgram verbose (simpleProgram "sh") db + + pb <- doesFileExist (dshBuildDir ++ "/libHSPathfinder-" ++ dshVersion ++ "_p.a") + + let script = [ "ar -r -s " + ++ dshBuildDir ++ "/libHSPathfinder-" ++ dshVersion ++ ".a " + ++ " pathfinder/lib/CC_Pathfinder.o " + , if pb + then "ar -r -s " + ++ dshBuildDir ++ "/libHSPathfinder-" ++ dshVersion ++ "_p.a " + ++ " pathfinder/lib/CC_Pathfinder.o " + else [] + , "cp " + ++ dshBuildDir ++ "/HSPathfinder-" ++ dshVersion ++ ".o " + ++ "pathfinder/lib/HS_Pathfinder.o" + , "ld -x -r -o " + ++ dshBuildDir ++ "/HSPathfinder-" ++ dshVersion ++ ".o " + ++ " pathfinder/lib/HS_Pathfinder.o " + ++ " pathfinder/lib/CC_Pathfinder.o " + ] + + writeFile "pathfinder_post_build.sh" (unlines script) + runProgramInvocation verbose (programInvocation sh ["pathfinder_post_build.sh"]) diff --git a/include/pathfinder.h b/include/pathfinder.h new file mode 100644 --- /dev/null +++ b/include/pathfinder.h @@ -0,0 +1,7 @@ +enum PFoutput_format_t { + PFoutput_format_sql + , PFoutput_format_xml + , PFoutput_format_dot +}; + +typedef enum PFoutput_format_t PFoutput_format_t; diff --git a/pathfinder.tar.gz b/pathfinder.tar.gz new file mode 100644 # file too large to diff: pathfinder.tar.gz diff --git a/src/Database/Pathfinder.hsc b/src/Database/Pathfinder.hsc new file mode 100644 --- /dev/null +++ b/src/Database/Pathfinder.hsc @@ -0,0 +1,98 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +module Database.Pathfinder + ( + compileFerry + , compileFerryOpt + , OutputFormat (..) + , XmlString + , ErrorString + , OutputString + , OptArgs + ) where + +import Foreign +import Foreign.C + +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import qualified Data.ByteString as B + +#include + +-------------------------------------------------------------------------------- +-- Enum: OutputFormat + +newtype COutputFormat = COutputFormat { unCOutputFormat :: CInt } +#{enum COutputFormat, COutputFormat + , c_PFoutput_format_sql = PFoutput_format_sql + , c_PFoutput_format_xml = PFoutput_format_xml + , c_PFoutput_format_dot = PFoutput_format_dot +} + +data OutputFormat + = OutputSql + | OutputXml + | OutputDot + +outputFormatToCInt :: OutputFormat -> CInt +outputFormatToCInt output = unCOutputFormat $ + case output of + OutputSql -> c_PFoutput_format_sql + OutputXml -> c_PFoutput_format_xml + OutputDot -> c_PFoutput_format_dot + + +-------------------------------------------------------------------------------- +-- FFI functions + +type XmlString = String +type ErrorString = String +type OutputString = String +type OptArgs = String + + +foreign import ccall safe "PFcompile_ferry" + c'PFcompile_ferry :: Ptr CString -> CString -> CString -> CInt -> IO CInt + +-- | Accept a logical query plan bundle in XML format and transform it into one +-- of the output formats. +compileFerry :: XmlString -- ^ Input XML plan + -> OutputFormat + -> IO (Either ErrorString OutputString) +compileFerry xml output = do + B.useAsCString (T.encodeUtf8 (T.pack xml)) $ \c'xml -> + alloca $ \ptr -> alloca $ \c'err -> do + + -- run PFcompile_ferry + ci <- c'PFcompile_ferry ptr c'err c'xml (outputFormatToCInt output) + + if ci == 0 + then Right `fmap` (peek ptr >>= B.packCString >>= (return . T.unpack . T.decodeUtf8)) + else Left `fmap` (B.packCString c'err >>= (return . T.unpack . T.decodeUtf8)) + + +foreign import ccall safe "PFcompile_ferry_opt" + c'PFcompile_ferry_opt :: Ptr CString -> CString -> CString -> CInt -> CString -> IO CInt + +-- | Accept a logical query plan bundle in XML format, optimize it based on the +-- argument 'OptArgs' or (if 'Nothing') the default optimization arguments in +-- @PFopt_args@, and transform it into one of the output formats. +compileFerryOpt :: XmlString + -> OutputFormat + -> Maybe OptArgs -- ^ Optimization arguments (see pf option -o) + -> IO (Either ErrorString OutputString) +compileFerryOpt xml output optimization = do + B.useAsCString (T.encodeUtf8 (T.pack xml)) $ \c'xml -> + alloca $ \ptr -> alloca $ \c'err -> do + + -- Read optimization arguments, use nullPtr if nothing is given + opt <- maybe (return nullPtr) + newCString + optimization + + -- run PFcompile_ferry_opt + ci <- c'PFcompile_ferry_opt ptr c'err c'xml (outputFormatToCInt output) opt + if ci == 0 + then Right `fmap` (peek ptr >>= B.packCString >>= (return . T.unpack . T.decodeUtf8)) + else Left `fmap` (B.packCString c'err >>= (return . T.unpack . T.decodeUtf8))