tidyups

Language/SQL/SimpleSQL/Parser.lhs

@@ -38,12 +38,9 @@
 
 > setPos :: Maybe (Int,Int) -> P ()
 > setPos Nothing = return ()
-> setPos (Just (l,c)) =
+> setPos (Just (l,c)) = fmap f getPosition >>= setPosition
->     getPosition
+>   where f = flip setSourceColumn c
->     >>= (return
+>             . flip setSourceLine l
->          . flip setSourceColumn c
->          . flip setSourceLine l)
->     >>= setPosition
 
 > data ParseError = ParseError
 >                   {peErrorString :: String
@@ -254,9 +251,8 @@ used for between parsing
 
 > prefixUnaryOp :: P ScalarExpr
 > prefixUnaryOp =
->     makeOp <$> opSymbol <*> scalarExpr'
+>     PrefixOp <$> opSymbol <*> scalarExpr'
 >   where
->     makeOp nm e = PrefixOp nm e
 >     opSymbol = choice (map (try . symbol) prefixUnOpSymbolNames
 >                       ++ map (try . keyword) prefixUnOpKeywordNames)
 
@@ -276,8 +272,7 @@ used for between parsing
 >     opPairs = flip map ops $ \o -> (o, words o)
 >     makeOp (o,ws) =
 >       try $ PostfixOp o e <$ keywords_ ws
->     keywords_ [] = return ()
+>     keywords_ = try . mapM_ keyword_
->     keywords_ (k:ks) = keyword_ k <* keywords_ ks
 
 > scalarExpr' :: P ScalarExpr
 > scalarExpr' = scalarExpr'' False
@@ -294,6 +289,7 @@ postgresql handles this
 >     factor = choice [literal
 >                     ,scase
 >                     ,cast
+>                     --,extract
 >                     ,subquery
 >                     ,prefixUnaryOp
 >                     ,try app
@@ -314,9 +310,7 @@ postgresql handles this
 >                (if bExpr
 >                 then binOpKeywordNamesNoAnd
 >                 else binOpKeywordNames))
->     keywords ks = intercalate " " <$> keywords' ks
+>     keywords ks = unwords <$> mapM keyword ks
->     keywords' [] = return []
->     keywords' (k:ks) = (:) <$> keyword k <*> keywords' ks
 
 > sparens :: P ScalarExpr
 > sparens = Parens <$> parens scalarExpr'

Language/SQL/SimpleSQL/Pretty.lhs

@@ -44,8 +44,8 @@ back into SQL source text. It attempts to format the output nicely.
 >     sep [scalarExpr e0, text f, scalarExpr e1]
 
 > scalarExpr (Case t ws els) =
->     sep [text "case" <+> (maybe empty scalarExpr t)
+>     sep [text "case" <+> maybe empty scalarExpr t
->         ,nest 4 (sep ((map w ws)
+>         ,nest 4 (sep (map w ws
 >                       ++ maybeToList (fmap e els)))
 >         ,text "end"]
 >   where

TODO

@@ -8,6 +8,7 @@ get tpch parsing
 check the pretty printer on the tpch queries
 add automated tests to cabal
 do code documentation and haddock
+  check the order of exports, imports and functions/cases in the files
 do some tests for parse errors?
 website with haddock and table of parsing tests
 

Tests.lhs

@@ -168,7 +168,7 @@
 >     ,("a is similar to b", BinOp "is similar to" (Iden "a") (Iden "b"))
 >     ,("a is not similar to b", BinOp "is not similar to" (Iden "a") (Iden "b"))
 >     ,("a overlaps b", BinOp "overlaps" (Iden "a") (Iden "b"))
->     --,("extract(day from t)", Op "not" [])
+>     --,("extract(day from t)", SpecialOp "extract" [Iden "day", Iden "t"])
 >     ]
 
 > aggregates :: TestItem

Tpch.lhs

@@ -2,7 +2,7 @@
 test data for tpch queries
 
 
-> {-# LANGUAGE QuasiQuotes,OverloadedStrings #-}
+> {-# LANGUAGE OverloadedStrings #-}
 
 > module Tpch (tpchQueries) where
 >