RIS.hs

{- | RIS: Representación Intermedia del Select. 
     
     El propósito es abstraer el select.
     Pudo utilizarse un AST, sin embargo, en esta aproximación
     utilizaremos un registro que denominamos Select.

     Con la abstracción Select introducimos una separación.
     GenSelect puede refinar en una consulta a partir de un taris.
     GenSelectDBM puede generar un Select a partir de las especificaciones
     de consulta.

     Leonel Fonseca. 2010.
-}

{-# language  NoMonomorphismRestriction  #-}


module Database.TA.Core.RIS  
              ( module Database.TA.Core.Nucleo
              , emptySelect
              , toString
              , maybeString ) 

where
  
import Database.TA.Core.Nucleo 
import Data.List       ( intersperse )
import Control.Monad   ( liftM, liftM2 )


emptySelect   ::   InstanciaCR
emptySelect   =    Select [] [] [] [] [] [] []

toString      =    maybe "" id . maybeString 
 
maybeString   ::   InstanciaCR ->  Maybe String
maybeString s =    genWith    (with_    s)
              +++  genSelect  (select_  s)
              +++  genFrom    (from_    s)
              +++  genWhere   (where_   s)
              +++  genOrder   (order_   s)
              +++  genGroup   (group_   s)
              +++  genHaving  (having_  s)

  where
    
  infixl +++
  a +++  b   =  liftM2 (++) a b
  lista      =  concat . (intersperse ", ")
  
             -- concat and wrap aplana una lista de hileras en una
             -- sola hilera h. Luego le prefija la hilera x. 
             -- Luego envuelve el resultado en constructor Just.
  caw        ::  String -> [String] -> Maybe String
  caw x      =   Just   . (x ++) . lista

             -- Si x es una lista vacia, usa f para genera un valor.
             -- De lo contrario usa g (x) para generar un valor.
  tv           ::  b -> ([a] -> b) -> [a] -> b  
  tv f _ []  =   f
  tv _ g x   =   g x


  --  En algunos RDBMS se puede hacer "select" sin
  --  especificar un "from". En Oracle siempre es
  --  obligatorio. Por lo tanto, en las próximas definiciones
  --  devolver Nothing codifica un caso de error,
  --  donde ni siquiera aparecen las partes básicas de un
  --  select.
 

  genWith   = tv (Just "") (liftM (++"\n") . (caw "with\n    "))
  genSelect = tv Nothing   (caw     "select\n    ")
  genFrom   = tv Nothing   (caw    "\n    /* TA Select */\nfrom\n    ")
  genWhere  = tv (Just "") (caw    "\nwhere\n    ")
  genOrder  = tv (Just "") (caw "\norder by\n    ")
  genGroup  = tv (Just "") (caw "\ngroup by\n    ")
  genHaving = tv (Just "") (caw   "\nhaving\n    ")