sql-words-0.1.4.1/0000755000000000000000000000000012731432033011772 5ustar0000000000000000sql-words-0.1.4.1/Setup.hs0000644000000000000000000000005612731432033013427 0ustar0000000000000000import Distribution.Simple main = defaultMain sql-words-0.1.4.1/sql-words.cabal0000644000000000000000000000360412731432033014714 0ustar0000000000000000name: sql-words version: 0.1.4.1 synopsis: Simple idea SQL keywords data constructor into OverloadedString description: This package contiains SQL keywords constructors defined as OverloadedString literals and helper functions to concate these. homepage: http://khibino.github.io/haskell-relational-record/ license: BSD3 license-file: LICENSE author: Kei Hibino maintainer: ex8k.hibino@gmail.com copyright: Copyright (c) 2013-2016 Kei Hibino category: Database build-type: Simple cabal-version: >=1.10 tested-with: GHC == 8.0.1 , GHC == 7.10.1, GHC == 7.10.2, GHC == 7.10.3 , GHC == 7.8.1, GHC == 7.8.2, GHC == 7.8.3, GHC == 7.8.4 , GHC == 7.6.1, GHC == 7.6.2, GHC == 7.6.3 , GHC == 7.4.1, GHC == 7.4.2 library exposed-modules: Language.SQL.Keyword.Type Language.SQL.Keyword.Concat Language.SQL.Keyword other-modules: Language.SQL.Keyword.Internal.Type build-depends: base >=4.5 && <5 hs-source-dirs: src ghc-options: -Wall default-language: Haskell2010 test-suite monoids build-depends: base >=4.5 && <5 , quickcheck-simple , QuickCheck >=2 , sql-words type: exitcode-stdio-1.0 main-is: monoidLaw.hs hs-source-dirs: test ghc-options: -Wall default-language: Haskell2010 source-repository head type: git location: https://github.com/khibino/haskell-relational-record source-repository head type: mercurial location: https://bitbucket.org/khibino/haskell-relational-record sql-words-0.1.4.1/LICENSE0000644000000000000000000000275612731432033013011 0ustar0000000000000000Copyright (c) 2013, Kei Hibino 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 Kei Hibino 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. sql-words-0.1.4.1/src/0000755000000000000000000000000012731432033012561 5ustar0000000000000000sql-words-0.1.4.1/src/Language/0000755000000000000000000000000012731432033014304 5ustar0000000000000000sql-words-0.1.4.1/src/Language/SQL/0000755000000000000000000000000012731432033014743 5ustar0000000000000000sql-words-0.1.4.1/src/Language/SQL/Keyword.hs0000644000000000000000000000110512731432033016720 0ustar0000000000000000-- | -- Module : Language.SQL.Keyword -- Copyright : 2013 Kei Hibino -- License : BSD3 -- -- Maintainer : ex8k.hibino@gmail.com -- Stability : experimental -- Portability : unknown -- -- SQL keyword representation using Haskell data constructors. -- Integrated module. module Language.SQL.Keyword ( -- * Module which includes keyword type definition module Language.SQL.Keyword.Type, -- * Module which includes functions to concatinate keywords module Language.SQL.Keyword.Concat ) where import Language.SQL.Keyword.Type import Language.SQL.Keyword.Concat sql-words-0.1.4.1/src/Language/SQL/Keyword/0000755000000000000000000000000012731432033016367 5ustar0000000000000000sql-words-0.1.4.1/src/Language/SQL/Keyword/Type.hs0000644000000000000000000000113212731432033017641 0ustar0000000000000000-- | -- Module : Language.SQL.Keyword.Type -- Copyright : 2013 Kei Hibino -- License : BSD3 -- -- Maintainer : ex8k.hibino@gmail.com -- Stability : experimental -- Portability : unknown -- -- SQL keyword representation using Haskell data constructors. module Language.SQL.Keyword.Type ( Keyword (..), DString, word, wordShow, unwordsSQL ) where import Data.Monoid (mconcat) import Language.SQL.Keyword.Internal.Type (Keyword (..), word, wordShow, DString) -- | Concatinate keywords into 'String' like unwords unwordsSQL :: [Keyword] -> String unwordsSQL = wordShow . mconcat sql-words-0.1.4.1/src/Language/SQL/Keyword/Concat.hs0000644000000000000000000001165012731432033020135 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} -- | -- Module : Language.SQL.Keyword.Concat -- Copyright : 2013 Kei Hibino -- License : BSD3 -- -- Maintainer : ex8k.hibino@gmail.com -- Stability : experimental -- Portability : unknown -- -- Concatinations on 'Keyword' types module Language.SQL.Keyword.Concat ( -- * List concatination functions -- $listConcatination unwords', sepBy, parenSepBy, -- * Binary operators -- $binaryOperators defineBinOp, strBinOp, as, (<.>), (|*|), (.||.), (.=.), (.<.), (.<=.), (.>.), (.>=.), (.<>.), and, or, in', (<++>), fold, -- * Unary operator defineUniOp, paren, strUniOp ) where import Prelude hiding (and, or, not) import Data.List (intersperse) import Data.Monoid (mempty, mconcat, (<>)) import Language.SQL.Keyword.Internal.Type (Keyword (..), word, wordShow, toDString, fromDString) {- $listConcatination Functions to concatinate 'Keyword' list. -} -- | Separate 'Keyword' list with delimiter 'Keyword' and map to 'String' list. sepBy' :: [Keyword] -> Keyword -> [String] ws `sepBy'` d = map wordShow . intersperse d $ ws -- | Concatinate 'Keyword' list like unwords on 'String' list. unwords' :: [Keyword] -> Keyword unwords' = mconcat -- | Concatinate 'String' list into one 'Keyword'. concatStr :: [String] -> Keyword concatStr = word . concat -- | Separate 'Keyword' list with delimiter 'Keyword' and concatinate into one 'Keyword'. sepBy :: [Keyword] -> Keyword -> Keyword ws `sepBy` d = concatStr $ ws `sepBy'` d -- | Do 'sepBy' and enclose by paren parenSepBy :: [Keyword] -> Keyword -> Keyword ws `parenSepBy` d = concatStr $ "(" : (ws `sepBy'` d) ++ [")"] {- $binaryOperators Binary operators on SQL. Result is concatinated into one 'Keyword'. -} -- | Directly concatinate SQL string without whitespaces. (<++>) :: Keyword -> Keyword -> Keyword x <++> y = fromDString $ toDString x <> toDString y concat' :: [Keyword] -> Keyword concat' = fromDString . mconcat . map toDString -- | Define binary operator on 'Keyword' type. -- Result is not delimited by whitespace like concat on 'String' list. defineBinOp' :: Keyword -> Keyword -> Keyword -> Keyword defineBinOp' op a b = concat' [a, op, b] -- | Define binary operator on 'Keyword' type. -- Result is delimited by whitespace like unwords on 'String' list. defineBinOp :: Keyword -> Keyword -> Keyword -> Keyword defineBinOp op a b = mconcat [a, op, b] -- | Binary operator to create qualified name on SQL. (<.>) :: Keyword -> Keyword -> Keyword (<.>) = defineBinOp' "." -- | Binary operator to create comma separated words. (|*|) :: Keyword -> Keyword -> Keyword (|*|) = defineBinOp' ", " -- | Binary operator for SQL string expression concatination. (.||.) :: Keyword -> Keyword -> Keyword (.||.) = defineBinOp "||" -- | Binary eq operator for SQL expression. (.=.) :: Keyword -> Keyword -> Keyword (.=.) = defineBinOp "=" -- | Binary not eq operator for SQL expression. (.<>.) :: Keyword -> Keyword -> Keyword (.<>.) = defineBinOp "<>" -- | Binary lt operator for SQL expression. (.<.) :: Keyword -> Keyword -> Keyword (.<.) = defineBinOp "<" -- | Binary le operator for SQL expression. (.<=.) :: Keyword -> Keyword -> Keyword (.<=.) = defineBinOp "<=" -- | Binary gt operator for SQL expression. (.>.) :: Keyword -> Keyword -> Keyword (.>.) = defineBinOp ">" -- | Binary ge operator for SQL expression. (.>=.) :: Keyword -> Keyword -> Keyword (.>=.) = defineBinOp ">=" -- | Binary operator for SQL name alias. as :: Keyword -> Keyword -> Keyword as = defineBinOp AS -- | Binary `AND` operator for SQL boolean expression. and :: Keyword -> Keyword -> Keyword and = defineBinOp AND -- | Binary `OR` operator for SQL boolean expression. or :: Keyword -> Keyword -> Keyword or = defineBinOp OR -- | Fold operation using binary operator with empty result of zero length case. fold :: (Keyword -> Keyword -> Keyword) -- ^ Binary operator used in fold -> [Keyword] -- ^ List to fold -> Keyword -- ^ Result fold op = d where d [] = mempty d xs@(_:_) = foldr1 op xs -- | Define unary operator on 'Keyword' type represeted by specified 'Keyword'. -- Result is delimited by whitespace like unwords on 'String' list. defineUniOp :: Keyword -> Keyword -> Keyword defineUniOp op e = mconcat [op, e] -- | Uni operator to create Parend words. paren :: Keyword -> Keyword paren w = concat' ["(", w, ")"] -- | Binary `IN` operator for SQL. in' :: Keyword -> Keyword -> Keyword in' = defineBinOp IN infixr 5 .||. infixr 4 .=., .<., .<=., .>., .>=., .<>. infix 4 `in'` infixr 3 `and` infixr 2 `or` infixr 1 |*| -- | Define uni operator of string from 'Keyword' uni operator. strUniOp :: (Keyword -> Keyword) -> String -> String strUniOp u = wordShow . u . word -- | Define binary operator of string from 'Keyword' binary operator. strBinOp :: (Keyword -> Keyword -> Keyword) -> String -> String -> String strBinOp op a b = wordShow $ op (word a) (word b) sql-words-0.1.4.1/src/Language/SQL/Keyword/Internal/0000755000000000000000000000000012731432033020143 5ustar0000000000000000sql-words-0.1.4.1/src/Language/SQL/Keyword/Internal/Type.hs0000644000000000000000000000723312731432033021425 0ustar0000000000000000-- | -- Module : Language.SQL.Keyword.Internal.Type -- Copyright : 2013 Kei Hibino -- License : BSD3 -- -- Maintainer : ex8k.hibino@gmail.com -- Stability : experimental -- Portability : unknown -- -- This module defines package internal types. module Language.SQL.Keyword.Internal.Type ( -- * SQL keyword type interface. Keyword (..), word, wordShow, -- * Low-level diff string interface. fromDString, toDString, DString, dString, showDString, isEmptyDString ) where import Data.String (IsString(..)) import Data.List (find) import Data.Monoid (Monoid (..), (<>)) -- | Diff String type for low-cost concatination. newtype DString = DString (String -> String) -- | Make 'DString' from 'String' dString :: String -> DString dString = DString . (++) -- | Show 'DString' into 'String' showDString :: DString -> String showDString (DString f) = f [] -- | 'DString' is empty or not. isEmptyDString :: DString -> Bool isEmptyDString = null . showDString instance Eq DString where x == y = showDString x == showDString y instance Show DString where show = showDString instance Read DString where readsPrec _ s = [(dString s, [])] instance Monoid DString where mempty = DString id DString f `mappend` DString g = DString $ f . g dspace :: DString dspace = dString " " -- | Type represent SQL keywords. data Keyword = SELECT | ALL | DISTINCT | ON | GROUP | COUNT | SUM | AVG | MAX | MIN | EVERY | ANY | SOME | ORDER | BY | ASC | DESC | CUBE | ROLLUP | GROUPING | SETS | HAVING | FOR | LIMIT | FETCH | FIRST | NEXT | ROW | ROWS | ONLY | UNION | EXCEPT | INTERSECT | DELETE | USING | RETURNING | FROM | AS | WITH | JOIN | INNER | LEFT | RIGHT | FULL | NATURAL | OUTER | UPDATE | SET | DEFAULT | WHERE | INSERT | INTO | VALUES | MERGE | OVER | PARTITION | DENSE_RANK | RANK | ROW_NUMBER | PERCENT_RANK | CUME_DIST | LAG | LEAD | FIRST_VALUE | LAST_VALUE | CASE | END | WHEN | ELSE | THEN | LIKE | SIMILAR | AND | OR | NOT | EXISTS | IS | NULL | IN | DATE | TIME | TIMESTAMP | TIMESTAMPTZ | INTERVAL | Sequence !DString deriving (Read, Show) {- | (:?) | (:+) | (:-) | (:*) | (:/) | OPEN | CLOSE -} -- | Wrap 'DString' into 'Keyword' fromDString :: DString -> Keyword fromDString = Sequence -- | Unwrap 'Keyword' into 'DString' toDString :: Keyword -> DString toDString = d where d (Sequence ds) = ds d w = dString $ show w -- | Make 'Keyword' from String word :: String -> Keyword word = fromDString . dString -- | 'Keyword' type with OverloadedString extension, -- can be involved same list with string literals. -- -- > selectFoo = [SELECT, "a, b, c", FROM, "foo"] -- instance IsString Keyword where fromString s' = found (find ((== "") . snd) (reads s')) s' where found Nothing s = word s found (Just (w, _)) _ = w -- | 'Keyword' default concatination separate by space. instance Monoid Keyword where mempty = fromDString mempty a `mappend` b = fromDString $ toDString a `append'` toDString b where append' p q | isEmptyDString p = q | isEmptyDString q = p | otherwise = p <> dspace <> q -- | Show 'Keyword' wordShow :: Keyword -> String wordShow = d where d (Sequence s) = showDString s d w = show w instance Eq Keyword where x == y = wordShow x == wordShow y sql-words-0.1.4.1/test/0000755000000000000000000000000012731432033012751 5ustar0000000000000000sql-words-0.1.4.1/test/monoidLaw.hs0000644000000000000000000000254412731432033015243 0ustar0000000000000000{-# OPTIONS -fno-warn-orphans #-} import Language.SQL.Keyword (Keyword, DString) import Data.Monoid (Monoid, mempty, (<>)) import Data.String (fromString) import Test.QuickCheck (Arbitrary (..), Testable) import Test.QuickCheck.Simple (Test, qcTest, defaultMain) prop :: Testable prop => String -> prop -> Test prop = qcTest leftId :: (Eq a, Monoid a) => a -> Bool leftId a = mempty <> a == a rightId :: (Eq a, Monoid a) => a -> Bool rightId a = a <> mempty == a assoc :: (Eq a, Monoid a) => a -> a -> a -> Bool assoc a b c = (a <> b) <> c == a <> (b <> c) dsLeftId :: DString -> Bool dsLeftId = leftId dsRightId :: DString -> Bool dsRightId = rightId dsAssoc :: DString -> DString -> DString -> Bool dsAssoc = assoc instance Arbitrary DString where arbitrary = fmap read arbitrary kwLeftId :: Keyword -> Bool kwLeftId = leftId kwRightId :: Keyword -> Bool kwRightId = rightId kwAssoc :: Keyword -> Keyword -> Keyword -> Bool kwAssoc = assoc instance Arbitrary Keyword where arbitrary = fmap fromString arbitrary tests :: [Test] tests = [ prop "DString left Id" dsLeftId , prop "DString right Id" dsRightId , prop "DString associativity" dsAssoc , prop "Keyword left Id" kwLeftId , prop "Keyword right Id" kwRightId , prop "Keyword associativity" kwAssoc ] main :: IO () main = defaultMain tests