{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Language.Lsd.AST.Common
    ( KindName (..)
    , TypeName (..)
    , FullTypeName
    , DisplayTypeName (..)
    , Keyword (..)
    , NavTocHeading (..)
    , Fallback (..)
    )
where

import Data.Aeson (FromJSON (parseJSON), ToJSON (toJSON))
import Data.Data (Proxy (Proxy))
import Data.OpenApi (ToSchema (declareNamedSchema))
import Data.String (IsString)
import Data.Text (Text)

newtype KindName = KindName String
    deriving (Int -> KindName -> ShowS
[KindName] -> ShowS
KindName -> String
(Int -> KindName -> ShowS)
-> (KindName -> String) -> ([KindName] -> ShowS) -> Show KindName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> KindName -> ShowS
showsPrec :: Int -> KindName -> ShowS
$cshow :: KindName -> String
show :: KindName -> String
$cshowList :: [KindName] -> ShowS
showList :: [KindName] -> ShowS
Show, String -> KindName
(String -> KindName) -> IsString KindName
forall a. (String -> a) -> IsString a
$cfromString :: String -> KindName
fromString :: String -> KindName
IsString, KindName -> KindName -> Bool
(KindName -> KindName -> Bool)
-> (KindName -> KindName -> Bool) -> Eq KindName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: KindName -> KindName -> Bool
== :: KindName -> KindName -> Bool
$c/= :: KindName -> KindName -> Bool
/= :: KindName -> KindName -> Bool
Eq, Eq KindName
Eq KindName =>
(KindName -> KindName -> Ordering)
-> (KindName -> KindName -> Bool)
-> (KindName -> KindName -> Bool)
-> (KindName -> KindName -> Bool)
-> (KindName -> KindName -> Bool)
-> (KindName -> KindName -> KindName)
-> (KindName -> KindName -> KindName)
-> Ord KindName
KindName -> KindName -> Bool
KindName -> KindName -> Ordering
KindName -> KindName -> KindName
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: KindName -> KindName -> Ordering
compare :: KindName -> KindName -> Ordering
$c< :: KindName -> KindName -> Bool
< :: KindName -> KindName -> Bool
$c<= :: KindName -> KindName -> Bool
<= :: KindName -> KindName -> Bool
$c> :: KindName -> KindName -> Bool
> :: KindName -> KindName -> Bool
$c>= :: KindName -> KindName -> Bool
>= :: KindName -> KindName -> Bool
$cmax :: KindName -> KindName -> KindName
max :: KindName -> KindName -> KindName
$cmin :: KindName -> KindName -> KindName
min :: KindName -> KindName -> KindName
Ord)

instance ToJSON KindName where
    toJSON :: KindName -> Value
toJSON (KindName String
kind) = String -> Value
forall a. ToJSON a => a -> Value
toJSON String
kind

instance FromJSON KindName where
    parseJSON :: Value -> Parser KindName
parseJSON = (String -> KindName) -> Parser String -> Parser KindName
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> KindName
KindName (Parser String -> Parser KindName)
-> (Value -> Parser String) -> Value -> Parser KindName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser String
forall a. FromJSON a => Value -> Parser a
parseJSON

instance ToSchema KindName where
    declareNamedSchema :: Proxy KindName -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy KindName
_ = Proxy String -> Declare (Definitions Schema) NamedSchema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) NamedSchema
declareNamedSchema (Proxy String
forall {k} (t :: k). Proxy t
Proxy :: Proxy String)

newtype TypeName = TypeName String
    deriving (Int -> TypeName -> ShowS
[TypeName] -> ShowS
TypeName -> String
(Int -> TypeName -> ShowS)
-> (TypeName -> String) -> ([TypeName] -> ShowS) -> Show TypeName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TypeName -> ShowS
showsPrec :: Int -> TypeName -> ShowS
$cshow :: TypeName -> String
show :: TypeName -> String
$cshowList :: [TypeName] -> ShowS
showList :: [TypeName] -> ShowS
Show, String -> TypeName
(String -> TypeName) -> IsString TypeName
forall a. (String -> a) -> IsString a
$cfromString :: String -> TypeName
fromString :: String -> TypeName
IsString, TypeName -> TypeName -> Bool
(TypeName -> TypeName -> Bool)
-> (TypeName -> TypeName -> Bool) -> Eq TypeName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TypeName -> TypeName -> Bool
== :: TypeName -> TypeName -> Bool
$c/= :: TypeName -> TypeName -> Bool
/= :: TypeName -> TypeName -> Bool
Eq, Eq TypeName
Eq TypeName =>
(TypeName -> TypeName -> Ordering)
-> (TypeName -> TypeName -> Bool)
-> (TypeName -> TypeName -> Bool)
-> (TypeName -> TypeName -> Bool)
-> (TypeName -> TypeName -> Bool)
-> (TypeName -> TypeName -> TypeName)
-> (TypeName -> TypeName -> TypeName)
-> Ord TypeName
TypeName -> TypeName -> Bool
TypeName -> TypeName -> Ordering
TypeName -> TypeName -> TypeName
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TypeName -> TypeName -> Ordering
compare :: TypeName -> TypeName -> Ordering
$c< :: TypeName -> TypeName -> Bool
< :: TypeName -> TypeName -> Bool
$c<= :: TypeName -> TypeName -> Bool
<= :: TypeName -> TypeName -> Bool
$c> :: TypeName -> TypeName -> Bool
> :: TypeName -> TypeName -> Bool
$c>= :: TypeName -> TypeName -> Bool
>= :: TypeName -> TypeName -> Bool
$cmax :: TypeName -> TypeName -> TypeName
max :: TypeName -> TypeName -> TypeName
$cmin :: TypeName -> TypeName -> TypeName
min :: TypeName -> TypeName -> TypeName
Ord)

