content: -- | Module containing functions required by test code. Not part of the public interface.
  module Debug.Util(
      hasRankNTypes,
      prettyPrint,
      -- * Exported for tests only
      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
  
  -- | Discover the function name inside (possibly nested) let expressions
  --   Transform strings of the form "let (var tag "f" -> f) = f x in f_1" into "f"
  removeLet :: String -> String
  removeLet s =
      if "let" `isInfixOf` fst (word1 s)
          then case stripInfix " = " s of
              Just pair -> removeLet (snd pair)
              Nothing   -> s    -- this shouldn't happen...
          else fst $ word1 s
  
  -- | Remove possible _n suffix from discovered function names
  removeExtraDigits :: String -> String
  removeExtraDigits str = maybe str fst (stripInfixEnd "_" str)
  
  -- | Trsansform infix operator into a valid variable name
  -- | For example "++"" ---> "plus_plus"
  -- | This transformed variable is not visible in the UI
  mkLegalInfixVar :: String -> String
  mkLegalInfixVar s =
      let f c acc = case M.lookup c opNames of
              Just "" -> acc -- no adl underscores when removing backtics
              Just s  -> s ++ "_" ++ acc
              Nothing -> c : acc
          removeTrailing_ x = fromMaybe x $ stripSuffix "_" x
      in removeTrailing_ $ foldr f "" s
  
  -- | Legal variable names for each operator character
  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")
               , ('`', "") -- remove backtics to form variable name
               ]
  
  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 -- avoid nasty qualifications
  