{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# LANGUAGE GADTs, TypeOperators, TypeFamilies, FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances, DeriveGeneric, OverloadedStrings #-}
{-# LANGUAGE CPP #-}
-- | Basic Selda types.
module Database.Selda.Types
  ( (:*:)(..), Head, Tup (..)
  , first, second, third, fourth, fifth
  , ColName, TableName
  , modColName, mkColName, mkTableName, addColSuffix, addColPrefix
  , fromColName, fromTableName, rawTableName, intercalateColNames
  ) where
import Data.Dynamic ( Typeable )
import Data.String ( IsString )
import Data.Text (Text, replace, append, intercalate)
import GHC.Generics (Generic)

-- | Name of a database column.
newtype ColName = ColName { ColName -> Text
unColName :: Text }
  deriving (Eq ColName
ColName -> ColName -> Bool
ColName -> ColName -> Ordering
ColName -> ColName -> ColName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ColName -> ColName -> ColName
$cmin :: ColName -> ColName -> ColName
max :: ColName -> ColName -> ColName
$cmax :: ColName -> ColName -> ColName
>= :: ColName -> ColName -> Bool
$c>= :: ColName -> ColName -> Bool
> :: ColName -> ColName -> Bool
$c> :: ColName -> ColName -> Bool
<= :: ColName -> ColName -> Bool
$c<= :: ColName -> ColName -> Bool
< :: ColName -> ColName -> Bool
$c< :: ColName -> ColName -> Bool
compare :: ColName -> ColName -> Ordering
$ccompare :: ColName -> ColName -> Ordering
Ord, ColName -> ColName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColName -> ColName -> Bool
$c/= :: ColName -> ColName -> Bool
== :: ColName -> ColName -> Bool
$c== :: ColName -> ColName -> Bool
Eq, Int -> ColName -> ShowS
[ColName] -> ShowS
ColName -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColName] -> ShowS
$cshowList :: [ColName] -> ShowS
show :: ColName -> String
$cshow :: ColName -> String
showsPrec :: Int -> ColName -> ShowS
$cshowsPrec :: Int -> ColName -> ShowS
Show, String -> ColName
forall a. (String -> a) -> IsString a
fromString :: String -> ColName
$cfromString :: String -> ColName
IsString)

-- | Name of a database table.
newtype TableName = TableName Text
  deriving (Eq TableName
TableName -> TableName -> Bool
TableName -> TableName -> Ordering
TableName -> TableName -> TableName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TableName -> TableName -> TableName
$cmin :: TableName -> TableName -> TableName
max :: TableName -> TableName -> TableName
$cmax :: TableName -> TableName -> TableName
>= :: TableName -> TableName -> Bool
$c>= :: TableName -> TableName -> Bool
> :: TableName -> TableName -> Bool
$c> :: TableName -> TableName -> Bool
<= :: TableName -> TableName -> Bool
$c<= :: TableName -> TableName -> Bool
< :: TableName -> TableName -> Bool
$c< :: TableName -> TableName -> Bool
compare :: TableName -> TableName -> Ordering
$ccompare :: TableName -> TableName -> Ordering
Ord, TableName -> TableName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TableName -> TableName -> Bool
$c/= :: TableName -> TableName -> Bool
== :: TableName -> TableName -> Bool
$c== :: TableName -> TableName -> Bool
Eq, Int -> TableName -> ShowS
[TableName] -> ShowS
TableName -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TableName] -> ShowS
$cshowList :: [TableName] -> ShowS
show :: TableName -> String
$cshow :: TableName -> String
showsPrec :: Int -> TableName -> ShowS
$cshowsPrec :: Int -> TableName -> ShowS
Show, String -> TableName
forall a. (String -> a) -> IsString a
fromString :: String -> TableName
$cfromString :: String -> TableName
IsString)

-- | Modify the given column name using the given function.
modColName :: ColName -> (Text -> Text) -> ColName
modColName :: ColName -> (Text -> Text) -> ColName
modColName (ColName Text
cn) Text -> Text
f = Text -> ColName
ColName (Text -> Text
f Text
cn)

-- | Add a prefix to a column name.
addColPrefix :: ColName -> Text -> ColName
addColPrefix :: ColName -> Text -> ColName
addColPrefix (ColName Text
cn) Text
s = Text -> ColName
ColName forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
Data.Text.append Text
s Text
cn

-- | Add a suffix to a column name.
addColSuffix :: ColName -> Text -> ColName
addColSuffix :: ColName -> Text -> ColName
addColSuffix (ColName Text
cn) Text
s = Text -> ColName
ColName forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
Data.Text.append Text
cn Text
s

-- | Convert a column name into a string, with quotes.
fromColName :: ColName -> Text
fromColName :: ColName -> Text
fromColName (ColName Text
cn) = forall a. Monoid a => [a] -> a
mconcat [Text
"\"", Text -> Text
escapeQuotes Text
cn, Text
"\""]

