{-# LANGUAGE DeriveAnyClass     #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFunctor      #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE OverloadedStrings  #-}

module Language.Dickinson.Name ( TyName
                               , Name (..)
                               , NameEnv
                               , isMain
                               ) where

import           Control.DeepSeq               (NFData (..))
import           Data.Binary                   (Binary (..))
import           Data.Data                     (Data)
import           Data.Foldable                 (toList)
import qualified Data.IntMap                   as IM
import           Data.List.NonEmpty            (NonEmpty (..))
import           Data.Semigroup                ((<>))
import qualified Data.Text                     as T
import           Data.Text.Prettyprint.Doc.Ext (Debug (..), intercalate)
import           GHC.Generics                  (Generic)
import           Language.Dickinson.Unique
import           Prettyprinter                 (Pretty (pretty))

type TyName a = Name a

-- TODO: separate type for module name
-- | A (possibly qualified) name.
data Name a = Name { forall a. Name a -> NonEmpty Text
name   :: NonEmpty T.Text
                   , forall a. Name a -> Unique
unique :: !Unique
                   , forall a. Name a -> a
loc    :: a
                   } deriving (forall a b. a -> Name b -> Name a
forall a b. (a -> b) -> Name a -> Name b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Name b -> Name a
$c<$ :: forall a b. a -> Name b -> Name a
fmap :: forall a b. (a -> b) -> Name a -> Name b
$cfmap :: forall a b. (a -> b) -> Name a -> Name b
Functor, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Name a) x -> Name a
forall a x. Name a -> Rep (Name a) x
$cto :: forall a x. Rep (Name a) x -> Name a
$cfrom :: forall a x. Name a -> Rep (Name a) x
Generic, forall a. Binary a => Get (Name a)
forall a. Binary a => [Name a] -> Put
forall a. Binary a => Name a -> Put
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [Name a] -> Put
$cputList :: forall a. Binary a => [Name a] -> Put
get :: Get (Name a)
$cget :: forall a. Binary a => Get (Name a)
put :: Name a -> Put
$cput :: forall a. Binary a => Name a -> Put
Binary, Int -> Name a -> ShowS
forall a. Show a => Int -> Name a -> ShowS
forall a. Show a => [Name a] -> ShowS
forall a. Show a => Name a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Name a] -> ShowS
$cshowList :: forall a. Show a => [Name a] -> ShowS
show :: Name a -> String
$cshow :: forall a. Show a => Name a -> String
showsPrec :: Int -> Name a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Name a -> ShowS
Show, Name a -> DataType
Name a -> Constr
forall {a}. Data a => Typeable (Name a)
forall a. Data a => Name a -> DataType
forall a. Data a => Name a -> Constr
forall a.
Data a =>
(forall b. Data b => b -> b) -> Name a -> Name a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Name a -> u
forall a u. Data a => (forall d. Data d => d -> u) -> Name a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Name a -> r
forall a r r'.
Data a =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Name a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Name a -> m (Name a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Name a -> m (Name a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Name a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Name a -> c (Name a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Name a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Name a))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Name a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Name a -> c (Name a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Name a))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Name a -> m (Name a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Name a -> m (Name a)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Name a -> m (Name a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Name a -> m (Name a)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Name a -> m (Name a)
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Name a -> m (Name a)
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Name a -> u
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Name a -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Name a -> [u]
$cgmapQ :: forall a u. Data a => (forall d. Data d => d -> u) -> Name a -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Name a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Name a -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Name a -> r
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Name a -> r
gmapT :: (forall b. Data b => b -> b) -> Name a -> Name a
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> Name a -> Name a
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Name a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Name a))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Name a))
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Name a))
dataTypeOf :: Name a -> DataType
$cdataTypeOf :: forall a. Data a => Name a -> DataType
toConstr :: Name a -> Constr
$ctoConstr :: forall a. Data a => Name a -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Name a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Name a)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Name a -> c (Name a)
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Name a -> c (Name a)
Data)

instance NFData a => NFData (Name a) where
    rnf :: Name a -> ()
rnf (Name NonEmpty Text
_ Unique
u a
x) = forall a. NFData a => a -> ()
rnf a
x seq :: forall a b. a -> b -> b
`seq` Unique
u seq :: forall a b. a -> b -> b
`seq` ()

isMain :: Name a -> Bool
isMain :: forall a. Name a -> Bool
isMain = (forall a. Eq a => a -> a -> Bool
== (Text
"main" forall a. a -> [a] -> NonEmpty a
:| [])) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Name a -> NonEmpty Text
name

instance Eq (Name a) where
    == :: Name a -> Name a -> Bool
(==) (Name NonEmpty Text
_ Unique
u a
_) (Name NonEmpty Text
_ Unique
u' a
_) = Unique
u forall a. Eq a => a -> a -> Bool
== Unique
u'

instance Ord (Name a) where
    compare :: Name a -> Name a -> Ordering
compare (Name NonEmpty Text
_ Unique
u a
_) (Name NonEmpty Text
_ Unique
u' a
_) = forall a. Ord a => a -> a -> Ordering
compare Unique
u Unique
u'

instance Pretty (Name a) where
    pretty :: forall ann. Name a -> Doc ann
pretty (Name NonEmpty Text
t Unique
_ a
_) = forall a. Doc a -> [Doc a] -> Doc a
intercalate Doc ann
"." (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (forall a ann. Pretty a => a -> Doc ann
pretty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty Text
t))

instance Debug (Name a) where
    debug :: forall b. Name a -> Doc b
debug (Name NonEmpty Text
t Unique
u a
_) = forall a. Doc a -> [Doc a] -> Doc a
intercalate Doc b
"." (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (forall a ann. Pretty a => a -> Doc ann
pretty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty Text
t)) forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Unique
u

type NameEnv a = IM.IntMap (Name a)