From 0344d94343408f1ce03e752bb44439e9edc6a195 Mon Sep 17 00:00:00 2001 From: Kei Hibino Date: Mon, 12 May 2014 18:10:12 +0900 Subject: [PATCH] Divide type module into internal type module. --- sql-words/sql-words.cabal | 3 + .../src/Language/SQL/Keyword/Internal/Type.hs | 139 ++++++++++++++++++ sql-words/src/Language/SQL/Keyword/Type.hs | 116 +-------------- 3 files changed, 143 insertions(+), 115 deletions(-) create mode 100644 sql-words/src/Language/SQL/Keyword/Internal/Type.hs diff --git a/sql-words/sql-words.cabal b/sql-words/sql-words.cabal index 6881adc7..2d191bfb 100644 --- a/sql-words/sql-words.cabal +++ b/sql-words/sql-words.cabal @@ -20,6 +20,9 @@ library Language.SQL.Keyword Language.SQL.Keyword.ConcatString + other-modules: + Language.SQL.Keyword.Internal.Type + build-depends: base <5 hs-source-dirs: src ghc-options: -Wall diff --git a/sql-words/src/Language/SQL/Keyword/Internal/Type.hs b/sql-words/src/Language/SQL/Keyword/Internal/Type.hs new file mode 100644 index 00000000..63ee2436 --- /dev/null +++ b/sql-words/src/Language/SQL/Keyword/Internal/Type.hs @@ -0,0 +1,139 @@ +-- | +-- 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 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 | INTERVAL + + | Sequence DString + deriving (Read, Show) + + {- + | (:?) + | (:+) | (:-) | (:*) | (:/) + | OPEN | CLOSE + -} + + +fromDString :: DString -> Keyword +fromDString = Sequence + +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 diff --git a/sql-words/src/Language/SQL/Keyword/Type.hs b/sql-words/src/Language/SQL/Keyword/Type.hs index a1c17c32..6e07d17c 100644 --- a/sql-words/src/Language/SQL/Keyword/Type.hs +++ b/sql-words/src/Language/SQL/Keyword/Type.hs @@ -19,123 +19,9 @@ module Language.SQL.Keyword.Type ( stringMap ) where -import Data.String (IsString(fromString)) -import Data.List (find) -import Data.Monoid (Monoid (..), (<>)) +import Language.SQL.Keyword.Internal.Type (Keyword (..), word, wordShow) -newtype DString = DString (String -> String) - -dString :: String -> DString -dString = DString . (++) - -showDString :: DString -> String -showDString (DString f) = f [] - -isEmptyDString :: DString -> Bool -isEmptyDString = null . showDString - -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 | INTERVAL - - | Sequence DString - deriving (Read, Show) - - {- - | (:?) - | (:+) | (:-) | (:*) | (:/) - | OPEN | CLOSE - -} - - -fromDString :: DString -> Keyword -fromDString = Sequence - -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 - -- | Concatinate keywords into 'String' like unwords unwordsSQL :: [Keyword] -> String unwordsSQL = unwords . map wordShow