mirror of
https://github.com/khibino/haskell-relational-record.git
synced 2024-11-29 14:45:51 +03:00
sql-words: add Semigroup instance for GHC 8.4.x.
This commit is contained in:
parent
3e3853f76b
commit
8cd78d7c7a
@ -29,6 +29,8 @@ library
|
||||
Language.SQL.Keyword.Internal.Type
|
||||
|
||||
build-depends: base >=4.5 && <5
|
||||
if impl(ghc < 8)
|
||||
build-depends: semigroups
|
||||
hs-source-dirs: src
|
||||
ghc-options: -Wall
|
||||
|
||||
|
@ -19,7 +19,8 @@ module Language.SQL.Keyword.Internal.Type (
|
||||
|
||||
import Data.String (IsString(..))
|
||||
import Data.List (find)
|
||||
import Data.Monoid (Monoid (..), (<>))
|
||||
import Data.Semigroup (Semigroup (..))
|
||||
import Data.Monoid (Monoid (..))
|
||||
|
||||
|
||||
-- | Diff String type for low-cost concatination.
|
||||
@ -46,12 +47,15 @@ instance Show DString where
|
||||
instance Read DString where
|
||||
readsPrec _ s = [(dString s, [])]
|
||||
|
||||
dappend :: DString -> DString -> DString
|
||||
DString f `dappend` DString g = DString $ f . g
|
||||
|
||||
instance Semigroup DString where
|
||||
(<>) = dappend
|
||||
|
||||
instance Monoid DString where
|
||||
mempty = DString id
|
||||
DString f `mappend` DString g = DString $ f . g
|
||||
|
||||
dspace :: DString
|
||||
dspace = dString " "
|
||||
mappend = dappend
|
||||
|
||||
-- | Type represent SQL keywords.
|
||||
data Keyword = SELECT | ALL | DISTINCT | ON
|
||||
@ -130,14 +134,23 @@ instance IsString Keyword 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
|
||||
kappend :: Keyword -> Keyword -> Keyword
|
||||
a `kappend` b = fromDString $ toDString a `append'` toDString b
|
||||
where
|
||||
append' p q
|
||||
| isEmptyDString p = q
|
||||
| isEmptyDString q = p
|
||||
| otherwise = p <> dspace <> q
|
||||
dspace :: DString
|
||||
dspace = dString " "
|
||||
|
||||
instance Semigroup Keyword where
|
||||
(<>) = kappend
|
||||
|
||||
-- | 'Keyword' default concatination separate by space.
|
||||
instance Monoid Keyword where
|
||||
mempty = fromDString mempty
|
||||
mappend = kappend
|
||||
|
||||
|
||||
-- | Show 'Keyword'
|
||||
|
Loading…
Reference in New Issue
Block a user