-- | Convert column names into a string, without quotes, intercalating the given
-- string.
--
-- @
-- intercalateColNames "_" [ColName "a", ColName "b"] == "a_b"
-- @
intercalateColNames :: Text -> [ColName] -> Text
intercalateColNames :: Text -> [ColName] -> Text
intercalateColNames Text
inter [ColName]
cs = Text -> [Text] -> Text
intercalate Text
inter (Text -> Text
escapeQuotes forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColName -> Text
unColName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ColName]
cs)

-- | Convert a table name into a string, with quotes.
fromTableName :: TableName -> Text
fromTableName :: TableName -> Text
fromTableName (TableName Text
tn) = forall a. Monoid a => [a] -> a
mconcat [Text
"\"", Text -> Text
escapeQuotes Text
tn, Text
"\""]

-- | Convert a table name into a string, without quotes.
rawTableName :: TableName -> Text
rawTableName :: TableName -> Text
rawTableName (TableName Text
tn) = Text -> Text
escapeQuotes Text
tn

-- | Create a column name.
mkColName :: Text -> ColName
mkColName :: Text -> ColName
mkColName = Text -> ColName
ColName

-- | Create a column name.
mkTableName :: Text -> TableName
mkTableName :: Text -> TableName
mkTableName = Text -> TableName
TableName

-- | Escape double quotes in an SQL identifier.
escapeQuotes :: Text -> Text
escapeQuotes :: Text -> Text
escapeQuotes = Text -> Text -> Text -> Text
Data.Text.replace Text
"\"" Text
"\"\""

-- | An inductively defined "tuple", or heterogeneous, non-empty list.
data a :*: b where
  (:*:) :: a -> b -> a :*: b
  deriving (Typeable, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a b x. Rep (a :*: b) x -> a :*: b
forall a b x. (a :*: b) -> Rep (a :*: b) x
$cto :: forall a b x. Rep (a :*: b) x -> a :*: b
$cfrom :: forall a b x. (a :*: b) -> Rep (a :*: b) x
Generic)
infixr 1 :*:

instance (Show a, Show b) => Show (a :*: b) where
  show :: (a :*: b) -> String
show (a
a :*: b
b) = forall a. Show a => a -> String
show a
a forall a. [a] -> [a] -> [a]
++ String
" :*: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show b
b

instance (Eq a, Eq b) => Eq (a :*: b) where
  (a
a :*: b
b) == :: (a :*: b) -> (a :*: b) -> Bool
== (a
a' :*: b
b') = a
a forall a. Eq a => a -> a -> Bool
== a
a' Bool -> Bool -> Bool
&& b
b forall a. Eq a => a -> a -> Bool
== b
b'

instance (Ord a, Ord b) => Ord (a :*: b) where
  (a
a :*: b
b) compare :: (a :*: b) -> (a :*: b) -> Ordering
`compare` (a
a' :*: b
b') =
    case a
a forall a. Ord a => a -> a -> Ordering
`compare` a
a' of
      Ordering
EQ -> b
b forall a. Ord a => a -> a -> Ordering
`compare` b
b'
      Ordering
o  -> Ordering
o

type family Head a where
  Head (a :*: b) = a
  Head a         = a

class Tup a where
  tupHead :: a -> Head a

instance {-# OVERLAPPING #-} Tup (a :*: b) where
  tupHead :: (a :*: b) -> Head (a :*: b)
tupHead (a
a :*: b
_) = a
a

instance Head a ~ a => Tup a where
  tupHead :: a -> Head a
tupHead a
a = a
a

-- | Get the first element of an inductive tuple.
first :: Tup a => a -> Head a
first :: forall a. Tup a => a -> Head a
first = forall a. Tup a => a -> Head a
tupHead

-- | Get the second element of an inductive tuple.
second :: Tup b => (a :*: b) -> Head b
second :: forall b a. Tup b => (a :*: b) -> Head b
second (a
_ :*: b
b) = forall a. Tup a => a -> Head a
tupHead b
b

-- | Get the third element of an inductive tuple.
third :: Tup c => (a :*: b :*: c) -> Head c
third :: forall c a b. Tup c => (a :*: (b :*: c)) -> Head c
third (a
_ :*: b
_ :*: c
c) = forall a. Tup a => a -> Head a
tupHead c
c

-- | Get the fourth element of an inductive tuple.
fourth :: Tup d => (a :*: b :*: c :*: d) -> Head d
fourth :: forall d a b c. Tup d => (a :*: (b :*: (c :*: d))) -> Head d
fourth (a
_ :*: b
_ :*: c
_ :*: d
d) = forall a. Tup a => a -> Head a
tupHead d
d

-- | Get the fifth element of an inductive tuple.
fifth :: Tup e => (a :*: b :*: c :*: d :*: e) -> Head e
fifth :: forall e a b c d.
Tup e =>
(a :*: (b :*: (c :*: (d :*: e)))) -> Head e
fifth (a
_ :*: b
_ :*: c
_ :*: d
_ :*: e
e) = forall a. Tup a => a -> Head a
tupHead e
e