module Pasta.Types
( BooleanExpression (..)
, Expression (..)
, Select (..)
, FromRelation (..)
, Column (..)
, Update (..)
, Delete (..)
, Insert (..)
, Name (..)
, Identifier (..)
, Literal (..)
, Conflict (..)
, ConflictTarget (..)
, ConflictAction (..)
, Assignment (..)
, Operator (..)
, IsExpression (..)
, IsSQL (..)
) where
import Protolude hiding (toList)
import Data.Function (id)
import Data.List.NonEmpty (NonEmpty (..), toList)
import Data.String (fromString)
import qualified Data.Text as T
import TextShow (TextShow, fromText, showb, showt)
newtype Operator = Operator T.Text deriving (Eq, Show)
newtype Literal = Literal T.Text deriving (Eq, Show)
newtype Name = Name T.Text deriving (Eq, Show)
class IsSQL a where
toSQL :: a -> Text
instance IsSQL Select where
toSQL = showt
instance IsSQL Update where
toSQL = showt
instance IsSQL Delete where
toSQL = showt
instance IsSQL Insert where
toSQL = showt
class IsExpression a where
toExp :: a -> Expression
instance IsExpression Expression where
toExp = id
instance IsExpression Identifier where
toExp = IdentifierExp
instance IsExpression Literal where
toExp = LitExp
instance IsExpression Text where
toExp = LitExp . Literal
data Identifier = Identifier
{ _qualifier :: Name
, _identifier :: Name
} deriving (Eq, Show)
instance TextShow Literal where
showb (Literal e) = fromText (pgFmtLit e)
instance IsString Literal where
fromString = Literal . fromString
instance TextShow Name where
showb (Name "*") = "*"
showb (Name "EXCLUDED") = "EXCLUDED"
showb (Name c) = fromText $ pgFmtIdent c
instance TextShow Operator where
showb (Operator op) = fromText op
instance IsString Name where
fromString = Name . fromString
instance TextShow Identifier where
showb (Identifier e1 e2) = showb e1 <> "." <> showb e2
data BooleanExpression = Or BooleanExpression BooleanExpression
| And BooleanExpression BooleanExpression
| Not BooleanExpression
| BoolLiteral Bool
| Exists Select
| In Identifier Select
| Comparison Operator Expression Expression
deriving (Eq, Show)
data Expression = IdentifierExp Identifier
| BoolExp BooleanExpression
| OperatorExp Expression Operator Expression
| FunctionExp Identifier [Expression]
| QueryExp Select
| LitExp Literal
| NameExp Name
| Null
deriving (Eq, Show)
data Column = Column Expression
| AliasedColumn
{ _expression :: Expression
, _alias :: Name
} deriving (Eq, Show)
data FromRelation = FromRelation
{ _relationExpression :: Expression
, _relationAlias :: Name
} deriving (Eq, Show)
data Select = Select
{ _selectColumns :: NonEmpty Column
, _selectRelations :: [FromRelation]
, _selectConditions :: BooleanExpression
} deriving (Eq, Show)
instance TextShow Expression where
showb (IdentifierExp e) = showb e
showb (BoolExp e) = showb e
showb (OperatorExp e1 (Operator operator) e2) = showb e1 <> " " <> fromText operator <> " " <> showb e2
showb (FunctionExp i parameters) = showb i <> "(" <> fromText (withCommas parameters) <> ")"
showb (QueryExp e) = showb e
showb (LitExp e) = showb e
showb (NameExp e) = showb e
showb Null = "NULL"
instance TextShow FromRelation where
showb (FromRelation e a) = showb e <> " " <> showb a
instance TextShow Column where
showb (Column c) = showb c
showb (AliasedColumn c a) = showb c <> " AS " <> showb a
instance TextShow Select where
showb (Select c fr w) =
sel <> " WHERE " <> showb w
where sel = "SELECT " <> fromText (neWithCommas c) <>
if null fr
then ""
else " FROM "
<> fromText (withCommas fr)
instance TextShow BooleanExpression where
showb (Or e1 e2) = showb e1 <> " OR " <> showb e2
showb (And e1 e2) = showb e1 <> " AND " <> showb e2
showb (Not e) = "NOT " <> showb e
showb (BoolLiteral True) = "true"
showb (BoolLiteral False) = "false"
showb (Exists e) = "EXISTS (" <> showb e <> ")"
showb (In e s) = showb e <> " IN (" <> showb s <> ")"
showb (Comparison op e1 e2) = showb e1 <> " " <> showb op <> " " <> showb e2
instance IsString Expression where
fromString = LitExp . Literal . fromString
instance IsString Column where
fromString = Column . NameExp . fromString
instance IsString FromRelation where
fromString e = FromRelation (NameExp $ fromString e) (fromString e)
data Assignment = Assignment
{ _targetColumn :: Name
, _assignmentValue :: Expression
} deriving (Eq, Show)
data Update = Update
{ _updateTarget :: Identifier
, _updateAssignments :: NonEmpty Assignment
, _updateConditions :: BooleanExpression
, _updateReturning :: [Column]
} deriving (Eq, Show)
data Delete = Delete
{ _deleteTarget :: Identifier
, _deleteConditions :: BooleanExpression
, _deleteReturning :: [Column]
} deriving (Eq, Show)
instance TextShow Assignment where
showb (Assignment e1 e2) = showb e1 <> " = " <> showb e2
data ConflictTarget = OnConstraint Name
deriving (Eq, Show)
data Conflict = Conflict
{ _conflictTarget :: Maybe ConflictTarget
, _conflictAction :: ConflictAction
} deriving (Eq, Show)
data ConflictAction = DoNothing
| DoUpdate (NonEmpty Assignment) BooleanExpression
deriving (Eq, Show)
data Insert = Insert
{ _insertTarget :: Identifier
, _insertColumns :: NonEmpty Name
, _insertValues :: NonEmpty Expression
, _insertOnConflict :: Maybe Conflict
} deriving (Eq, Show)
instance IsString ConflictTarget where
fromString = OnConstraint . fromString
instance TextShow ConflictTarget where
showb (OnConstraint e1) = fromText $ "ON CONSTRAINT " <> showt e1
instance TextShow Conflict where
showb (Conflict Nothing e1) = fromText $ " ON CONFLICT " <> showt e1
showb (Conflict (Just e1) e2) = fromText $ " ON CONFLICT " <> showt e1 <> " " <> showt e2
instance TextShow ConflictAction where
showb DoNothing = "DO NOTHING"
showb (DoUpdate e1 e2) = "DO UPDATE SET " <> fromText (neWithCommas e1) <> " WHERE " <> showb e2
instance TextShow Insert where
showb (Insert e1 e2 e3 e4) =
fromText $
"INSERT INTO "
<> showt e1
<> " ("
<> neWithCommas e2
<> ") VALUES ("
<> neWithCommas e3
<> ")"
<> fromMaybe "" (showt <$> e4)
instance TextShow Update where
showb (Update e1 e2 e3 e4) =
fromText $
"UPDATE "
<> showt e1
<> " SET "
<> neWithCommas e2
<> " WHERE " <> showt e3
<> if null e4
then ""
else " RETURNING "
<> withCommas e4
instance TextShow Delete where
showb (Delete e1 e3 e4) =
fromText $
"DELETE FROM "
<> showt e1
<> " WHERE " <> showt e3
<> if null e4
then ""
else " RETURNING "
<> withCommas e4
withCommas :: TextShow a => [a] -> T.Text
withCommas = T.intercalate ", " . map showt
neWithCommas :: TextShow a => NonEmpty a -> T.Text
neWithCommas = withCommas . toList
pgFmtIdent :: T.Text -> T.Text
pgFmtIdent x = "\"" <> T.replace "\"" "\"\"" (trimNullChars x) <> "\""
pgFmtLit :: T.Text -> T.Text
pgFmtLit x =
let trimmed = trimNullChars x
escaped = "'" <> T.replace "'" "''" trimmed <> "'"
slashed = T.replace "\\" "\\\\" escaped in
if "\\" `T.isInfixOf` escaped
then "E" <> slashed
else slashed
trimNullChars :: T.Text -> T.Text
trimNullChars = T.takeWhile (/= '\x0')