-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Representation of the "type" of a schema.
module Swarm.Doc.Schema.SchemaType where

import Control.Applicative ((<|>))
import Data.Aeson
import Data.List.NonEmpty (NonEmpty)
import Data.Text (Text)
import Data.Text qualified as T
import System.FilePath (takeBaseName)

newtype SingleOrList a = SingleOrList
  { forall a. SingleOrList a -> [a]
getList :: [a]
  }
  deriving (SingleOrList a -> SingleOrList a -> Bool
(SingleOrList a -> SingleOrList a -> Bool)
-> (SingleOrList a -> SingleOrList a -> Bool)
-> Eq (SingleOrList a)
forall a. Eq a => SingleOrList a -> SingleOrList a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => SingleOrList a -> SingleOrList a -> Bool
== :: SingleOrList a -> SingleOrList a -> Bool
$c/= :: forall a. Eq a => SingleOrList a -> SingleOrList a -> Bool
/= :: SingleOrList a -> SingleOrList a -> Bool
Eq, Eq (SingleOrList a)
Eq (SingleOrList a) =>
(SingleOrList a -> SingleOrList a -> Ordering)
-> (SingleOrList a -> SingleOrList a -> Bool)
-> (SingleOrList a -> SingleOrList a -> Bool)
-> (SingleOrList a -> SingleOrList a -> Bool)
-> (SingleOrList a -> SingleOrList a -> Bool)
-> (SingleOrList a -> SingleOrList a -> SingleOrList a)
-> (SingleOrList a -> SingleOrList a -> SingleOrList a)
-> Ord (SingleOrList a)
SingleOrList a -> SingleOrList a -> Bool
SingleOrList a -> SingleOrList a -> Ordering
SingleOrList a -> SingleOrList a -> SingleOrList a
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
forall a. Ord a => Eq (SingleOrList a)
forall a. Ord a => SingleOrList a -> SingleOrList a -> Bool
forall a. Ord a => SingleOrList a -> SingleOrList a -> Ordering
forall a.
Ord a =>
SingleOrList a -> SingleOrList a -> SingleOrList a
$ccompare :: forall a. Ord a => SingleOrList a -> SingleOrList a -> Ordering
compare :: SingleOrList a -> SingleOrList a -> Ordering
$c< :: forall a. Ord a => SingleOrList a -> SingleOrList a -> Bool
< :: SingleOrList a -> SingleOrList a -> Bool
$c<= :: forall a. Ord a => SingleOrList a -> SingleOrList a -> Bool
<= :: SingleOrList a -> SingleOrList a -> Bool
$c> :: forall a. Ord a => SingleOrList a -> SingleOrList a -> Bool
> :: SingleOrList a -> SingleOrList a -> Bool
$c>= :: forall a. Ord a => SingleOrList a -> SingleOrList a -> Bool
>= :: SingleOrList a -> SingleOrList a -> Bool
$cmax :: forall a.
Ord a =>
SingleOrList a -> SingleOrList a -> SingleOrList a
max :: SingleOrList a -> SingleOrList a -> SingleOrList a
$cmin :: forall a.
Ord a =>
SingleOrList a -> SingleOrList a -> SingleOrList a
min :: SingleOrList a -> SingleOrList a -> SingleOrList a
Ord, Int -> SingleOrList a -> ShowS
[SingleOrList a] -> ShowS
SingleOrList a -> String
(Int -> SingleOrList a -> ShowS)
-> (SingleOrList a -> String)
-> ([SingleOrList a] -> ShowS)
-> Show (SingleOrList a)
forall a. Show a => Int -> SingleOrList a -> ShowS
forall a. Show a => [SingleOrList a] -> ShowS
forall a. Show a => SingleOrList a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> SingleOrList a -> ShowS
showsPrec :: Int -> SingleOrList a -> ShowS
$cshow :: forall a. Show a => SingleOrList a -> String
show :: SingleOrList a -> String
$cshowList :: forall a. Show a => [SingleOrList a] -> ShowS
showList :: [SingleOrList a] -> ShowS
Show)

instance (FromJSON a) => FromJSON (SingleOrList a) where
  parseJSON :: Value -> Parser (SingleOrList a)
parseJSON Value
x =
    ([a] -> SingleOrList a) -> Parser [a] -> Parser (SingleOrList a)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> SingleOrList a
