{- |
Copyright: (c) 2020 Kowainik
SPDX-License-Identifier: MPL-2.0
Maintainer: Kowainik <xrom.xkov@gmail.com>

Wrapper around Haskell module names and conversion functions for GHC
types.
-}

module Stan.Core.ModuleName
    ( ModuleName (..)
    , fromGhcModule
    , fromGhcModuleName
    ) where

import Data.Aeson.Micro (ToJSON)

import qualified Stan.Ghc.Compat as Ghc


-- | Wrapper around Haskell module name.
newtype ModuleName = ModuleName
    { ModuleName -> Text
unModuleName :: Text
    } deriving stock (Int -> ModuleName -> ShowS
[ModuleName] -> ShowS
ModuleName -> String
(Int -> ModuleName -> ShowS)
-> (ModuleName -> String)
-> ([ModuleName] -> ShowS)
-> Show ModuleName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModuleName] -> ShowS
$cshowList :: [ModuleName] -> ShowS
show :: ModuleName -> String
$cshow :: ModuleName -> String
showsPrec :: Int -> ModuleName -> ShowS
$cshowsPrec :: Int -> ModuleName -> ShowS
Show)
      deriving newtype (ModuleName -> ModuleName -> Bool
(ModuleName -> ModuleName -> Bool)
-> (ModuleName -> ModuleName -> Bool) -> Eq ModuleName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModuleName -> ModuleName -> Bool
$c/= :: ModuleName -> ModuleName -> Bool
== :: ModuleName -> ModuleName -> Bool
$c== :: ModuleName -> ModuleName -> Bool
Eq, Int -> ModuleName -> Int
ModuleName -> Int
(Int -> ModuleName -> Int)
-> (ModuleName -> Int) -> Hashable ModuleName
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: ModuleName -> Int
$chash :: ModuleName -> Int
hashWithSalt :: Int -> ModuleName -> Int
$chashWithSalt :: Int -> ModuleName -> Int
Hashable, String -> ModuleName
(String -> ModuleName) -> IsString ModuleName
forall a. (String -> a) -> IsString a
fromString :: String -> ModuleName
$cfromString :: String -> ModuleName
IsString, ModuleName -> Value
(ModuleName -> Value) -> ToJSON ModuleName
forall a. (a -> Value) -> ToJSON a
toJSON :: ModuleName -> Value
$ctoJSON :: ModuleName -> Value
ToJSON)

-- | Convert 'GHC.ModuleName' to 'ModuleName'.
fromGhcModuleName :: Ghc.ModuleName -> ModuleName
fromGhcModuleName :: ModuleName -> ModuleName
fromGhcModuleName = Text -> ModuleName
ModuleName (Text -> ModuleName)
-> (ModuleName -> Text) -> ModuleName -> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. ToText a => a -> Text
toText (String -> Text) -> (ModuleName -> String) -> ModuleName -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> String
Ghc.moduleNameString

-- | Extract 'ModuleName' from 'GHC.Module'.
fromGhcModule :: Ghc.Module -> ModuleName
fromGhcModule :: Module -> ModuleName
fromGhcModule = ModuleName -> ModuleName
fromGhcModuleName (ModuleName -> ModuleName)
-> (Module -> ModuleName) -> Module -> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> ModuleName
Ghc.moduleName