{- -----------------------------------------------------------------------------
Copyright 2019-2020 Kevin P. Barry

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

    http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
----------------------------------------------------------------------------- -}

-- Author: Kevin P. Barry [ta0kira@gmail.com]

{-# LANGUAGE Safe #-}
{-# LANGUAGE TypeFamilies #-}

module Base.GeneralType (
  GeneralType,
  dualGeneralType,
  mapGeneralType,
  singleType,
) where

import qualified Data.Set as Set

import Base.MergeTree
import Base.Mergeable


data GeneralType a =
  SingleType {
    forall a. GeneralType a -> a
stType :: a
  } |
  AllowAnyOf {
    forall a. GeneralType a -> Set (GeneralType a)
aaoTypes :: Set.Set (GeneralType a)
  } |
  RequireAllOf {
    forall a. GeneralType a -> Set (GeneralType a)
raoTypes :: Set.Set (GeneralType a)
  }
  deriving (GeneralType a -> GeneralType a -> Bool
forall a. Eq a => GeneralType a -> GeneralType a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GeneralType a -> GeneralType a -> Bool
$c/= :: forall a. Eq a => GeneralType a -> GeneralType a -> Bool
== :: GeneralType a -> GeneralType a -> Bool
$c== :: forall a. Eq a => GeneralType a -> GeneralType a -> Bool
Eq,GeneralType a -> GeneralType a -> Bool
GeneralType a -> GeneralType a -> Ordering
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 (GeneralType a)
forall a. Ord a => GeneralType a -> GeneralType a -> Bool
forall a. Ord a => GeneralType a -> GeneralType a -> Ordering
forall a. Ord a => GeneralType a -> GeneralType a -> GeneralType a
min :: GeneralType a -> GeneralType a -> GeneralType a
$cmin :: forall a. Ord a => GeneralType a -> GeneralType a -> GeneralType a
max :: GeneralType a -> GeneralType a -> GeneralType a
$cmax :: forall a. Ord a => GeneralType a -> GeneralType a -> GeneralType a
>= :: GeneralType a -> GeneralType a -> Bool
$c>= :: forall a. Ord a => GeneralType a -> GeneralType a -> Bool
> :: GeneralType a -> GeneralType a -> Bool
$c> :: forall a. Ord a => GeneralType a -> GeneralType a -> Bool
<= :: GeneralType a -> GeneralType a -> Bool
$c<= :: forall a. Ord a => GeneralType a -> GeneralType a -> Bool
< :: GeneralType a -> GeneralType a -> Bool
$c< :: forall a. Ord a => GeneralType a -> GeneralType a -> Bool
compare :: GeneralType a -> GeneralType a -> Ordering
$ccompare :: forall a. Ord a => GeneralType a -> GeneralType a -> Ordering
Ord)

singleType :: (Eq a, Ord a) => a -> GeneralType a
singleType :: forall a. (Eq a, Ord a) => a -> GeneralType a
singleType = forall a. a -> GeneralType a
SingleType

instance (Eq a, Ord a) => Mergeable (GeneralType a) where
  mergeAny :: forall (f :: * -> *).
Foldable f =>
f (GeneralType a) -> GeneralType a
mergeAny = forall {a}. Set (GeneralType a) -> GeneralType a
unnest forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a. Ord a => Set a -> Set a -> Set a
Set.union forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Ord a => GeneralType a -> Set (GeneralType a)
flattenAny) forall a. Set a
Set.empty where
    flattenAny :: GeneralType a -> Set (GeneralType a)
flattenAny (AllowAnyOf Set (GeneralType a)
xs) = Set (GeneralType a)
xs
    flattenAny GeneralType a
x               = forall a. Ord a => [a] -> Set a
Set.fromList [GeneralType a
x]
    unnest :: Set (GeneralType a) -> GeneralType a
unnest Set (GeneralType a)
xs = case forall a. Set a -> [a]
Set.toList Set (GeneralType a)
xs of
                     [GeneralType a
x] -> GeneralType a
x
                     [GeneralType a]
_ -> forall {a}. Set (GeneralType a) -> GeneralType a
AllowAnyOf Set (GeneralType a)
xs
  mergeAll :: forall (f :: * -> *).
Foldable f =>
f (GeneralType a) -> GeneralType a
mergeAll = forall {a}. Set (GeneralType a) -> GeneralType a
unnest forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a. Ord a => Set a -> Set a -> Set a
Set.union forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Ord a => GeneralType a -> Set (GeneralType a)
flattenAll) forall a. Set a
Set.empty where
    flattenAll :: GeneralType a -> Set (GeneralType a)
