module PgSchema.Utils.ShowType where

import Data.List as L
import Data.String
import Data.Text as T
import PgSchema.Schema
import Prelude as P


class ShowType a where
  showType :: a -> Text

instance ShowType Text where
  showType :: Text -> Text
showType = String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> (Text -> String) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall a. Show a => a -> String
P.show

instance ShowType a => ShowType (Maybe a) where
  showType :: Maybe a -> Text
showType Maybe a
Nothing  = Text
"'Nothing"
  showType (Just a
a) = Text
"('Just " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall a. ShowType a => a -> Text
showType a
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"

instance ShowType Bool where
  showType :: Bool -> Text
showType Bool
True  = Text
"'True"
  showType Bool
False = Text
"'False"

instance ShowType a => ShowType [a] where
  showType :: [a] -> Text
showType = (\Text
x -> Text
"'[ " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ]") (Text -> Text) -> ([a] -> Text) -> [a] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
T.intercalate Text
"," ([Text] -> Text) -> ([a] -> [Text]) -> [a] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Text) -> [a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
L.map a -> Text
forall a. ShowType a => a -> Text
showType

instance (ShowType a, ShowType b) => ShowType (a,b) where
  showType :: (a, b) -> Text
showType (a
a,b
b) = Text
"'( " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall a. ShowType a => a -> Text
showType a
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"," Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> b -> Text
forall a. ShowType a => a -> Text
showType b
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" )"

instance ShowType NameNS where
  showType :: NameNS -> Text
showType NameNS{Text
nnsNamespace :: Text
nnsName :: Text
nnsName :: forall s. NameNS' s -> s
nnsNamespace :: forall s. NameNS' s -> s
..} =
    Text
"( " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall a. ShowType a => a -> Text
showType Text
nnsNamespace Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ->> " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall a. ShowType a => a -> Text
showType Text
nnsName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" )"

instance ShowType TypDef where
  showType :: TypDef -> Text
showType TypDef{[Text]
Maybe NameNS
Text
typCategory :: Text
typElem :: Maybe NameNS
typEnum :: [Text]
typEnum :: forall s. TypDef' s -> [s]
typElem :: forall s. TypDef' s -> Maybe (NameNS' s)
typCategory :: forall s. TypDef' s -> s
..} = Text
"'TypDef " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
" "
    [Text -> Text
forall a. ShowType a => a -> Text
showType Text
typCategory, Maybe NameNS -> Text
forall a. ShowType a => a -> Text
showType Maybe NameNS
typElem, [Text] -> Text
forall a. ShowType a => a -> Text
showType [Text]
typEnum]

instance ShowType FldDef where
  showType :: FldDef -> Text
showType FldDef{Bool
NameNS
fdType :: NameNS
fdNullable :: Bool
fdHasDefault :: Bool
fdHasDefault :: forall s. FldDef' s -> Bool
fdNullable :: forall s. FldDef' s -> Bool
fdType :: forall s. FldDef' s -> NameNS' s
..} = Text
"'FldDef " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
" "
    [NameNS -> Text
forall a. ShowType a => a -> Text
showType NameNS
fdType, Bool -> Text
forall a. ShowType a => a -> Text
showType Bool
fdNullable, Bool -> Text
forall a. ShowType a => a -> Text
showType Bool
fdHasDefault]

instance ShowType TabDef where
  showType :: TabDef -> Text
showType TabDef{[[Text]]
[Text]
tdFlds :: [Text]
tdKey :: [Text]
tdUniq :: [[Text]]
tdUniq :: forall s. TabDef' s -> [[s]]
tdKey :: forall s. TabDef' s -> [s]
tdFlds :: forall s. TabDef' s -> [s]
..} = Text
"'TabDef " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
" "
    [[Text] -> Text
forall a. ShowType a => a -> Text
showType [Text]
tdFlds, [Text] -> Text
forall a. ShowType a => a -> Text
showType [Text]
tdKey, [[Text]] -> Text
forall a. ShowType a => a -> Text
showType [[Text]]
tdUniq]

instance ShowType RelDef where
  showType :: RelDef -> Text
showType RelDef{[(Text, Text)]
NameNS
rdFrom :: NameNS
rdTo :: NameNS
rdCols :: [(Text, Text)]
rdCols :: forall s. RelDef' s -> [(s, s)]
rdTo :: forall s. RelDef' s -> NameNS' s
rdFrom :: forall s. RelDef' s -> NameNS' s
..} = Text
"'RelDef " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
" "
    [NameNS -> Text
forall a. ShowType a => a -> Text
showType NameNS
rdFrom, NameNS -> Text
forall a. ShowType a => a -> Text
showType NameNS
rdTo, [(Text, Text)] -> Text
forall a. ShowType a => a -> Text
showType [(Text, Text)]
rdCols]

instance ShowType Ref where
  showType :: Ref -> Text
showType Ref{Text
FldDef
fromName :: Text
fromDef :: FldDef
toName :: Text
toDef :: FldDef
toDef :: forall s. Ref' s -> FldDef' s
toName :: forall s. Ref' s -> s
fromDef :: forall s. Ref' s -> FldDef' s
fromName :: forall s. Ref' s -> s
..} = Text
"'Ref " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
" "
    [Text -> Text
forall a. ShowType a => a -> Text
showType Text
fromName, FldDef -> Text
forall a. ShowType a => a -> Text
showType FldDef
fromDef, Text -> Text
forall a. ShowType a => a -> Text
showType Text
toName, FldDef -> Text
forall a. ShowType a => a -> Text
showType FldDef
toDef]

instance ShowType (RecField NameNS) where
  showType :: RecField NameNS -> Text
showType = \case
    RFEmpty Text
s     -> Text
"'RFEmpty " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall a. ShowType a => a -> Text
showType Text
s
    RFPlain FldDef
fd    -> Text
"'RFPlain " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FldDef -> Text
forall a. ShowType a => a -> Text
showType FldDef
fd
    RFAggr FldDef
fd AggrFun
fn Bool
b -> Text
"'RFAggr " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
" " [FldDef -> Text
forall a. ShowType a => a -> Text
showType FldDef
fd, AggrFun -> Text
forall a. ShowType a => a -> Text
showType AggrFun
fn, Bool -> Text
forall a. ShowType a => a -> Text
showType Bool
b]
    RFToHere NameNS
t [Ref]
rr -> Text
"'RFToHere " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> NameNS -> Text
forall a. ShowType a => a -> Text
showType NameNS
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Ref] -> Text
forall a. ShowType a => a -> Text
showType [Ref]
rr
    RFFromHere NameNS
t [Ref]
rr -> Text
"'RFFromHere " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> NameNS -> Text
forall a. ShowType a => a -> Text
showType NameNS
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Ref] -> Text
forall a. ShowType a => a -> Text
showType [Ref]
rr
    RFSelfRef NameNS
t [Ref]
rr -> Text
"'RFSelfRef " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> NameNS -> Text
forall a. ShowType a => a -> Text
showType NameNS
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Ref] -> Text
forall a. ShowType a => a -> Text
showType [Ref]
rr

instance ShowType AggrFun where
  showType :: AggrFun -> Text
showType = \case
    AggrFun
ACount -> Text
"'ACount"
    AggrFun
AMin -> Text
"'AMin"
    AggrFun
AMax -> Text
"'AMax"
    AggrFun
ASum -> Text
"'ASum"
    AggrFun
AAvg -> Text
"'AAvg"