forall a. [a] -> SingleOrList a
SingleOrList (Parser [a] -> Parser (SingleOrList a))
-> Parser [a] -> Parser (SingleOrList a)
forall a b. (a -> b) -> a -> b
$
      a -> [a]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> [a]) -> Parser a -> Parser [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value
x Parser [a] -> Parser [a] -> Parser [a]
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser [a]
forall a. FromJSON a => Value -> Parser a
parseJSON Value
x

data SchemaType
  = -- | A basic built-in type
    Simple (SingleOrList Text)
  | -- | Any one of multiple possible schema types
    Alternatives [SchemaType]
  | -- | A reference to a schema defined elsewhere
    Reference SchemaIdReference
  | -- | Members of a list, all of the given schema type
    ListOf SchemaType
  | EnumList (NonEmpty Text)
  deriving (SchemaType -> SchemaType -> Bool
(SchemaType -> SchemaType -> Bool)
-> (SchemaType -> SchemaType -> Bool) -> Eq SchemaType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SchemaType -> SchemaType -> Bool
== :: SchemaType -> SchemaType -> Bool
$c/= :: SchemaType -> SchemaType -> Bool
/= :: SchemaType -> SchemaType -> Bool
Eq, Eq SchemaType
Eq SchemaType =>
(SchemaType -> SchemaType -> Ordering)
-> (SchemaType -> SchemaType -> Bool)
-> (SchemaType -> SchemaType -> Bool)
-> (SchemaType -> SchemaType -> Bool)
-> (SchemaType -> SchemaType -> Bool)
-> (SchemaType -> SchemaType -> SchemaType)
-> (SchemaType -> SchemaType -> SchemaType)
-> Ord SchemaType
SchemaType -> SchemaType -> Bool
SchemaType -> SchemaType -> Ordering
SchemaType -> SchemaType -> SchemaType
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 :: SchemaType -> SchemaType -> Ordering
compare :: SchemaType -> SchemaType -> Ordering
$c< :: SchemaType -> SchemaType -> Bool
< :: SchemaType -> SchemaType -> Bool
$c<= :: SchemaType -> SchemaType -> Bool
<= :: SchemaType -> SchemaType -> Bool
$c> :: SchemaType -> SchemaType -> Bool
> :: SchemaType -> SchemaType -> Bool
$c>= :: SchemaType -> SchemaType -> Bool
>= :: SchemaType -> SchemaType -> Bool
$cmax :: SchemaType -> SchemaType -> SchemaType
max :: SchemaType -> SchemaType -> SchemaType
$cmin :: SchemaType -> SchemaType -> SchemaType
min :: SchemaType -> SchemaType -> SchemaType
Ord, Int -> SchemaType -> ShowS
[SchemaType] -> ShowS
SchemaType -> String
(Int -> SchemaType -> ShowS)
-> (SchemaType -> String)
-> ([SchemaType] -> ShowS)
-> Show SchemaType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SchemaType -> ShowS
showsPrec :: Int -> SchemaType -> ShowS
$cshow :: SchemaType -> String
show :: SchemaType -> String
$cshowList :: [SchemaType] -> ShowS
showList :: [SchemaType] -> ShowS
Show)

newtype SchemaIdReference = SchemaIdReference Text
  deriving (SchemaIdReference -> SchemaIdReference -> Bool
(SchemaIdReference -> SchemaIdReference -> Bool)
-> (SchemaIdReference -> SchemaIdReference -> Bool)
-> Eq SchemaIdReference
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SchemaIdReference -> SchemaIdReference -> Bool
== :: SchemaIdReference -> SchemaIdReference -> Bool
$c/= :: SchemaIdReference -> SchemaIdReference -> Bool
/= :: SchemaIdReference -> SchemaIdReference -> Bool
Eq, Eq SchemaIdReference
Eq SchemaIdReference =>
(SchemaIdReference -> SchemaIdReference -> Ordering)
-> (SchemaIdReference -> SchemaIdReference -> Bool)
-> (SchemaIdReference -> SchemaIdReference -> Bool)
-> (SchemaIdReference -> SchemaIdReference -> Bool)
-> (SchemaIdReference -> SchemaIdReference -> Bool)
-> (SchemaIdReference -> SchemaIdReference -> SchemaIdReference)
-> (SchemaIdReference -> SchemaIdReference -> SchemaIdReference)
-> Ord SchemaIdReference
SchemaIdReference -> SchemaIdReference -> Bool
SchemaIdReference -> SchemaIdReference -> Ordering
SchemaIdReference -> SchemaIdReference -> SchemaIdReference
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 :: SchemaIdReference -> SchemaIdReference -> Ordering
compare :: SchemaIdReference -> SchemaIdReference -> Ordering
$c< :: SchemaIdReference -> SchemaIdReference -> Bool
< :: SchemaIdReference -> SchemaIdReference -> Bool
$c<= :: SchemaIdReference -> SchemaIdReference -> Bool
<= :: SchemaIdReference -> SchemaIdReference -> Bool
$c> :: SchemaIdReference -> SchemaIdReference -> Bool
> :: SchemaIdReference -> SchemaIdReference -> Bool
$c>= :: SchemaIdReference -> SchemaIdReference -> Bool
>= :: SchemaIdReference -> SchemaIdReference -> Bool
$cmax :: SchemaIdReference -> SchemaIdReference -> SchemaIdReference
max :: SchemaIdReference -> SchemaIdReference -> SchemaIdReference
$cmin :: SchemaIdReference -> SchemaIdReference -> SchemaIdReference
min :: SchemaIdReference -> SchemaIdReference -> SchemaIdReference
Ord, Int -> SchemaIdReference -> ShowS
[SchemaIdReference] -> ShowS
SchemaIdReference -> String
(Int -> SchemaIdReference -> ShowS)
-> (SchemaIdReference -> String)
-> ([SchemaIdReference] -> ShowS)
-> Show SchemaIdReference
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SchemaIdReference -> ShowS
showsPrec :: Int -> SchemaIdReference -> ShowS
$cshow :: SchemaIdReference -> String
show :: SchemaIdReference -> String
$cshowList :: [SchemaIdReference] -> ShowS
showList :: [SchemaIdReference] -> ShowS
Show)

fromFilePath :: FilePath -> SchemaIdReference
fromFilePath :: String -> SchemaIdReference
fromFilePath = Text -> SchemaIdReference
SchemaIdReference (Text -> SchemaIdReference)
-> (String -> Text) -> String -> SchemaIdReference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> ShowS -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
takeBaseName