packages feed

applicative-quoters (empty) → 0.1

raw patch · 5 files changed

+257/−0 lines, 5 filesdep +basedep +haskell-src-metadep +template-haskellsetup-changed

Dependencies added: base, haskell-src-meta, template-haskell

Files

+ Control/Applicative/QQ/ADo.hs view
@@ -0,0 +1,156 @@+{-# LANGUAGE TemplateHaskell #-}++-- | Applicative do. Phillipa Cowderoy's idea, some explanations due Edward+-- Kmett+--+-- Pointful version of "Language.Haskell.Meta.QQ.Idiom". Note the only+-- expression which has the bound variables in scope is the last one.+--+-- This lets you work with applicatives without the order of fields in an data+-- constructor becoming such a burden.+--+-- In a similar role as 'fail' in do notation, if match failures can be+-- expected, the result is an @Applicative f => f (Maybe a)@, rather than+-- @Applicative f => f a@, where @a@ may be partially defined.+module Control.Applicative.QQ.ADo (++    ado,+    ado'++    -- * Desugaring+    -- $desugaring+    ) where++import Control.Applicative+import Language.Haskell.Meta+import Language.Haskell.TH.Lib+import Language.Haskell.TH.Quote+import Language.Haskell.TH.Syntax+import Control.Monad+import Data.Data (cast, gmapQ)++-- $desugaring+--+-- If you use patterns that may fail:+--+-- > foo :: Applicative f => f (Maybe T)+-- > foo = [$ado|+-- >    x:xs <- foo bar baz+-- >    Just y <- quux quaffle+-- >    T x y |]+--+-- 'ado' desugars to:+--+-- > foo = (\x y -> case (x,y) of+-- >                    (x:xs,Just y) -> Just $ T x y+-- >                    _ -> Nothing+-- >        ) <$> foo bar baz <*> quux quaffle+--+-- While 'ado'' desugars to the less safe:+--+-- > foo = (\(x:xs) (Just y) -> T x y) <$> foo bar baz <*> quux quaffle+--+-- If the simple patterns cannot fail, there is no 'Maybe' for the 'ado' quote,+-- just like 'ado'':+--+-- > newtype A = A Int+-- > foo :: Applicative f => f T+-- > foo = [$ado|+-- >    ~(x:xs) <- foo bar baz+-- >    A y <- quux quaffle+-- >    T x y |]+--+-- Becomes:+--+-- > foo = (\ ~(x:xs) (A y) -> T x y) <$> foo bar baz <*> quux quaffle++-- | Usage:+--+-- > ghci> [$ado| a <- "foo"; b <- "bar"; (a,b) |]+-- > [('f','b'),('f','a'),('f','r'),('o','b'),('o','a'),('o','r'),('o','b'),('o','a'),('o','r')]+--+-- > ghci> [$ado| Just a <- [Just 1,Nothing,Just 2]; b <- "fo"; (a,b) |]+-- > [Just (1,'f'),Just (1,'o'),Nothing,Nothing,Just (2,'f'),Just (2,'o')]+--+-- Notice that the last statement is not of an applicative type, so when translating+-- from monadic do, drop the final 'return':+--+-- > (do x <- [1,2,3]; return (x + 1)) == [$ado| x <- [1,2,3]; x + 1 |]++ado :: QuasiQuoter+ado = ado'' False++-- | Variant of 'ado' that does not implicitly add a Maybe when patterns may fail:+--+-- > ghci> [$ado'| Just a <- [Just 1,Nothing,Just 2]; b <- "fo"; (a,b) |]+-- > [(1,'f'),(1,'o'),*** Exception: <interactive>:...+--+ado' :: QuasiQuoter+ado' = ado'' True++ado'' ::  Bool -> QuasiQuoter+ado'' b = QuasiQuoter { quoteExp = \str -> applicate b =<< parseDo str }++parseDo ::  (Monad m) => String -> m [Stmt]+parseDo str =+    let prefix = "do\n" in+    case parseExp $ prefix ++ str of+      Right (DoE stmts) -> return stmts+      Right a -> fail $ "ado can't handle:\n" ++ show a+      Left a -> fail a++applicate :: Bool -> [Stmt] -> ExpQ+applicate rawPatterns stmt = do+    (_:ps,f:es) <- fmap (unzip . reverse) $+            flip mapM stmt $ \s ->+            case s of+                BindS p e -> return (p,e)+                NoBindS e   -> return (WildP,e)+                LetS _ -> fail $ "LetS not supported"+                ParS _ -> fail $ "ParS not supported"++    fps <- filterM failingPattern ps++    f' <- if rawPatterns || null fps+      then return $ LamE ps f+      else do+            xs <- mapM (const $ newName "x") ps+            return $ LamE (map VarP xs) $ CaseE (TupE (map VarE xs))+                [Match (TupP ps) (NormalB $ ConE 'Just `AppE` f) []+                ,Match WildP (NormalB $ ConE 'Nothing) []+                ]++    return $ foldl (\g e -> VarE '(<**>) `AppE` e `AppE` g)+                    (VarE 'pure `AppE` f')+                    es++failingPattern :: Pat -> Q Bool+failingPattern pat = case pat of+  LitP {} -> return True+  VarP {} -> return False+  TupP ps -> anyFailing ps+  ConP n ps -> liftM2 ((||) . not) (singleCon n) (anyFailing ps)+  InfixP p n q -> failingPattern $ ConP n [p, q]+  TildeP {} -> return False+  WildP -> return False+  RecP n fps -> failingPattern $ ConP n (map snd fps)+  ListP {} -> return True+  -- recurse on any subpatterns+  -- we do this implicitly because it avoids referring to the constructors+  -- by name, which means we can work with TH versions where they didn't+  -- exist+  _ -> fmap or . sequence $ gmapQ (mkQ (return False) failingPattern) pat+ where+  anyFailing = fmap or . mapM failingPattern+  mkQ d f x = maybe d f (cast x)++singleCon :: Name -> Q Bool+singleCon n = do+    DataConI _ _ tn _ <- reify n+    TyConI dec <- reify tn+    case dec of+        DataD _ _ _ [_] _ -> return True+        NewtypeD {} -> return True+        DataD _ _ _ (_:_) _ -> return False+        _ -> fail $ "Bad dec: "++show dec+
+ Control/Applicative/QQ/Idiom.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE TemplateHaskell, QuasiQuotes #-}++-- | Idiom brackets. Vixey's idea.++module Control.Applicative.QQ.Idiom (i) where++import Control.Applicative+import Language.Haskell.Meta+import Language.Haskell.TH.Lib+import Language.Haskell.TH.Quote+import Language.Haskell.TH.Syntax++-- ghci> [$i| (,) "foo" "bar" |]+-- [('f','b'),('f','a'),('f','r'),('o','b'),('o','a'),('o','r'),('o','b'),('o','a'),('o','r')]+i :: QuasiQuoter+i = QuasiQuoter { quoteExp = applicateQ }++applicateQ :: String -> ExpQ+applicateQ s = case either fail unwindE (parseExp s) of+                  x:y:xs -> foldl+                              (\e e' -> [|$e <*> $e'|])+                              [|$(return x) <$> $(return y)|]+                              (fmap return xs)+                  _ -> fail "applicateQ fails."++unwindE :: Exp -> [Exp]+unwindE = go []+  where go acc (e `AppE` e') = go (e':acc) e+        go acc e = e:acc+
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2010, Matt Morrow++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Matt Morrow nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ applicative-quoters.cabal view
@@ -0,0 +1,39 @@+Cabal-Version: >= 1.6++Name:     applicative-quoters+Version:  0.1+Category: Language+Synopsis: Quasiquoters for idiom brackets and an applicative do-notation++Description:+    Quasiquoters taken from Matt Morrow's haskell-src-meta to implement+    Conor McBride's idiom brackets, and a do-notation that only requires+    Applicative (and is correspondingly less powerful).++Author:       Matt Morrow+Maintainer:   Ben Millwood <haskell@benmachine.co.uk>+Copyright:    (c) Matt Morrow+License:      BSD3+License-file: LICENSE++Build-type:  Simple+Tested-with: GHC == 6.12.3, GHC == 7.0.1++Library+  Exposed-modules:+      Control.Applicative.QQ.ADo+      Control.Applicative.QQ.Idiom++  Build-depends:+      base >= 4 && < 4.4,+      haskell-src-meta >= 0.2 && < 0.4,+      template-haskell >= 2.4 && < 2.6++  -- We disable the missing-fields warning because not only do quoteType+  -- and quoteDec make no sense in this context, we can't initialise them+  -- because they don't exist in TH < 2.5.+  GHC-options: -Wall -fno-warn-missing-fields++Source-Repository head+  type:     git+  location: git://github.com/benmachine/applicative-quoters.git