From a001d120c19d72e4ad79895be11ee6400d735446 Mon Sep 17 00:00:00 2001
From: Jake Wheat <jakewheatmail@gmail.com>
Date: Fri, 13 Dec 2013 22:25:22 +0200
Subject: [PATCH] tidyups

---
 Language/SQL/SimpleSQL/Parser.lhs | 20 +++++++-------------
 Language/SQL/SimpleSQL/Pretty.lhs |  4 ++--
 TODO                              |  1 +
 Tests.lhs                         |  2 +-
 Tpch.lhs                          |  2 +-
 5 files changed, 12 insertions(+), 17 deletions(-)

diff --git a/Language/SQL/SimpleSQL/Parser.lhs b/Language/SQL/SimpleSQL/Parser.lhs
index b2d2994..3b299b2 100644
--- a/Language/SQL/SimpleSQL/Parser.lhs
+++ b/Language/SQL/SimpleSQL/Parser.lhs
@@ -38,12 +38,9 @@
 
 > setPos :: Maybe (Int,Int) -> P ()
 > setPos Nothing = return ()
-> setPos (Just (l,c)) =
->     getPosition
->     >>= (return
->          . flip setSourceColumn c
->          . flip setSourceLine l)
->     >>= setPosition
+> setPos (Just (l,c)) = fmap f getPosition >>= setPosition
+>   where f = flip setSourceColumn c
+>             . flip setSourceLine l
 
 > 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_ (k:ks) = keyword_ k <* keywords_ ks
+>     keywords_ = try . mapM_ keyword_
 
 > 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' [] = return []
->     keywords' (k:ks) = (:) <$> keyword k <*> keywords' ks
+>     keywords ks = unwords <$> mapM keyword ks
 
 > sparens :: P ScalarExpr
 > sparens = Parens <$> parens scalarExpr'
diff --git a/Language/SQL/SimpleSQL/Pretty.lhs b/Language/SQL/SimpleSQL/Pretty.lhs
index 6e2a957..b3f8b1b 100644
--- a/Language/SQL/SimpleSQL/Pretty.lhs
+++ b/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)
->         ,nest 4 (sep ((map w ws)
+>     sep [text "case" <+> maybe empty scalarExpr t
+>         ,nest 4 (sep (map w ws
 >                       ++ maybeToList (fmap e els)))
 >         ,text "end"]
 >   where
diff --git a/TODO b/TODO
index 860704b..0284504 100644
--- a/TODO
+++ b/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
 
diff --git a/Tests.lhs b/Tests.lhs
index 2401516..67220e3 100644
--- a/Tests.lhs
+++ b/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
diff --git a/Tpch.lhs b/Tpch.lhs
index b79df8a..a90f24c 100644
--- a/Tpch.lhs
+++ b/Tpch.lhs
@@ -2,7 +2,7 @@
 test data for tpch queries
 
 
-> {-# LANGUAGE QuasiQuotes,OverloadedStrings #-}
+> {-# LANGUAGE OverloadedStrings #-}
 
 > module Tpch (tpchQueries) where
 >