{-# LANGUAGE ViewPatterns #-}
module Ide.Plugin.Tactic.Naming where
import Control.Monad.State.Strict
import Data.Bool (bool)
import Data.Char
import Data.Map (Map)
import qualified Data.Map as M
import Data.Traversable
import Name
import TcType
import TyCon
import Type
import TysWiredIn (listTyCon, pairTyCon, unitTyCon)
mkTyName :: Type -> String
mkTyName :: Type -> String
mkTyName (Type -> ([Type], Type)
tcSplitFunTys -> ([a :: Type
a@(Type -> Bool
isFunTy -> Bool
False)], Type
b))
= String
"f" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Type -> String
mkTyName Type
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ Type -> String
mkTyName Type
b
mkTyName (Type -> ([Type], Type)
tcSplitFunTys -> ((Type
_:[Type]
_), Type
b))
= String
"f_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Type -> String
mkTyName Type
b
mkTyName (HasDebugCallStack => Type -> Maybe (TyCon, [Type])
Type -> Maybe (TyCon, [Type])
splitTyConApp_maybe -> Just (TyCon
c, [Type]
args))
= TyCon -> String
mkTyConName TyCon
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Type -> String) -> [Type] -> String
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Type -> String
mkTyName [Type]
args
mkTyName (Type -> Maybe TyVar
getTyVar_maybe -> Just TyVar
tv)
= OccName -> String
occNameString (OccName -> String) -> OccName -> String
forall a b. (a -> b) -> a -> b
$ TyVar -> OccName
forall name. HasOccName name => name -> OccName
occName TyVar
tv
mkTyName (Type -> ([TyVar], [Type], Type)
tcSplitSigmaTy -> ((TyVar
_:[TyVar]
_), [Type]
_, Type
t))
= Type -> String
mkTyName Type
t
mkTyName Type
_ = String
"x"
mkTyConName :: TyCon -> String
mkTyConName :: TyCon -> String
mkTyConName TyCon
tc
| TyCon
tc TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== TyCon
listTyCon = String
"l_"
| TyCon
tc TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== TyCon
pairTyCon = String
"p_"
| TyCon
tc TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== TyCon
unitTyCon = String
"unit"
| Bool
otherwise
= Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1
(String -> String) -> (OccName -> String) -> OccName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> String -> String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toLower
(String -> String) -> (OccName -> String) -> OccName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Char -> String -> String
forall a. (a -> Bool) -> a -> [a] -> [a]
filterReplace Char -> Bool
isSymbol Char
's'
(String -> String) -> (OccName -> String) -> OccName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Char -> String -> String
forall a. (a -> Bool) -> a -> [a] -> [a]
filterReplace Char -> Bool
isPunctuation Char
'p'
(String -> String) -> (OccName -> String) -> OccName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccName -> String
occNameString
(OccName -> String) -> OccName -> String
forall a b. (a -> b) -> a -> b
$ TyCon -> OccName
forall a. NamedThing a => a -> OccName
getOccName TyCon
tc
filterReplace :: (a -> Bool) -> a -> [a] -> [a]
filterReplace :: (a -> Bool) -> a -> [a] -> [a]
filterReplace a -> Bool
f a
r = (a -> a) -> [a] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
a -> a -> a -> Bool -> a
forall a. a -> a -> Bool -> a
bool a
a a
r (Bool -> a) -> Bool -> a
forall a b. (a -> b) -> a -> b
$ a -> Bool
f a
a)
mkGoodName
:: [OccName]
-> Type
-> OccName
mkGoodName :: [OccName] -> Type -> OccName
mkGoodName [OccName]
in_scope Type
t =
let tn :: String
tn = Type -> String
mkTyName Type
t
in String -> OccName
mkVarOcc (String -> OccName) -> String -> OccName
forall a b. (a -> b) -> a -> b
$ case OccName -> [OccName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (String -> OccName
mkVarOcc String
tn) [OccName]
in_scope of
Bool
True -> String
tn String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([OccName] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [OccName]
in_scope)
Bool
False -> String
tn
mkManyGoodNames
:: (Traversable t, Monad m)
=> M.Map OccName a
-> t Type
-> m (t OccName)
mkManyGoodNames :: Map OccName a -> t Type -> m (t OccName)
mkManyGoodNames Map OccName a
hy t Type
args =
(StateT [OccName] m (t OccName) -> [OccName] -> m (t OccName))
-> [OccName] -> StateT [OccName] m (t OccName) -> m (t OccName)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT [OccName] m (t OccName) -> [OccName] -> m (t OccName)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (Map OccName a -> [OccName]
forall a. Map OccName a -> [OccName]
getInScope Map OccName a
hy) (StateT [OccName] m (t OccName) -> m (t OccName))
-> StateT [OccName] m (t OccName) -> m (t OccName)
forall a b. (a -> b) -> a -> b
$ t Type
-> (Type -> StateT [OccName] m OccName)
-> StateT [OccName] m (t OccName)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for t Type
args ((Type -> StateT [OccName] m OccName)
-> StateT [OccName] m (t OccName))
-> (Type -> StateT [OccName] m OccName)
-> StateT [OccName] m (t OccName)
forall a b. (a -> b) -> a -> b
$ \Type
at -> do
[OccName]
in_scope <- StateT [OccName] m [OccName]
forall s (m :: * -> *). MonadState s m => m s
get
let n :: OccName
n = [OccName] -> Type -> OccName
mkGoodName [OccName]
in_scope Type
at
([OccName] -> [OccName]) -> StateT [OccName] m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (OccName
n OccName -> [OccName] -> [OccName]
forall a. a -> [a] -> [a]
:)
OccName -> StateT [OccName] m OccName
forall (f :: * -> *) a. Applicative f => a -> f a
pure OccName
n
getInScope :: Map OccName a -> [OccName]
getInScope :: Map OccName a -> [OccName]
getInScope = Map OccName a -> [OccName]
forall k a. Map k a -> [k]
M.keys