language-haskell-extract (empty) → 0.1.2

raw patch · 4 files changed

+195/−0 lines, 4 filesdep +basedep +haskell-src-extsdep +haskell98setup-changed

Dependencies added: base, haskell-src-exts, haskell98, regex-posix, template-haskell

Files

BSD3.txt +24/−0
Setup.lhs +6/−0
language-haskell-extract.cabal +79/−0
src/Language/Haskell/Extract.hs +86/−0

+ BSD3.txt view

@@ -0,0 +1,24 @@+Copyright (c) 2010, Oscar Finnsson+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 Oscar Finnsson 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 Oscar Finnsson 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.lhs view

@@ -0,0 +1,6 @@+#!/usr/bin/runhaskell +> module Main where+> import Distribution.Simple+> main :: IO ()+> main = defaultMain+

+ language-haskell-extract.cabal view

@@ -0,0 +1,79 @@+name: language-haskell-extract+version: 0.1.2+cabal-version: -any+build-type: Simple+license: BSD3+license-file: "BSD3.txt"+maintainer: Oscar Finnsson+build-depends: base >= 4 && < 5, haskell98, regex-posix, haskell-src-exts, template-haskell+stability: stable+homepage: http://github.com/finnsson/template-helper+package-url:+bug-reports:+synopsis: Module to automatically extract functions from the local code.+description:+   @language-haskell-extract@ contains some useful helper functions on top of Template Haskell.+   .+   @functionExtractor@ extracts all functions after a regexp-pattern.+   .+   > foo = "test"+   > boo = "testing"+   > bar = $(functionExtractor "oo$")+   .  +   will automagically extract the functions ending with @oo@ such as+   . +   > bar = [("foo",foo), ("boo",boo)]+   .+   This can be useful if you wish to extract all functions beginning with test (for a test-framework)+   or all functions beginning with wc (for a web service).+   .+   @functionExtractorMap@ works like @functionsExtractor@ but applies a function over all function-pairs.+   .+   This functions is useful if the common return type of the functions is a type class.+   .+   Example:+   .+   > secondTypeclassTest =+   >   do let expected = ["45", "88.8", "\"hej\""]+   >          actual = $(functionExtractorMap "^tc" [|\n f -> show f|] )+   >      expected @=? actual+   > +   > tcInt :: Integer+   > tcInt = 45+   > +   > tcDouble :: Double+   > tcDouble = 88.8+   > +   > tcString :: String+   > tcString = "hej"+category: Template Haskell+author: Oscar Finnsson & Emil Nordling+tested-with:+data-files:+data-dir: ""+extra-source-files:+extra-tmp-files:+exposed-modules: Language.Haskell.Extract +exposed: True+buildable: True+build-tools:+cpp-options:+cc-options:+ld-options:+pkgconfig-depends:+frameworks:+c-sources:+extensions:+extra-libraries:+extra-lib-dirs:+includes:+install-includes:+include-dirs:+hs-source-dirs: src+other-modules:+ghc-prof-options:+ghc-shared-options:+ghc-options:+hugs-options:+nhc98-options:+jhc-options:

+ src/Language/Haskell/Extract.hs view

@@ -0,0 +1,86 @@+module Language.Haskell.Extract (+  functionExtractor,+  functionExtractorMap,+  locationModule+) where+import Language.Haskell.TH+import Language.Haskell.Exts.Parser+import Language.Haskell.Exts.Syntax+import Text.Regex.Posix+import Maybe+import Language.Haskell.Exts.Extension++extractAllFunctions :: String -> String-> [String]+extractAllFunctions pattern  = +  allMatchingFunctions pattern . parsedModule++parsedModule moduleCode = +  let pMod = parseModuleWithMode ( ParseMode "test" [TemplateHaskell] False False [] ) moduleCode+      moduleOrDefault (ParseFailed _ _) = Module (SrcLoc "unknown" 1 1) (ModuleName "unknown") [] Nothing Nothing [] []+      moduleOrDefault (ParseOk m) = m+  in moduleOrDefault pMod ++allFunctions =  onlyJust extractNameOfFunctionFromDecl . hsModuleDecls +allMatchingFunctions pattern = filter (\f->f=~pattern::Bool) . allFunctions ++++extractNameOfFunctionFromDecl :: Decl -> Maybe String+extractNameOfFunctionFromDecl (PatBind _ (PVar (Ident n)) _ _ _ ) = Just n+extractNameOfFunctionFromDecl (FunBind ms) = Just $ head $ [n | (Language.Haskell.Exts.Syntax.Match _ (Ident n) _ _ _ _)  <- ms]+extractNameOfFunctionFromDecl _ = Nothing++onlyJust f = map fromJust . filter isJust . map f++hsModuleDecls (Module _ _ _ _ _ _ d) = d++-- | Extract the names and functions from the module where this function is called.+-- +--  > foo = "test"+--  > boo = "testing"+--  > bar = $(functionExtractor "oo$")+-- +-- will automagically extract the functions ending with "oo" such as+-- +-- > bar = [("foo",foo), ("boo",boo)]+functionExtractor :: String -> ExpQ+functionExtractor pattern =+  do loc <- location+     moduleCode <- runIO $ readFile $ loc_filename loc+     let functions = extractAllFunctions pattern moduleCode+         makePair n = TupE [ LitE $ StringL n , VarE $ mkName n]+     return $ ListE $ map makePair functions+++-- | Extract the names and functions from the module and apply a function to every pair.+-- +-- Is very useful if the common denominator of the functions is just a type class.+--+-- > secondTypeclassTest =+-- >   do let expected = ["45", "88.8", "\"hej\""]+-- >          actual = $(functionExtractorMap "^tc" [|\n f -> show f|] )+-- >      expected @=? actual+-- > +-- > tcInt :: Integer+-- > tcInt = 45+-- > +-- > tcDouble :: Double+-- > tcDouble = 88.8+-- > +-- > tcString :: String+-- > tcString = "hej"+functionExtractorMap :: String -> ExpQ -> ExpQ+functionExtractorMap pattern funcName =+  do loc <- location+     moduleCode <- runIO $ readFile $ loc_filename loc+     let functions :: [String]+         functions = extractAllFunctions pattern moduleCode+     fn <- funcName+     let makePair n = AppE (AppE (fn) (LitE $ StringL n)) (VarE $ mkName n)+     return $ ListE $ map makePair functions ++-- | Extract the name of the current module.+locationModule :: ExpQ+locationModule =+  do loc <- location+     return $ LitE $ StringL $ loc_module loc