module Language.Haskell.Extract (
  functionExtractor,
  functionExtractorMap,
  locationModule
) where
import Language.Haskell.TH
import Language.Haskell.Exts.Parser
import Language.Haskell.Exts (parseFileContentsWithMode)
import Language.Haskell.Exts.Syntax
import Text.Regex.Posix
import Data.Maybe
import Data.List
import Language.Haskell.Exts.Extension

extractAllFunctions :: String -> String-> [String]
extractAllFunctions pattern file  = 
--  allMatchingFunctions pattern . parsedModule
  nub $ filter (\f->f=~pattern::Bool) $ map (fst . head . lex) $ lines file

-- nub $ filter ("prop_" `isPrefixOf`) $
-- map (fst . head . lex) $ lines ct


parsedModule moduleCode = 
  let pMod = parseFileContentsWithMode (defaultParseMode { extensions = knownExtensions } ) 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


-- functionExtractor' :: String -> Q [String]
-- functionExtractor' pattern =
--   do loc <- location
--      moduleCode <- runIO $ readFile $ loc_filename loc
--      let functions = extractAllFunctions pattern moduleCode
--      return 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 

-- functionExtractorExpMap :: String -> (Exp -> ExpQ) -> ExpQ
-- functionExtractorExpMap pattern func =
--   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