module Sqel.Data.FragType where

import Sqel.Data.Order (Order)
import Sqel.Data.Sql (Sql, sql)

data FragType =
  Where
  |
  Offset
  |
  Limit
  |
  Order Order
  |
  Custom Int Text
  deriving stock (FragType -> FragType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FragType -> FragType -> Bool
$c/= :: FragType -> FragType -> Bool
== :: FragType -> FragType -> Bool
$c== :: FragType -> FragType -> Bool
Eq, Int -> FragType -> ShowS
[FragType] -> ShowS
FragType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FragType] -> ShowS
$cshowList :: [FragType] -> ShowS
show :: FragType -> String
$cshow :: FragType -> String
showsPrec :: Int -> FragType -> ShowS
$cshowsPrec :: Int -> FragType -> ShowS
Show, forall x. Rep FragType x -> FragType
forall x. FragType -> Rep FragType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FragType x -> FragType
$cfrom :: forall x. FragType -> Rep FragType x
Generic)

renderWithFragKeyword :: Sql -> FragType -> Sql
renderWithFragKeyword :: Sql -> FragType -> Sql
renderWithFragKeyword Sql
param = \case
  FragType
Where -> [sql|where #{param}|]
  FragType
Offset -> [sql|offset #{param}|]
  FragType
Limit -> [sql|limit #{param}|]
  Order Order
dir -> [sql|order by #{param} ##{dir}|]
  Custom Int
_ Text
kw -> [sql|##{kw} #{param}|]

sfragOrdinal :: FragType -> Int
sfragOrdinal :: FragType -> Int
sfragOrdinal = \case
  FragType
Where -> Int
0
  Order Order
_ -> Int
1
  FragType
Limit -> Int
2
  FragType
Offset -> Int
3
  Custom Int
i Text
_ -> Int
i

instance Ord FragType where
  compare :: FragType -> FragType -> Ordering
compare =
    forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing FragType -> Int
sfragOrdinal