yql-0.0.0: Main.hs

{-# LANGUAGE RankNTypes,
             RecordWildCards #-}

module Main
       ( main ) where

import Control.Applicative ((<$>))
import Control.Monad (forM, join, mzero)
import Control.Monad.Catch

import qualified Data.Map as Map (fromList)
import Data.Maybe (listToMaybe)

import System.IO

import Text.XML.HXT.Core (runX, readString, withRemoveWS, yes, (>>>))

import System.Environment (getArgs)

import Data.OpenDataTable
import Data.YQL

import Language.JavaScript.Interpret
import Language.JavaScript.SubType

import Data.OpenDataTable.Parser

import YQL

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  (xml:_) <- getArgs
  xmlFile <- openFile xml ReadMode
  document <- hGetContents xmlFile

  mOpenDataTable <- listToMaybe <$> runX (readString [withRemoveWS yes] document
                                          >>> parseOpenDataTable)
  case mOpenDataTable of
   Just opentable@(OpenDataTable {..}) -> do
     let selects = [s | SelectBinding s <- openDataTableBindings]
     case selects of
      Select {..}:_ -> do
        vs <- join <$>
          forM selectInputs
          (\i -> do
              case i of
               InputKey InputInfo {..} -> do
                 let key = maybe inputInfoId id inputInfoAs
                 putStr (key ++ ": ")
                 str <- getLine
                 let value = case inputInfoType of
                              InputTypeBool -> inj (read str :: Bool)
                              InputTypeDate -> inj str
                              InputTypeDouble -> inj (Number (read str :: Double))
                              InputTypeFloat -> inj (Number (read str :: Double))
                              InputTypeInt -> inj (Number (read str :: Double))
                              InputTypeString -> inj str
                 return [(key, value)]
               _ -> return mzero)
        result <- runYQL opentable (Map.fromList vs)
        print result
      _ -> throwM YQLExceptionMissingSelect
   _ -> throwM YQLExceptionXMLError