module Language.Haskell.Meta.QQ.Idiom (i) where
import Data.Generics
(Data,everywhere,mkT)
import Control.Applicative
import Language.Haskell.Meta
import Language.Haskell.TH.Lib
import Language.Haskell.TH.Quote
import Language.Haskell.TH.Syntax
i :: QuasiQuoter
i = QuasiQuoter ((cleanNames <$>) . applicateQ)
(either fail return . parsePat)
applicateQ :: String -> ExpQ
applicateQ s = case either fail unwindE (parseExp s) of
x:y:xs -> foldl
(\e e' -> [|$e <*> $e'|])
[|$(return x) <$> $(return y)|]
(fmap return xs)
_ -> fail "applicateQ fails."
unwindE :: Exp -> [Exp]
unwindE = go []
where go acc (e `AppE` e') = go (e':acc) e
go acc e = e:acc
cleanNames :: (Data a) => a -> a
cleanNames = everywhere (mkT cleanName)
where cleanName :: Name -> Name
cleanName n
| isNameU n = n
| otherwise = (mkName . nameBase) n
isNameU :: Name -> Bool
isNameU (Name _ (NameU _)) = True
isNameU _ = False