From 6c9a291930454716ebdf67ded83095e0a3c30e3a Mon Sep 17 00:00:00 2001
From: Jake Wheat <jakewheatmail@gmail.com>
Date: Sat, 10 May 2014 10:02:16 +0300
Subject: [PATCH] refactor the filter parsing

---
 Language/SQL/SimpleSQL/Combinators.lhs |  7 ++--
 Language/SQL/SimpleSQL/Parser.lhs      | 50 +++++++++-----------------
 2 files changed, 21 insertions(+), 36 deletions(-)

diff --git a/Language/SQL/SimpleSQL/Combinators.lhs b/Language/SQL/SimpleSQL/Combinators.lhs
index d952063..7676f1e 100644
--- a/Language/SQL/SimpleSQL/Combinators.lhs
+++ b/Language/SQL/SimpleSQL/Combinators.lhs
@@ -11,8 +11,8 @@
 >     ,(<??.>)
 >     ,(<??*>)) where
 
-> import Control.Applicative ((<$>), (<*>), (<**>))
-> import Text.Parsec (option,many)
+> import Control.Applicative --((<$>), (<*>), (<**>))
+> import Text.Parsec --(option,many)
 > import Text.Parsec.String (Parser)
 
 a possible issue with the option suffix is that it enforces left
@@ -54,4 +54,5 @@ succeeding.
 0 to many repeated applications of suffix parser
 
 > (<??*>) :: Parser a -> Parser (a -> a) -> Parser a
-> p <??*> q = foldr ($) <$> p <*> (reverse <$> many q)
+> p <??*> q = p <**> chainl q (pure (flip (.))) id
+>     -- foldr ($) <$> p <*> (reverse <$> many q)
diff --git a/Language/SQL/SimpleSQL/Parser.lhs b/Language/SQL/SimpleSQL/Parser.lhs
index 6ab38d4..58b3127 100644
--- a/Language/SQL/SimpleSQL/Parser.lhs
+++ b/Language/SQL/SimpleSQL/Parser.lhs
@@ -414,7 +414,19 @@ syntactically, e.g. a clob(5) will parse to a precision type name, not
 a lob type name.
 
 Not sure if the factoring in this function is too far. It could do
-with some work to improve the readability still.
+with some work to improve the readability still. Ideas: the parsers of
+each component, the various kinds combinators, the application of
+choice particularly and the constuctors are a bit mixed together and
+should be separated more. Probably start with:
+
+P (a -> b), which combines parsing some extra fields and then
+constructing a 'b' with these new fields and the 'a', decompose it
+into
+
+P c -- separate each field that contributes to a b to a separately
+named function
+separate out the ctor wrapper:  c -> a -> b
+and then create a P (a -> b) just by combining bits
 
 > typeName :: Parser TypeName
 > typeName = lexeme $
@@ -611,7 +623,7 @@ syntax can start with the same keyword.
 cast: cast(expr as type)
 
 > cast :: Parser ValueExpr
-> cast = keyword_ "cast" >>
+> cast = keyword_ "cast" *>
 >        parens (Cast <$> valueExpr
 >                     <*> (keyword_ "as" *> typeName))
 
@@ -834,7 +846,7 @@ factored with the typename 'literal' parser.
 >   [((,,) <$> duplicates
 >          <*> commaSep1 valueExpr
 >          <*> (option [] orderBy <* closeParen))
->    <**> (afilterz
+>    <**> ((\f (sq,es,ob) nm -> f sq es ob nm) <$> afilter
 >          <|> pure (\(d,es,ob) f -> AggregateApp f d es ob Nothing))
 >    -- separate cases with no all or distinct which have at least one
 >    -- value expr
@@ -842,11 +854,11 @@ factored with the typename 'literal' parser.
 >    <**> choice
 >         [closeParen *> choice [window
 >                               ,withinGroup
->                               ,afiltery
+>                               ,(\f es nm -> f SQDefault es [] nm) <$> afilter
 >                               ,pure (flip App)]
 >         ,(orderBy <* closeParen)
 >          <**>
->          choice [afilterx
+>          choice [(\f ob es nm -> f SQDefault es ob nm) <$> afilter
 >                 ,pure (\ob es f -> AggregateApp f SQDefault es ob Nothing)]]
 >   ,([] <$ closeParen)
 >    <**> choice [window
@@ -854,34 +866,6 @@ factored with the typename 'literal' parser.
 >                ,pure (flip App)]
 >   ]
 
-todo: brain no work - fix this mess. Should be able to convert these
-to simple applicative functions then inline them
-
-> afilterx :: Parser ([SortSpec]
->                     -> [ValueExpr]
->                     -> [Name]
->                     -> ValueExpr)
-> afilterx = do
->     f <- afilter
->     pure $ \ob es nm -> f SQDefault es ob nm
-
-> afiltery :: Parser ([ValueExpr]
->                     -> [Name]
->                     -> ValueExpr)
-> afiltery = do
->     f <- afilter
->     pure $ \es nm -> f SQDefault es [] nm
-
-
-> afilterz :: Parser ((SetQuantifier
->                    ,[ValueExpr]
->                    ,[SortSpec])
->                    -> [Name]
->                    -> ValueExpr)
-> afilterz = do
->     f <- afilter
->     pure $ \(sq,es,ob) nm -> f sq es ob nm
-
 > afilter :: Parser (SetQuantifier
 >                    -> [ValueExpr]
 >                    -> [SortSpec]