flattenAll (RequireAllOf Set (GeneralType a)
xs) = Set (GeneralType a)
xs
    flattenAll GeneralType a
x                 = forall a. Ord a => [a] -> Set a
Set.fromList [GeneralType a
x]
    unnest :: Set (GeneralType a) -> GeneralType a
unnest Set (GeneralType a)
xs = case forall a. Set a -> [a]
Set.toList Set (GeneralType a)
xs of
                     [GeneralType a
x] -> GeneralType a
x
                     [GeneralType a]
_ -> forall {a}. Set (GeneralType a) -> GeneralType a
RequireAllOf Set (GeneralType a)
xs

instance (Eq a, Ord a) => PreserveMerge (GeneralType a) where
  type T (GeneralType a) = a
  convertMerge :: forall b.
Mergeable b =>
(T (GeneralType a) -> b) -> GeneralType a -> b
convertMerge T (GeneralType a) -> b
f (AllowAnyOf   Set (GeneralType a)
xs) = forall a (f :: * -> *). (Mergeable a, Foldable f) => f a -> a
mergeAny forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (PreserveMerge a, Mergeable b) => (T a -> b) -> a -> b
convertMerge T (GeneralType a) -> b
f) forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
Set.toList Set (GeneralType a)
xs
  convertMerge T (GeneralType a) -> b
f (RequireAllOf Set (GeneralType a)
xs) = forall a (f :: * -> *). (Mergeable a, Foldable f) => f a -> a
mergeAll forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (PreserveMerge a, Mergeable b) => (T a -> b) -> a -> b
convertMerge T (GeneralType a) -> b
f) forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
Set.toList Set (GeneralType a)
xs
  convertMerge T (GeneralType a) -> b
f (SingleType a
x)    = T (GeneralType a) -> b
f a
x

instance (Eq a, Ord a) => Bounded (GeneralType a) where
  minBound :: GeneralType a
minBound = forall a (f :: * -> *). (Mergeable a, Foldable f) => f a -> a
mergeAny forall a. Maybe a
Nothing  -- all
  maxBound :: GeneralType a
maxBound = forall a (f :: * -> *). (Mergeable a, Foldable f) => f a -> a
mergeAll forall a. Maybe a
Nothing  -- any

dualGeneralType :: (Eq a, Ord a) => GeneralType a -> GeneralType a
dualGeneralType :: forall a. (Eq a, Ord a) => GeneralType a -> GeneralType a
dualGeneralType = forall a b.
PreserveMerge a =>
([b] -> b) -> ([b] -> b) -> (T a -> b) -> a -> b
reduceMergeTree forall a (f :: * -> *). (Mergeable a, Foldable f) => f a -> a
mergeAll forall a (f :: * -> *). (Mergeable a, Foldable f) => f a -> a
mergeAny forall a. (Eq a, Ord a) => a -> GeneralType a
singleType

mapGeneralType :: (Eq a, Ord a, Eq b, Ord b) => (a -> b) -> GeneralType a -> GeneralType b
mapGeneralType :: forall a b.
(Eq a, Ord a, Eq b, Ord b) =>
(a -> b) -> GeneralType a -> GeneralType b
mapGeneralType = forall a b.
PreserveMerge a =>
([b] -> b) -> ([b] -> b) -> (T a -> b) -> a -> b
reduceMergeTree forall a (f :: * -> *). (Mergeable a, Foldable f) => f a -> a
mergeAny forall a (f :: * -> *). (Mergeable a, Foldable f) => f a -> a
mergeAll forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. (Eq a, Ord a) => a -> GeneralType a
singleType forall b c a. (b -> c) -> (a -> b) -> a -> c
.)