haskell-src-exts-util-0.2.1.2/src/0000755000000000000000000000000013146015106014770 5ustar0000000000000000haskell-src-exts-util-0.2.1.2/src/Language/0000755000000000000000000000000013146015106016513 5ustar0000000000000000haskell-src-exts-util-0.2.1.2/src/Language/Haskell/0000755000000000000000000000000013146015106020076 5ustar0000000000000000haskell-src-exts-util-0.2.1.2/src/Language/Haskell/Exts/0000755000000000000000000000000013150123276021024 5ustar0000000000000000haskell-src-exts-util-0.2.1.2/src/Language/Haskell/Exts/Util/0000755000000000000000000000000013150077656021753 5ustar0000000000000000haskell-src-exts-util-0.2.1.2/src/Language/Haskell/Exts/Util.hs0000644000000000000000000000121113150123276022270 0ustar0000000000000000{-# OPTIONS -fno-warn-orphans #-} module Language.Haskell.Exts.Util ( -- * Free variables of ASTs FreeVars(..) , Vars(..) , AllVars(..) -- * Rebracketing of ASTs , Brackets(..) , paren , transformBracket , rebracket1 , appsBracket ) where import Data.Default import Language.Haskell.Exts hiding (paren) import Language.Haskell.Exts.Bracket import Language.Haskell.Exts.FreeVars -- Orphan instances required for using the bracketing code with HSE source locs instance Default SrcLoc where def = noLoc instance Default SrcSpan where def = srcInfoSpan noSrcSpan instance Default SrcSpanInfo where def = noSrcSpan haskell-src-exts-util-0.2.1.2/src/Language/Haskell/Exts/Bracket.hs0000644000000000000000000001254713146407501022745 0ustar0000000000000000{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE PatternGuards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -fno-warn-overlapping-patterns -fno-warn-incomplete-patterns #-} -- | The contents of this module originate from module -- [HSE.Bracket](https://github.com/ndmitchell/hlint/blob/master/src/HSE/Bracket.hs) -- in Neil Mitchell's HLint module Language.Haskell.Exts.Bracket ( Brackets(..) , paren , transformBracket , rebracket1 , appsBracket ) where import Control.Monad.Trans.State import Data.Data import Data.Default import Data.Generics.Uniplate.Data import Language.Haskell.Exts.Syntax import Language.Haskell.Exts.Util.Internal class Brackets a where remParen :: a -> Maybe a -- remove one paren, or Nothing if there is no paren addParen :: a -> a -- write out a paren -- | Is this item lexically requiring no bracketing ever -- i.e. is totally atomic isAtom :: a -> Bool -- | Is the child safe free from brackets in the parent position. -- Err on the side of caution, True = don't know needBracket :: Int -> a -> a -> Bool instance (Data l, Default l) => Brackets (Exp l) where remParen (Paren _ x) = Just x remParen _ = Nothing addParen = Paren def isAtom x = case x of Paren{} -> True Tuple{} -> True List{} -> True LeftSection{} -> True RightSection{} -> True TupleSection{} -> True RecConstr{} -> True ListComp{} -> True EnumFrom{} -> True EnumFromTo{} -> True EnumFromThen{} -> True EnumFromThenTo{} -> True _ -> isLexeme x -- note: i is the index in children, not in the AST needBracket i parent child | isAtom child = False | InfixApp{} <- parent, App{} <- child = False | isSection parent, App{} <- child = False | Let{} <- parent, App{} <- child = False | ListComp{} <- parent = False | List{} <- parent = False | Tuple{} <- parent = False | If{} <- parent, isAnyApp child = False | App{} <- parent, i == 0, App{} <- child = False | ExpTypeSig{} <- parent, i == 0, isApp child = False | Paren{} <- parent = False | isDotApp parent, isDotApp child, i == 1 = False | RecConstr{} <- parent = False | RecUpdate{} <- parent, i /= 0 = False | Case{} <- parent, i /= 0 || isAnyApp child = False | Lambda{} <- parent, i == length (universeBi parent :: [Pat l]) - 1 = False -- watch out for PViewPat | Do{} <- parent = False | otherwise = True instance Default l => Brackets (Type l) where remParen (TyParen _ x) = Just x remParen _ = Nothing addParen = TyParen def isAtom x = case x of TyParen{} -> True TyTuple{} -> True TyList{} -> True TyVar{} -> True TyCon{} -> True _ -> False needBracket _ parent child | isAtom child = False -- a -> (b -> c) is not a required bracket, but useful for documentation about arity etc. -- | TyFun{} <- parent, i == 1, TyFun{} <- child = False | TyFun{} <- parent, TyApp{} <- child = False | TyTuple{} <- parent = False | TyList{} <- parent = False | TyInfix{} <- parent, TyApp{} <- child = False | TyParen{} <- parent = False | otherwise = True instance Default l => Brackets (Pat l) where remParen (PParen _ x) = Just x remParen _ = Nothing addParen = PParen def isAtom x = case x of PParen{} -> True PTuple{} -> True PList{} -> True PRec{} -> True PVar{} -> True PApp _ _ [] -> True PWildCard{} -> True _ -> False needBracket _ parent child | isAtom child = False | PTuple{} <- parent = False | PList{} <- parent = False | PInfixApp{} <- parent, PApp{} <- child = False | PParen{} <- parent = False | otherwise = True -- | Add a Paren around something if it is not atomic paren :: (Data l, Default l) => Exp l -> Exp l paren x = if isAtom x then x else addParen x -- | Descend, and if something changes then add/remove brackets appropriately descendBracket :: (Data l, Default l) => (Exp l -> (Bool, Exp l)) -> Exp l -> Exp l descendBracket op x = descendIndex g x where g i y = if a then f i b else b where (a,b) = op y f i (Paren _ y) | not $ needBracket i x y = y f i y | needBracket i x y = addParen y f _ y = y transformBracket :: (Data l, Default l) => (Exp l -> Maybe (Exp l)) -> Exp l -> Exp l transformBracket op = snd . g where g = f . descendBracket g f x = maybe (False,x) ((,) True) (op x) -- | Add/remove brackets as suggested needBracket at 1-level of depth rebracket1 :: (Data l, Default l) => Exp l -> Exp l rebracket1 = descendBracket (\x -> (True,x)) -- a list of application, with any necessary brackets appsBracket :: (Data l, Default l) => [Exp l] -> Exp l appsBracket = foldl1 (\x -> rebracket1 . App def x) descendIndex :: Data a => (Int -> a -> a) -> a -> a descendIndex f x = flip evalState 0 $ flip descendM x $ \y -> do i <- get modify (+1) return $ f i y haskell-src-exts-util-0.2.1.2/src/Language/Haskell/Exts/FreeVars.hs0000644000000000000000000001371713150077451023111 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -fno-warn-name-shadowing #-} -- | The contents of this module originate from module -- [HSE.FreeVars](https://github.com/ndmitchell/hlint/blob/master/src/HSE/FreeVars.hs) -- in Neil Mitchell's HLint. module Language.Haskell.Exts.FreeVars ( FreeVars(..) , Vars(..) , AllVars(..) ) where import Data.Data import Data.Generics.Uniplate.Data import Data.Monoid (Monoid(..)) import Data.Set (Set) import qualified Data.Set as Set import Language.Haskell.Exts import Prelude (^+) :: (Data s, Ord s) => Set (Name s) -> Set (Name s) -> Set (Name s) (^+) = Set.union (^-) :: (Data s, Ord s) => Set (Name s) -> Set (Name s) -> Set (Name s) (^-) = Set.difference data Vars = Vars {bound :: Set (Name ()), free :: Set (Name ())} instance Monoid Vars where mempty = Vars Set.empty Set.empty mappend (Vars x1 x2) (Vars y1 y2) = Vars (x1 ^+ y1) (x2 ^+ y2) mconcat fvs = Vars (Set.unions $ map bound fvs) (Set.unions $ map free fvs) class AllVars a where -- | Return the variables, erring on the side of more free variables allVars :: a -> Vars class FreeVars a where -- | Return the variables, erring on the side of more free variables freeVars :: a -> Set (Name ()) freeVars_ :: (FreeVars a) => a -> Vars freeVars_ = Vars Set.empty . freeVars inFree :: (AllVars a, FreeVars b) => a -> b -> Set (Name ()) inFree a b = free aa ^+ (freeVars b ^- bound aa) where aa = allVars a inVars :: (AllVars a, AllVars b) => a -> b -> Vars inVars a b = Vars (bound aa ^+ bound bb) (free aa ^+ (free bb ^- bound aa)) where aa = allVars a bb = allVars b unqualNames :: QName s -> [Name ()] unqualNames (UnQual _ x) = [withNoLoc x] unqualNames _ = [] unqualOp :: QOp s -> [Name ()] unqualOp (QVarOp _ x) = unqualNames x unqualOp (QConOp _ x) = unqualNames x withNoLoc x = fmap (const()) x instance (Data s, Ord s) => FreeVars (Set (Name s)) where freeVars = Set.map withNoLoc instance AllVars Vars where allVars = id instance (Data s, Ord s) => FreeVars (Exp s) where -- never has any bound variables freeVars (Var _ x) = Set.fromList $ unqualNames x freeVars (VarQuote l x) = freeVars $ Var l x freeVars (SpliceExp _ (IdSplice l x)) = Set.fromList [withNoLoc $ Ident l x] freeVars (InfixApp _ a op b) = freeVars a ^+ Set.fromList (unqualOp op) ^+ freeVars b freeVars (LeftSection _ a op) = freeVars a ^+ Set.fromList (unqualOp op) freeVars (RightSection _ op b) = Set.fromList (unqualOp op) ^+ freeVars b freeVars (Lambda _ p x) = inFree p x freeVars (Let _ bind x) = inFree bind x freeVars (Case _ x alts) = freeVars x `mappend` freeVars alts freeVars (Do _ xs) = free $ allVars xs freeVars (MDo l xs) = freeVars $ Do l xs freeVars (ParComp _ x xs) = free xfv ^+ (freeVars x ^- bound xfv) where xfv = mconcat $ map allVars xs freeVars (ListComp l x xs) = freeVars $ ParComp l x [xs] freeVars x = freeVars $ children x instance (Data s, Ord s) => FreeVars [Exp s] where freeVars = Set.unions . map freeVars instance (Data s, Ord s) => AllVars (Pat s) where allVars (PVar _ x) = Vars (Set.singleton $ withNoLoc x) Set.empty allVars (PNPlusK l x _) = allVars (PVar l x) allVars (PAsPat l n x) = allVars (PVar l n) `mappend` allVars x allVars (PWildCard _) = mempty -- explicitly cannot guess what might be bound here allVars (PViewPat _ e p) = freeVars_ e `mappend` allVars p allVars x = allVars $ children x instance (Data s, Ord s) => AllVars [Pat s] where allVars = mconcat . map allVars instance (Data s, Ord s) => FreeVars (Alt s) where freeVars (Language.Haskell.Exts.Alt _ pat alt bind) = inFree pat $ inFree bind alt instance (Data s, Ord s) => FreeVars [Alt s] where freeVars = mconcat . map freeVars instance (Data s, Ord s) => FreeVars (Rhs s) where freeVars (UnGuardedRhs _ x) = freeVars x freeVars (GuardedRhss _ xs) = mconcat $ map freeVars xs instance (Data s, Ord s) => FreeVars (GuardedRhs s) where freeVars (GuardedRhs _ stmt exp) = inFree stmt exp instance (Data s, Ord s) => AllVars (QualStmt s) where allVars (QualStmt _ x) = allVars x allVars x = freeVars_ (childrenBi x :: [Exp s]) instance (Data s, Ord s) => AllVars [QualStmt s] where allVars (x:xs) = inVars x xs allVars [] = mempty instance (Data s, Ord s) => AllVars [Stmt s] where allVars (x:xs) = inVars x xs allVars [] = mempty instance (Data s, Ord s) => AllVars (Stmt s) where allVars (Generator _ pat exp) = allVars pat `mappend` freeVars_ exp allVars (Qualifier _ exp) = freeVars_ exp allVars (LetStmt _ binds) = allVars binds allVars (RecStmt _ stmts) = allVars stmts instance (Data s, Ord s) => AllVars (Maybe (Binds s)) where allVars = maybe mempty allVars instance (Data s, Ord s) => AllVars (Binds s) where allVars (BDecls _ decls) = allVars decls allVars (IPBinds _ binds) = freeVars_ binds instance (Data s, Ord s) => AllVars [Decl s] where allVars = mconcat . map allVars instance (Data s, Ord s) => AllVars (Decl s) where allVars (FunBind _ m) = allVars m allVars (PatBind _ pat rhs bind) = allVars pat `mappend` freeVars_ (inFree bind rhs) allVars _ = mempty instance (Data s, Ord s) => AllVars [Match s] where allVars = mconcat . map allVars instance (Data s, Ord s) => AllVars (Match s) where allVars (Match l name pat rhs binds) = allVars (PVar l name) `mappend` freeVars_ (inFree pat (inFree binds rhs)) allVars (InfixMatch l p1 name p2 rhs binds) = allVars $ Match l name (p1:p2) rhs binds instance (Data s, Ord s) => FreeVars [IPBind s] where freeVars = mconcat . map freeVars instance (Data s, Ord s) => FreeVars (IPBind s) where freeVars (IPBind _ _ exp) = freeVars exp haskell-src-exts-util-0.2.1.2/src/Language/Haskell/Exts/Util/Internal.hs0000644000000000000000000000223313150077656024063 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# OPTIONS_GHC -fno-warn-name-shadowing #-} -- | The contents of this module originate from module -- [HSE.Util](https://github.com/ndmitchell/hlint/blob/master/src/HSE/Util.hs) -- in Neil Mitchell's HLint. module Language.Haskell.Exts.Util.Internal where import Language.Haskell.Exts import Prelude --------------------------------------------------------------------- -- ACCESSOR/TESTER -- is* :: Exp l -> Bool -- is* :: Decl s -> Bool isApp :: Exp l -> Bool isApp App{} = True; isApp _ = False isAnyApp :: Exp l -> Bool isAnyApp x = isApp x || isInfixApp x isInfixApp :: Exp l -> Bool isInfixApp InfixApp{} = True; isInfixApp _ = False isDot :: QOp s -> Bool isDot (QVarOp _ (UnQual _ (Symbol _ "."))) = True isDot _ = False isSection :: Exp l -> Bool isSection LeftSection{} = True isSection RightSection{} = True isSection _ = False isDotApp :: Exp s -> Bool isDotApp (InfixApp _ _ dot _) | isDot dot = True isDotApp _ = False isLexeme :: Exp l -> Bool isLexeme Var{} = True isLexeme Con{} = True isLexeme Lit{} = True isLexeme _ = False haskell-src-exts-util-0.2.1.2/LICENSE0000644000000000000000000000274713146044654015232 0ustar0000000000000000BSD 3-Clause License Copyright (c) 2017, Pepe Iborra 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 the copyright holder nor the names of its 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 HOLDER 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. haskell-src-exts-util-0.2.1.2/haskell-src-exts-util.cabal0000644000000000000000000000200513150123347021330 0ustar0000000000000000-- This file has been generated from package.yaml by hpack version 0.17.1. -- -- see: https://github.com/sol/hpack name: haskell-src-exts-util version: 0.2.1.2 synopsis: Helper functions for working with haskell-src-exts trees description: see README.md category: language homepage: https://github.com/pepeiborra/haskell-src-exts-util author: Neil Mitchell, Jose Iborra maintainer: pepeiborra@gmail.com copyright: All Rights Reserved license: BSD3 license-file: LICENSE build-type: Simple cabal-version: >= 1.10 extra-source-files: README.md library hs-source-dirs: src build-depends: base < 5 , containers , data-default , haskell-src-exts , transformers , uniplate exposed-modules: Language.Haskell.Exts.Util other-modules: Language.Haskell.Exts.Bracket Language.Haskell.Exts.FreeVars Language.Haskell.Exts.Util.Internal Paths_haskell_src_exts_util default-language: Haskell2010 haskell-src-exts-util-0.2.1.2/README.md0000644000000000000000000000154513146571356015503 0ustar0000000000000000[![Hackage](https://img.shields.io/hackage/v/haskell-src-exts-util.svg)](https://hackage.haskell.org/package/haskell-src-exts-util) [![Stackage Nightly](http://stackage.org/package/haskell-src-exts-util/badge/nightly)](http://stackage.org/nightly/package/haskell-src-exts-util) [![Travis Build Status](https://travis-ci.org/pepeiborra/haskell-src-exts-util.svg)](https://travis-ci.org/pepeiborra/haskell-src-exts-util) haskell-src-exts-util ===================== A small suite of helper functions for working with **haskell-src-exts**: - Free variables - Bound variables - Minimal (approximate) rebracketing of AST values such that prettyprint roundtrips. Acknowledgments ================ This package extracts some the HSE functions in **HLint** and generalizes them. The original code was authored over the years by Neil Mitchell and the rest of HLint contributors.