module Debug.Util(
hasRankNTypes,
prettyPrint,
mkLegalInfixVar,
removeLet,
removeExtraDigits
) where
import Data.Data
import Data.Generics.Uniplate.Data
import Data.List.Extra
import qualified Data.Map.Strict as M
import Data.Maybe
import Language.Haskell.TH
import Language.Haskell.TH.Syntax
removeLet :: String -> String
removeLet s =
if "let" `isInfixOf` fst (word1 s)
then case stripInfix " = " s of
Just pair -> removeLet (snd pair)
Nothing -> s
else fst $ word1 s
removeExtraDigits :: String -> String
removeExtraDigits str = case stripInfixEnd "_" str of
Just s -> fst s
Nothing -> str
mkLegalInfixVar :: String -> String
mkLegalInfixVar s =
let f c acc = case M.lookup c opNames of
Just "" -> acc
Just s -> s ++ "_" ++ acc
Nothing -> c : acc
removeTrailing_ x = fromMaybe x $ stripSuffix "_" x
in removeTrailing_ $ foldr f "" s
opNames :: M.Map Char String
opNames = M.fromList opList where
opList = [ ('+', "plus"), ('-', "minus"), ('*', "star"), ('/', "div")
, ('^', "caret"), ('~', "tilde"), ('%', "percent"), ('&', "amp")
, ('=', "equals"), ('<', "lt"), ('>', "gt"), ('?', "quest"), (':', "cons")
, ('.', "dot"), ('@', "at"), ('#', "hash"), ('!', "bang"), ('|', "bar")
, ('`', "")
]
hasRankNTypes, hasRankNTypes' :: Type -> Bool
hasRankNTypes (ForallT _vars _ctxt typ) = hasRankNTypes' typ
hasRankNTypes typ = hasRankNTypes' typ
hasRankNTypes' typ = not $ null [ () | ForallT{} <- universe typ]
prettyPrint :: (Data a, Ppr a) => a -> String
prettyPrint = pprint . transformBi f
where f (Name x _) = Name x NameS