{-# LANGUAGE CPP, PatternSynonyms, ViewPatterns, OverloadedStrings #-}

module HsDev.Symbols.Name (
	Name, qualName, unqualName, nameModule, nameIdent, pattern Name, fromName_, toName_, toModuleName_, fromModuleName_, fromName, toName,
	name_, moduleName_
	) where

import Control.Arrow
import Control.Lens
import Data.Char (isAlpha, isAlphaNum)
import Data.Text (Text)
import Data.String (fromString)
import qualified Data.Text as T
import Language.Haskell.Exts (QName(..), ModuleName(..), Boxed(..), SpecialCon(..))
import qualified Language.Haskell.Exts as Exts (Name(..))

-- | Qualified name
type Name = QName ()

qualName :: String -> String -> Name
qualName :: String -> String -> Name
qualName String
m = () -> ModuleName () -> Name () -> Name
forall l. l -> ModuleName l -> Name l -> QName l
Qual () (() -> String -> ModuleName ()
forall l. l -> String -> ModuleName l
ModuleName () String
m) (Name () -> Name) -> (String -> Name ()) -> String -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Name ()
toName_ (Text -> Name ()) -> (String -> Text) -> String -> Name ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. IsString a => String -> a
fromString

unqualName :: String -> Name
unqualName :: String -> Name
unqualName = () -> Name () -> Name
forall l. l -> Name l -> QName l
UnQual () (Name () -> Name) -> (String -> Name ()) -> String -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Name ()
toName_ (Text -> Name ()) -> (String -> Text) -> String -> Name ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. IsString a => String -> a
fromString

nameModule :: Name -> Maybe Text
nameModule :: Name -> Maybe Text
nameModule (Qual ()
_ (ModuleName ()
_ String
m) Name ()
_) = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString String
m
nameModule Name
_ = Maybe Text
forall a. Maybe a
Nothing

nameIdent :: Name -> Text
nameIdent :: Name -> Text
nameIdent (Qual ()
_ ModuleName ()
_ Name ()
n) = Name () -> Text
fromName_ Name ()
n
nameIdent (UnQual ()
_ Name ()
n) = Name () -> Text
fromName_ Name ()
n
nameIdent Name
s = Name -> Text
fromName Name
s

pattern Name :: Maybe Text -> Text -> Name
pattern $bName :: Maybe Text -> Text -> Name
$mName :: forall r. Name -> (Maybe Text -> Text -> r) -> (Void# -> r) -> r
Name m n <- ((nameModule &&& nameIdent) -> (m, n)) where
	Name Maybe Text
Nothing Text
n = () -> Name () -> Name
forall l. l -> Name l -> QName l
UnQual () (() -> String -> Name ()
forall l. l -> String -> Name l
Exts.Ident () (Text -> String
T.unpack Text
n))
	Name (Just Text
m) Text
n = () -> ModuleName () -> Name () -> Name
forall l. l -> ModuleName l -> Name l -> QName l
Qual () (() -> String -> ModuleName ()
forall l. l -> String -> ModuleName l
ModuleName () (Text -> String
T.unpack Text
m)) (() -> String -> Name ()
forall l. l -> String -> Name l
Exts.Ident () (Text -> String
T.unpack Text
n))

fromName_ :: Exts.Name () -> Text
fromName_ :: Name () -> Text
fromName_ (Exts.Ident ()
_ String
s') = String -> Text
forall a. IsString a => String -> a
fromString String
s'
fromName_ (Exts.Symbol ()
_ String
s') = String -> Text
forall a. IsString a => String -> a
fromString String
s'

toName_ :: Text -> Exts.Name ()
toName_ :: Text -> Name ()
toName_ Text
txt
	| Text -> Bool
T.null Text
txt = () -> String -> Name ()
forall l. l -> String -> Name l
Exts.Ident () String
""
	| Char -> Bool
isAlpha (Text -> Char
T.head Text
txt) Bool -> Bool -> Bool
&& ((Char -> Bool) -> Text -> Bool
T.all Char -> Bool
validChar (Text -> Bool) -> Text -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.tail Text
txt) = () -> String -> Name ()
forall l. l -> String -> Name l
Exts.Ident () (String -> Name ()) -> (Text -> String) -> Text -> Name ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> Name ()) -> Text -> Name ()
forall a b. (a -> b) -> a -> b
$ Text
txt
	| Bool
otherwise = () -> String -> Name ()
forall l. l -> String -> Name l
Exts.Symbol () (String -> Name ()) -> (Text -> String) -> Text -> Name ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> Name ()) -> Text -> Name ()
forall a b. (a -> b) -> a -> b
$ Text
txt
	where
		validChar :: Char -> Bool
validChar Char
ch = Char -> Bool
isAlphaNum Char
ch Bool -> Bool -> Bool
|| Char
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_'

toModuleName_ :: Text -> ModuleName ()
toModuleName_ :: Text -> ModuleName ()
toModuleName_ = () -> String -> ModuleName ()
forall l. l -> String -> ModuleName l
ModuleName () (String -> ModuleName ())
-> (Text -> String) -> Text -> ModuleName ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack

fromModuleName_ :: ModuleName () -> Text
fromModuleName_ :: ModuleName () -> Text
fromModuleName_ (ModuleName () String
m) = String -> Text
T.pack String
m

toName :: Text -> Name
toName :: Text -> Name
toName Text
"()" = () -> SpecialCon () -> Name
forall l. l -> SpecialCon l -> QName l
Special () (() -> SpecialCon ()
forall l. l -> SpecialCon l
UnitCon ())
toName Text
"[]" = () -> SpecialCon () -> Name
forall l. l -> SpecialCon l -> QName l
Special () (() -> SpecialCon ()
forall l. l -> SpecialCon l
ListCon ())
toName Text
"->" = () -> SpecialCon () -> Name
forall l. l -> SpecialCon l -> QName l
Special () (() -> SpecialCon ()
forall l. l -> SpecialCon l
FunCon ())
toName Text
"(:)" = () -> SpecialCon () -> Name
forall l. l -> SpecialCon l -> QName l
Special () (() -> SpecialCon ()
forall l. l -> SpecialCon l
Cons ())
toName Text
"(# #)" = () -> SpecialCon () -> Name
forall l. l -> SpecialCon l -> QName l
Special () (() -> SpecialCon ()
forall l. l -> SpecialCon l
UnboxedSingleCon ())
toName Text
tup
	| (Char -> Bool) -> Text -> Bool
T.all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',') Text
noBraces = () -> SpecialCon () -> Name
forall l. l -> SpecialCon l -> QName l
Special () (() -> Boxed -> Int -> SpecialCon ()
forall l. l -> Boxed -> Int -> SpecialCon l
TupleCon () Boxed
Boxed (Int -> Int
forall a. Enum a => a -> a
succ (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Text -> Int
T.length Text
noBraces))
	where
		noBraces :: Text
noBraces = (Char -> Bool) -> Text -> Text
T.dropAround (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'(', Char
')']) Text
tup
toName Text
n = case (Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') Text
n of
	[Text
n'] -> () -> Name () -> Name
forall l. l -> Name l -> QName l
UnQual () (() -> String -> Name ()
forall l. l -> String -> Name l
Exts.Ident () (String -> Name ()) -> String -> Name ()
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
n')
	[Text]
ns -> () -> ModuleName () -> Name () -> Name
forall l. l -> ModuleName l -> Name l -> QName l
Qual () (() -> String -> ModuleName ()
forall l. l -> String -> ModuleName l
ModuleName () (Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"." ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. [a] -> [a]
init [Text]
ns)) (Text -> Name ()
toName_ (Text -> Name ()) -> Text -> Name ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. [a] -> a
last [Text]
ns)

fromName :: Name -> Text
fromName :: Name -> Text
fromName (Qual ()
_ (ModuleName ()
_ String
m) Name ()
n) = [Text] -> Text
T.concat [String -> Text
forall a. IsString a => String -> a
fromString String
m, Text
".", Name () -> Text
fromName_ Name ()
n]
fromName (UnQual ()
_ Name ()
n) = Name () -> Text
fromName_ Name ()
n
fromName (Special ()
_ SpecialCon ()
c) = case SpecialCon ()
c of
	UnitCon ()
_ -> Text
"()"
	ListCon ()
_ -> Text
"[]"
	FunCon ()
_ -> Text
"->"
	TupleCon ()
_ Boxed
_ Int
i -> String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int -> Int
forall a. Enum a => a -> a
pred Int
i) Char
',' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
	Cons ()
_ -> Text
"(:)"
	UnboxedSingleCon ()
_ -> Text
"(# #)"
#if MIN_VERSION_haskell_src_exts(1,20,0)
	ExprHole ()
_ -> Text
"_"
#endif

name_ :: Iso' (Exts.Name ()) Text
name_ :: p Text (f Text) -> p (Name ()) (f (Name ()))
name_ = (Name () -> Text)
-> (Text -> Name ()) -> Iso (Name ()) (Name ()) Text Text
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Name () -> Text
fromName_ Text -> Name ()
toName_

moduleName_ :: Iso' (ModuleName ()) Text
moduleName_ :: p Text (f Text) -> p (ModuleName ()) (f (ModuleName ()))
moduleName_ = (ModuleName () -> Text)
-> (Text -> ModuleName ())
-> Iso (ModuleName ()) (ModuleName ()) Text Text
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso ModuleName () -> Text
fromModuleName_ Text -> ModuleName ()
toModuleName_