{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TemplateHaskell #-}

module Data.Aeson.Schema.Utils.NameLike
  ( NameLike(..)
  , fromName
  , resolveName
  ) where

import Data.Text (Text)
import Language.Haskell.TH.Syntax (Name, Q, lookupTypeName, nameBase)

data NameLike = NameRef String | NameTH Name

instance Eq NameLike where
  NameLike
ty1 == :: NameLike -> NameLike -> Bool
== NameLike
ty2 = NameLike -> String
fromName NameLike
ty1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== NameLike -> String
fromName NameLike
ty2

instance Show NameLike where
  show :: NameLike -> String
show = ShowS
forall a. Show a => a -> String
show ShowS -> (NameLike -> String) -> NameLike -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameLike -> String
fromName

fromName :: NameLike -> String
fromName :: NameLike -> String
fromName = \case
  NameRef String
s -> String
s
  NameTH Name
name -> Name -> String
nameBase Name
name

resolveName :: NameLike -> Q Name
resolveName :: NameLike -> Q Name
resolveName = \case
  -- some hardcoded cases
  NameRef String
"Bool"   -> Name -> Q Name
forall (f :: * -> *) a. Applicative f => a -> f a
pure ''Bool
  NameRef String
"Int"    -> Name -> Q Name
forall (f :: * -> *) a. Applicative f => a -> f a
pure ''Int
  NameRef String
"Double" -> Name -> Q Name
forall (f :: * -> *) a. Applicative f => a -> f a
pure ''Double
  NameRef String
"Text"   -> Name -> Q Name
forall (f :: * -> *) a. Applicative f => a -> f a
pure ''Text

  -- general cases
  NameRef String
name     -> String -> Q (Maybe Name)
lookupTypeName String
name Q (Maybe Name) -> (Maybe Name -> Q Name) -> Q Name
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Q Name -> (Name -> Q Name) -> Maybe Name -> Q Name
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Q Name
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Name) -> String -> Q Name
forall a b. (a -> b) -> a -> b
$ String
"Unknown type: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name) Name -> Q Name
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  NameTH Name
name      -> Name -> Q Name
forall (f :: * -> *) a. Applicative f => a -> f a
pure Name
name