SQL query row types

Main.purs

module Main where

import Prelude

import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (logShow, CONSOLE)
import Data.Foldable (class Foldable, foldl, intercalate)
import Data.Maybe (Maybe(..), maybe)
import Data.Monoid (class Monoid, mempty)
import Data.StrMap (StrMap, lookup)
import Data.String.Regex (replace')                                                                                                       
import Data.String.Regex.Flags (ignoreCase)
import Data.String.Regex.Unsafe (unsafeRegex)
import TryPureScript (render, withConsole)
import Unsafe.Coerce (unsafeCoerce)
import Data.Symbol (SProxy(..), class IsSymbol)
import Type.Row (class RowToList, class ListToRow, kind RowList, Cons, Nil)

-------------------

-- A Query is a morphism from a SQL table row to SQL table row.
-- It is implemented as a SQL query string which has a specific
--   type of arguments and returns a specific type.
--class Query q (i :: # Type) (o :: # Type) where
class Query q where
  formatSql :: forall i o. q i o -> i -> String
    
-- A NamedParameterQuery is a SQL query that has named arguments
--   of `i` type and produces records of `o` type.
--newtype NPQuery (i :: # Type) (o :: # Type) = NPQuery String
newtype NPQuery i o = NPQuery String

class NPQueryArg r
instance npqaRow ::
  ( RowToList r rl
  , ListToRow rl r
  , QueryArgRow rl
  ) =>
  NPQueryArg (Record r)

-- An NPQuery is a Query.
instance queryNpQuery ::
      -- ( RowToList i il
      -- , ListToRow il i
      -- , QueryArgRow il
      ( NPQueryArg vals
      ) =>
      Query NPQuery where
  formatSql (NPQuery sql) vals =
    sql -- !!! todo: replace ??param?? in `sql` with `vals`
  -- formatSql (NPQuery sql) vals = formatDollars vals sql
  --   where
  --     --valsStrMap :: forall a. StrMap a
  --     --valsStrMap = unsafeCoerce vals
  --     formatDollars :: forall i. String -> Record i -> String
  --     --formatDollars :: forall i. (SqlArg i) => StrMap i -> String -> String
  --     formatDollars vals sql = replace' (unsafeRegex """\?\?(\w+)\?\?""" ignoreCase) replaceFn sql
  --       where
  --         replaceFn :: String -> Array String -> String
  --         replaceFn matchedSymbol _ =
  --           --maybe "" formatSqlArg $ lookup matchedSymbol vals
  --           maybe "" formatSqlArg $ property matchedSymbol vals

  --     property :: forall a b. Record a -> String -> Maybe b
  --     property r k = ?f
    
-- An example NPQuery. It takes one argument.
data TimeUnit = Hour | Day | Week | Month
pricingByAssetIds :: NPQuery
  { asset_IDs :: Array String }
  { asset_ID :: String, duration :: Number, duration_unit :: TimeUnit, price :: Number }
pricingByAssetIds = NPQuery
  """
  SELECT asset_ID, duration, duration_unit, price
  FROM pricing
  WHERE asset_ID IN ??asset_IDs??
  """

---------------------

-- A row which contains named argument values in a SQL query.
class QueryArgRow (xs :: RowList) -- (row :: # Type)

instance qarNil :: QueryArgRow Nil -- row
instance qarCons ::
  ( QueryArg a
  , QueryArgRow la
  ) =>
  QueryArgRow (Cons k a la)

-- A type which can be rendered as a SQL query argument.
class QueryArg a where
  formatSqlArg :: a -> String

instance qaString :: QueryArg String where
  formatSqlArg s = s

instance qaArray :: (QueryArg a) => QueryArg (Array a) where
  formatSqlArg as = intercalateMap "," formatSqlArg as

intercalateMap :: forall f a m. Foldable f => Monoid m => m -> (a -> m) -> f a -> m
intercalateMap sep f xs = (foldl go { init: true, acc: mempty } xs).acc
  where
  go { init: true } x = { init: false, acc: f x }
  go { acc: acc }   x = { init: false, acc: acc <> sep <> f x }

---------------------

-- main :: forall eff. Eff (dom :: _, console :: CONSOLE | eff) Unit                        Unit
main :: Eff _ Unit
main = render =<< withConsole do
  logShow $ formatSql pricingByAssetIds { asset_IDs: ["1", "2", "3"] }
  logShow $ intercalateMap ", " show [ 1, 2, 3 ]
  --  Should produce `WHERE asset_ID IN ("1", "2", "3")`