applicative-quoters-0.1.0.8/0000755000000000000000000000000012027362636014054 5ustar0000000000000000applicative-quoters-0.1.0.8/README0000644000000000000000000000067012027362636014737 0ustar0000000000000000applicative-quoters provides two quasiquoters to be used with applicative functors: a do-notation-alike, ado, and an attempt to emulate Conor McBride's idiom brackets. They are originally taken from Matt Morrow's haskell-src-meta package, before he disappeared forever and I took up maintainership of it. However, I no longer maintain it, since it is unused even by me. If you're interested in keeping it updated, feel free to take over. applicative-quoters-0.1.0.8/ChangeLog0000644000000000000000000000176112027362636015633 0ustar00000000000000000.1.0.8: - Doc fixes - Since support for GHC < 7.4 was dropped, don't need notcpp or related code - Make dependency bounds more optimistic 0.1.0.7: - Make it a little more obvious that the package is unmaintained 0.1.0.6: - Use the notcpp package to aid with name lookup - Compatibility with GHC 7.6.1 and TH 2.8 - Drop compatibility with GHC < 7.4 to fix a bug with infix handling - Doc improvements - Remove maintainer 0.1.0.5: - Mostly a rerelease of 0.1.0.4 to fix some metadata 0.1.0.4: - GHC 7.4 compatibility 0.1.0.3: - Dependency update - Support infix applications in idiom brackets 0.1.0.2: - GHC 7.2 compatibility 0.1.0.1: - Stop ado' needlessly checking failing patterns - Make a better effort to resolve constructor names 0.1: - Quasiquoters extracted from haskell-src-meta - Module names changed to Control.Applicative.QQ.{ADo,Idiom} - Stop stripping qualification from names - Fixes for failing pattern detection in ado - Drop dependency on syb and containers - quotePat fields removed applicative-quoters-0.1.0.8/applicative-quoters.cabal0000644000000000000000000000206012027362636021037 0ustar0000000000000000Cabal-Version: >= 1.6 Name: applicative-quoters Version: 0.1.0.8 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). . applicative-quoters currently has no maintainer: if it is broken and you want it to be fixed, then fix it! Author: Matt Morrow Copyright: (c) Matt Morrow License: BSD3 License-file: LICENSE Extra-source-files: ChangeLog README Build-type: Simple Tested-with: GHC == 7.4.2, GHC == 7.6.1 Library Exposed-modules: Control.Applicative.QQ.ADo Control.Applicative.QQ.Idiom Build-depends: base >= 4 && < 5, haskell-src-meta >= 0.2 && < 1, template-haskell >= 2.7 && < 3 Extensions: TemplateHaskell GHC-options: -Wall Source-Repository head type: git location: git://github.com/benmachine/applicative-quoters.git applicative-quoters-0.1.0.8/LICENSE0000644000000000000000000000275712027362636015074 0ustar0000000000000000Copyright (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. applicative-quoters-0.1.0.8/Setup.hs0000644000000000000000000000005612027362636015511 0ustar0000000000000000import Distribution.Simple main = defaultMain applicative-quoters-0.1.0.8/Control/0000755000000000000000000000000012027362636015474 5ustar0000000000000000applicative-quoters-0.1.0.8/Control/Applicative/0000755000000000000000000000000012027362636017735 5ustar0000000000000000applicative-quoters-0.1.0.8/Control/Applicative/QQ/0000755000000000000000000000000012027362636020256 5ustar0000000000000000applicative-quoters-0.1.0.8/Control/Applicative/QQ/ADo.hs0000644000000000000000000001261212027362636021257 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} -- | Applicative do. Philippa 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 (parseExp) import Language.Haskell.TH import Language.Haskell.TH.Quote import Control.Monad -- $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: :... -- ado' :: QuasiQuoter ado' = ado'' True ado'' :: Bool -> QuasiQuoter ado'' b = QuasiQuoter { quoteExp = \str -> applicate b =<< parseDo str, quotePat = nonsense "pattern", quoteType = nonsense "type", quoteDec = nonsense "declaration" } where nonsense context = fail $ "You can't use ado in " ++ context ++ " context, that doesn't even make sense." 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" b <- if rawPatterns then return True else null <$> filterM failingPattern ps f' <- if b 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 -- patterns that always succeed VarP {} -> return False TildeP {} -> return False WildP -> return False -- patterns that can fail LitP {} -> return True ListP {} -> return True -- ConP can fail if the constructor is not the only constructor of its type -- /or/ if any of the subpatterns can fail ConP n ps -> liftM2 (\x y -> not x || y) (singleCon n) (anyFailing ps) -- some other patterns are essentially ConP patterns InfixP p n q -> failingPattern $ ConP n [p, q] UInfixP p n q -> failingPattern $ ConP n [p, q] RecP n fps -> failingPattern $ ConP n (map snd fps) -- recursive cases TupP ps -> anyFailing ps UnboxedTupP ps -> anyFailing ps ParensP p -> failingPattern p BangP p -> failingPattern p AsP _ p -> failingPattern p SigP p _ -> failingPattern p ViewP _ p -> failingPattern p where anyFailing = fmap or . mapM failingPattern -- | Take the name of a value constructor and try to find out if it is -- the only constructor of its type singleCon :: Name -> Q Bool singleCon n = do dec <- recover noScope $ do Just vn <- lookupValueName (show n) DataConI _ _ tn _ <- reify vn TyConI dec <- reify tn return dec case dec of DataD _ _ _ [_] _ -> return True NewtypeD {} -> return True DataD _ _ _ (_:_) _ -> return False _ -> fail $ "ado singleCon: not a data declaration: " ++ show dec where noScope = fail $ "Data constructor " ++ show n ++ " lookup failed." applicative-quoters-0.1.0.8/Control/Applicative/QQ/Idiom.hs0000644000000000000000000000344712027362636021663 0ustar0000000000000000{-# LANGUAGE TemplateHaskell, QuasiQuotes #-} -- | Idiom brackets. Vixey's idea. module Control.Applicative.QQ.Idiom (i) where import Control.Applicative ((<*>), pure) import Control.Monad ((<=<)) import Language.Haskell.Meta (parseExp) import Language.Haskell.TH.Lib import Language.Haskell.TH.Quote import Language.Haskell.TH.Syntax -- | Turns function application into '<*>', and puts a 'pure' on the beginning. -- -- > [i| subtract [1,2,3] [10,20,30] |] -- > -> pure subtract <*> [1,2,3] <*> [10,20,30] -- > -> [9,19,29,8,18,28,7,17,27] -- -- Does not apply to nested applications: -- -- > getZipList [i| subtract (ZipList [1,2,3]) (ZipList [10,20,30]) |] -- > -> getZipList (pure subtract <*> ZipList [1,2,3] <*> ZipList [10,20,30]) -- > -> [9,18,27] -- -- Will treat @[i| x \`op\` y |]@ as @[i| op x y |]@ as long as neither x nor y -- are an infix expression. If they are, will likely complain that it doesn't -- have fixity information (unless haskell-src-meta becomes clever enough to -- resolve that itself). i :: QuasiQuoter i = QuasiQuoter { quoteExp = applicate <=< either fail return . parseExp, quotePat = nonsense "pattern", quoteType = nonsense "type", quoteDec = nonsense "dec" } where nonsense context = fail $ "You can't use idiom brackets in " ++ context ++ " context, that doesn't even make sense." applicate :: Exp -> ExpQ applicate (AppE f x) = [| $(applicate f) <*> $(return x) |] applicate (InfixE (Just left) op (Just right)) = [| pure $(return op) <*> $(return left) <*> $(return right) |] applicate (UInfixE left op right) = case (left,right) of (UInfixE{}, _) -> ambig (_, UInfixE{}) -> ambig (_, _) -> [| pure $(return op) <*> $(return left) <*> $(return right) |] where ambig = fail "Ambiguous infix expression in idiom bracket." applicate x = [| pure $(return x) |]