instance ToJSON TypeName where
    toJSON :: TypeName -> Value
toJSON (TypeName String
type_) = String -> Value
forall a. ToJSON a => a -> Value
toJSON String
type_

instance FromJSON TypeName where
    parseJSON :: Value -> Parser TypeName
parseJSON = (String -> TypeName) -> Parser String -> Parser TypeName
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> TypeName
TypeName (Parser String -> Parser TypeName)
-> (Value -> Parser String) -> Value -> Parser TypeName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser String
forall a. FromJSON a => Value -> Parser a
parseJSON

instance ToSchema TypeName where
    declareNamedSchema :: Proxy TypeName -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy TypeName
_ = Proxy String -> Declare (Definitions Schema) NamedSchema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) NamedSchema
declareNamedSchema (Proxy String
forall {k} (t :: k). Proxy t
Proxy :: Proxy String)

type FullTypeName = (KindName, TypeName)

newtype DisplayTypeName = DisplayTypeName String
    deriving (Int -> DisplayTypeName -> ShowS
[DisplayTypeName] -> ShowS
DisplayTypeName -> String
(Int -> DisplayTypeName -> ShowS)
-> (DisplayTypeName -> String)
-> ([DisplayTypeName] -> ShowS)
-> Show DisplayTypeName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DisplayTypeName -> ShowS
showsPrec :: Int -> DisplayTypeName -> ShowS
$cshow :: DisplayTypeName -> String
show :: DisplayTypeName -> String
$cshowList :: [DisplayTypeName] -> ShowS
showList :: [DisplayTypeName] -> ShowS
Show, String -> DisplayTypeName
(String -> DisplayTypeName) -> IsString DisplayTypeName
forall a. (String -> a) -> IsString a
$cfromString :: String -> DisplayTypeName
fromString :: String -> DisplayTypeName
IsString)

instance ToJSON DisplayTypeName where
    toJSON :: DisplayTypeName -> Value
toJSON (DisplayTypeName String
name) = String -> Value
forall a. ToJSON a => a -> Value
toJSON String
name

instance FromJSON DisplayTypeName where
    parseJSON :: Value -> Parser DisplayTypeName
parseJSON = (String -> DisplayTypeName)
-> Parser String -> Parser DisplayTypeName
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> DisplayTypeName
DisplayTypeName (Parser String -> Parser DisplayTypeName)
-> (Value -> Parser String) -> Value -> Parser DisplayTypeName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser String
forall a. FromJSON a => Value -> Parser a
parseJSON

instance ToSchema DisplayTypeName where
    declareNamedSchema :: Proxy DisplayTypeName -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy DisplayTypeName
_ = Proxy String -> Declare (Definitions Schema) NamedSchema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) NamedSchema
declareNamedSchema (Proxy String
forall {k} (t :: k). Proxy t
Proxy :: Proxy String)

newtype Keyword = Keyword Text

-- | Heading for the navigation TOC in the frontend, if static (determined by
--   type only).
newtype NavTocHeading = NavTocHeading Text
    deriving (Int -> NavTocHeading -> ShowS
[NavTocHeading] -> ShowS
NavTocHeading -> String
(Int -> NavTocHeading -> ShowS)
-> (NavTocHeading -> String)
-> ([NavTocHeading] -> ShowS)
-> Show NavTocHeading
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NavTocHeading -> ShowS
showsPrec :: Int -> NavTocHeading -> ShowS
$cshow :: NavTocHeading -> String
show :: NavTocHeading -> String
$cshowList :: [NavTocHeading] -> ShowS
showList :: [NavTocHeading] -> ShowS
Show)

-- | A wrapper to denote values that should only be used as fallback;
--   typically in case parsing fails.
newtype Fallback a = Fallback a
    deriving (Int -> Fallback a -> ShowS
[Fallback a] -> ShowS
Fallback a -> String
(Int -> Fallback a -> ShowS)
-> (Fallback a -> String)
-> ([Fallback a] -> ShowS)
-> Show (Fallback a)
forall a. Show a => Int -> Fallback a -> ShowS
forall a. Show a => [Fallback a] -> ShowS
forall a. Show a => Fallback a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Fallback a -> ShowS
showsPrec :: Int -> Fallback a -> ShowS
$cshow :: forall a. Show a => Fallback a -> String
show :: Fallback a -> String
$cshowList :: forall a. Show a => [Fallback a] -> ShowS
showList :: [Fallback a] -> ShowS
Show)