-- |
-- Module      : Language.SQL.Keyword.Internal.Type
-- Copyright   : 2013-2019 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.Semigroup (Semigroup (..))
import Data.Monoid (Monoid (..))


-- | Diff String type for low-cost concatination.
newtype DString = DString (String -> String)

-- | Make 'DString' from 'String'
dString :: String -> DString
dString :: String -> DString
dString =  (String -> String) -> DString
DString ((String -> String) -> DString)
-> (String -> String -> String) -> String -> DString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
forall a. [a] -> [a] -> [a]
(++)

-- | Show 'DString' into 'String'
showDString :: DString -> String
showDString :: DString -> String
showDString (DString String -> String
f) = String -> String
f []

-- | 'DString' is empty or not.
isEmptyDString :: DString -> Bool
isEmptyDString :: DString -> Bool
isEmptyDString = String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (String -> Bool) -> (DString -> String) -> DString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DString -> String
showDString

instance Eq DString where
  DString
x == :: DString -> DString -> Bool
== DString
y = DString -> String
showDString DString
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== DString -> String
showDString DString
y

instance Show DString where
  show :: DString -> String
show = DString -> String
showDString

instance Read DString where
  readsPrec :: Int -> ReadS DString
readsPrec Int
_ String
s = [(String -> DString
dString String
s, [])]

dappend :: DString -> DString -> DString
DString String -> String
f dappend :: DString -> DString -> DString
`dappend` DString String -> String
g = (String -> String) -> DString
DString ((String -> String) -> DString) -> (String -> String) -> DString
forall a b. (a -> b) -> a -> b
$ String -> String
f (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
g

instance Semigroup DString where
  <> :: DString -> DString -> DString
(<>) = DString -> DString -> DString
dappend

instance Monoid DString where
  mempty :: DString
mempty  = (String -> String) -> DString
DString String -> String
forall a. a -> a
id
  mappend :: DString -> DString -> DString
mappend = DString -> DString -> DString
forall a. Semigroup a => a -> a -> a
(<>)

-- | Type represent SQL keywords.
data Keyword = SELECT | ALL | DISTINCT | ON
             | GROUP | COUNT | SUM | AVG | MAX | MIN | EVERY | ANY | SOME
             | CUBE | ROLLUP | GROUPING | SETS | HAVING
             | FOR

             | ORDER | BY | ASC | DESC | NULLS | LAST

             | OFFSET
             | LIMIT
             | FETCH | FIRST | NEXT | PERCENT
             | ROW | ROWS | ONLY | TIES

             | 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 (ReadPrec [Keyword]
ReadPrec Keyword
Int -> ReadS Keyword
ReadS [Keyword]
(Int -> ReadS Keyword)
-> ReadS [Keyword]
-> ReadPrec Keyword
-> ReadPrec [Keyword]
-> Read Keyword
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Keyword
readsPrec :: Int -> ReadS Keyword
$creadList :: ReadS [Keyword]
readList :: ReadS [Keyword]
$creadPrec :: ReadPrec Keyword
readPrec :: ReadPrec Keyword
$creadListPrec :: ReadPrec [Keyword]
readListPrec :: ReadPrec [Keyword]
Read, Int -> Keyword -> String -> String
[Keyword] -> String -> String
Keyword -> String
(Int -> Keyword -> String -> String)
-> (Keyword -> String)
-> ([Keyword] -> String -> String)
-> Show Keyword
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Keyword -> String -> String
showsPrec :: Int -> Keyword -> String -> String
$cshow :: Keyword -> String
show :: Keyword -> String
$cshowList :: [Keyword] -> String -> String
showList :: [Keyword] -> String -> String
Show)

             {-
                  | (:?)
                  | (:+) | (:-) | (:*) | (:/)
                  | OPEN | CLOSE
             -}


-- | Wrap 'DString' into 'Keyword'
fromDString :: DString -> Keyword
fromDString :: DString -> Keyword
fromDString =  DString -> Keyword
Sequence

-- | Unwrap 'Keyword' into 'DString'
toDString :: Keyword -> DString
toDString :: Keyword -> DString
toDString = Keyword -> DString
d  where
  d :: Keyword -> DString
d (Sequence DString
ds) = DString
ds
  d  Keyword
w            = String -> DString
dString (String -> DString) -> String -> DString
forall a b. (a -> b) -> a -> b
$ Keyword -> String
forall a. Show a => a -> String
show Keyword
w

-- | Make 'Keyword' from String
word :: String -> Keyword
word :: String -> Keyword
word =  DString -> Keyword
fromDString (DString -> Keyword) -> (String -> DString) -> String -> Keyword
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> DString
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 :: String -> Keyword
fromString String
s' = Maybe (Keyword, String) -> String -> Keyword
forall {b}. Maybe (Keyword, b) -> String -> Keyword
found (((Keyword, String) -> Bool)
-> [(Keyword, String)] -> Maybe (Keyword, String)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"") (String -> Bool)
-> ((Keyword, String) -> String) -> (Keyword, String) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Keyword, String) -> String
forall a b. (a, b) -> b
snd) (ReadS Keyword
forall a. Read a => ReadS a
reads String
s')) String
s'  where
   found :: Maybe (Keyword, b) -> String -> Keyword
found  Maybe (Keyword, b)
Nothing      String
s = String -> Keyword
word String
s
   found (Just (Keyword
w, b
_)) String
_ = Keyword
w

kappend :: Keyword -> Keyword -> Keyword
Keyword
a kappend :: Keyword -> Keyword -> Keyword
`kappend` Keyword
b = DString -> Keyword
fromDString (DString -> Keyword) -> DString -> Keyword
forall a b. (a -> b) -> a -> b
$ Keyword -> DString
toDString Keyword
a DString -> DString -> DString
`append'` Keyword -> DString
toDString Keyword
b
  where
    append' :: DString -> DString -> DString
append' DString
p DString
q
      | DString -> Bool
isEmptyDString DString
p = DString
q
      | DString -> Bool
isEmptyDString DString
q = DString
p
      | Bool
otherwise        = DString
p DString -> DString -> DString
forall a. Semigroup a => a -> a -> a
<> DString
dspace DString -> DString -> DString
forall a. Semigroup a => a -> a -> a
<> DString
q
    dspace :: DString
    dspace :: DString
dspace =  String -> DString
dString String
" "

instance Semigroup Keyword where
  <> :: Keyword -> Keyword -> Keyword
(<>) = Keyword -> Keyword -> Keyword
kappend

-- | 'Keyword' default concatination separate by space.
instance Monoid Keyword where
  mempty :: Keyword
mempty  = DString -> Keyword
fromDString DString
forall a. Monoid a => a
mempty
  mappend :: Keyword -> Keyword -> Keyword
mappend = Keyword -> Keyword -> Keyword
forall a. Semigroup a => a -> a -> a
(<>)


-- | Show 'Keyword'
wordShow :: Keyword -> String
wordShow :: Keyword -> String
wordShow =  Keyword -> String
d  where
  d :: Keyword -> String
d (Sequence DString
s)   = DString -> String
showDString DString
s
  d Keyword
w              = Keyword -> String
forall a. Show a => a -> String
show Keyword
w

instance Eq Keyword where
  Keyword
x == :: Keyword -> Keyword -> Bool
== Keyword
y = Keyword -> String
wordShow Keyword
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Keyword -> String
wordShow Keyword
y