module Language.Haskell.Extract (
functionExtractor,
functionExtractorMap,
locationModule
) where
import Language.Haskell.TH
import Text.Regex.Posix
import Data.List
extractAllFunctions :: String -> Q [String]
extractAllFunctions pattern =
do loc <- location
file <- runIO $ readFile $ loc_filename loc
return $ nub $ filter (=~pattern) $ map fst $ concat $ map lex $ lines file
-- | 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 functions <- extractAllFunctions pattern
let 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 functions <- extractAllFunctions pattern
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