module Language.Haskell.Extract (
functionExtractor,
functionExtractorMap,
locationModule
) where
import Language.Haskell.TH
import Text.Regex.Posix
import Data.List
extractAllFunctions :: String -> Q [String]
pattern :: String
pattern =
do Loc
loc <- Q Loc
location
String
file <- IO String -> Q String
forall a. IO a -> Q a
runIO (IO String -> Q String) -> IO String -> Q String
forall a b. (a -> b) -> a -> b
$ String -> IO String
readFile (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ Loc -> String
loc_filename Loc
loc
[String] -> Q [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> Q [String]) -> [String] -> Q [String]
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
forall a. Eq a => [a] -> [a]
nub ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
RegexContext Regex source1 target) =>
source1 -> source -> target
=~String
pattern) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ ((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
forall a b. (a, b) -> a
fst ([(String, String)] -> [String]) -> [(String, String)] -> [String]
forall a b. (a -> b) -> a -> b
$ [[(String, String)]] -> [(String, String)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(String, String)]] -> [(String, String)])
-> [[(String, String)]] -> [(String, String)]
forall a b. (a -> b) -> a -> b
$ (String -> [(String, String)]) -> [String] -> [[(String, String)]]
forall a b. (a -> b) -> [a] -> [b]
map String -> [(String, String)]
lex ([String] -> [[(String, String)]])
-> [String] -> [[(String, String)]]
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines String
file
functionExtractor :: String -> ExpQ
pattern :: String
pattern =
do [String]
functions <- String -> Q [String]
extractAllFunctions String
pattern
let makePair :: String -> Exp
makePair n :: String
n = [Exp] -> Exp
TupE [ Lit -> Exp
LitE (Lit -> Exp) -> Lit -> Exp
forall a b. (a -> b) -> a -> b
$ String -> Lit
StringL String
n , Name -> Exp
VarE (Name -> Exp) -> Name -> Exp
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
n]
Exp -> ExpQ
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> ExpQ) -> Exp -> ExpQ
forall a b. (a -> b) -> a -> b
$ [Exp] -> Exp
ListE ([Exp] -> Exp) -> [Exp] -> Exp
forall a b. (a -> b) -> a -> b
$ (String -> Exp) -> [String] -> [Exp]
forall a b. (a -> b) -> [a] -> [b]
map String -> Exp
makePair [String]
functions
functionExtractorMap :: String -> ExpQ -> ExpQ
pattern :: String
pattern funcName :: ExpQ
funcName =
do [String]
functions <- String -> Q [String]
extractAllFunctions String
pattern
Exp
fn <- ExpQ
funcName
let makePair :: String -> Exp
makePair n :: String
n = Exp -> Exp -> Exp
AppE (Exp -> Exp -> Exp
AppE (Exp
fn) (Lit -> Exp
LitE (Lit -> Exp) -> Lit -> Exp
forall a b. (a -> b) -> a -> b
$ String -> Lit
StringL String
n)) (Name -> Exp
VarE (Name -> Exp) -> Name -> Exp
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
n)
Exp -> ExpQ
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> ExpQ) -> Exp -> ExpQ
forall a b. (a -> b) -> a -> b
$ [Exp] -> Exp
ListE ([Exp] -> Exp) -> [Exp] -> Exp
forall a b. (a -> b) -> a -> b
$ (String -> Exp) -> [String] -> [Exp]
forall a b. (a -> b) -> [a] -> [b]
map String -> Exp
makePair [String]
functions
locationModule :: ExpQ
locationModule :: ExpQ
locationModule =
do Loc
loc <- Q Loc
location
Exp -> ExpQ
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> ExpQ) -> Exp -> ExpQ
forall a b. (a -> b) -> a -> b
$ Lit -> Exp
LitE (Lit -> Exp) -> Lit -> Exp
forall a b. (a -> b) -> a -> b
$ String -> Lit
StringL (String -> Lit) -> String -> Lit
forall a b. (a -> b) -> a -> b
$ Loc -> String
loc_module Loc
loc