{-# language RecordWildCards #-}
{-# language StrictData #-}

module Rel8.Type.Name
  ( TypeName (..)
  , showTypeName
  )
where

-- base
import Data.Semigroup (mtimesDefault)
import Data.String (IsString, fromString)
import Prelude

-- pretty
import Text.PrettyPrint (Doc, comma, hcat, parens, punctuate, text)

-- rel8
import Rel8.Schema.QualifiedName (QualifiedName, ppQualifiedName)


-- | A PostgreSQL type consists of a 'QualifiedName' (name, schema), and
-- optional 'modifiers' and 'arrayDepth'. 'modifiers' will usually be @[]@,
-- but a type like @numeric(6, 2)@ will have @["6", "2"]@. 'arrayDepth' is
-- always @0@ for non-array types.
data TypeName = TypeName
  { TypeName -> QualifiedName
name :: QualifiedName
    -- ^ The name (and schema) of the type.
  , TypeName -> [String]
modifiers :: [String]
    -- ^ Any modifiers applied to the underlying type.
  , TypeName -> Word
arrayDepth :: Word
    -- ^ If this is an array type, the depth of that array (@1@ for @[]@, @2@
    -- for @[][]@, etc).
  }


-- | Constructs 'TypeName's with 'schema' set to 'Nothing', 'modifiers' set
-- to @[]@ and 'arrayDepth' set to @0@.
instance IsString TypeName where
  fromString :: String -> TypeName
fromString String
string =
    TypeName
      { name :: QualifiedName
name = String -> QualifiedName
forall a. IsString a => String -> a
fromString String
string
      , modifiers :: [String]
modifiers = []
      , arrayDepth :: Word
arrayDepth = Word
0
      }


ppTypeName :: TypeName -> Doc
ppTypeName :: TypeName -> Doc
ppTypeName TypeName {[String]
Word
QualifiedName
modifiers :: TypeName -> [String]
arrayDepth :: TypeName -> Word
name :: TypeName -> QualifiedName
name :: QualifiedName
modifiers :: [String]
arrayDepth :: Word
..} =
  QualifiedName -> Doc
ppQualifiedName QualifiedName
name Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
modifier Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Word -> Doc -> Doc
forall b a. (Integral b, Monoid a) => b -> a -> a
mtimesDefault Word
arrayDepth (String -> Doc
text String
"[]")
  where
    modifier :: Doc
modifier
      | [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
modifiers = Doc
forall a. Monoid a => a
mempty
      | Bool
otherwise = Doc -> Doc
parens ([Doc] -> Doc
hcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ String -> Doc
text (String -> Doc) -> [String] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
modifiers)


showTypeName :: TypeName -> String
showTypeName :: TypeName -> String
showTypeName = Doc -> String
forall a. Show a => a -> String
show (Doc -> String) -> (TypeName -> Doc) -> TypeName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeName -> Doc
ppTypeName