{- -----------------------------------------------------------------------------
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
(GeneralType a -> GeneralType a -> Bool)
-> (GeneralType a -> GeneralType a -> Bool) -> Eq (GeneralType a)
forall a. Eq a => GeneralType a -> GeneralType a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$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
/= :: GeneralType a -> GeneralType a -> Bool
Eq,Eq (GeneralType a)
Eq (GeneralType a) =>
(GeneralType a -> GeneralType a -> Ordering)
-> (GeneralType a -> GeneralType a -> Bool)
-> (GeneralType a -> GeneralType a -> Bool)
-> (GeneralType a -> GeneralType a -> Bool)
-> (GeneralType a -> GeneralType a -> Bool)
-> (GeneralType a -> GeneralType a -> GeneralType a)
-> (GeneralType a -> GeneralType a -> GeneralType a)
-> Ord (GeneralType a)
GeneralType a -> GeneralType a -> Bool
GeneralType a -> GeneralType a -> Ordering
GeneralType a -> GeneralType a -> GeneralType 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 (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
$ccompare :: forall a. Ord a => GeneralType a -> GeneralType a -> Ordering
compare :: GeneralType a -> GeneralType a -> Ordering
$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
>= :: GeneralType a -> GeneralType a -> Bool
$cmax :: forall a. Ord a => GeneralType a -> GeneralType a -> GeneralType a
max :: GeneralType a -> GeneralType a -> GeneralType a
$cmin :: forall a. Ord a => GeneralType a -> GeneralType a -> GeneralType a
min :: GeneralType a -> GeneralType a -> GeneralType a
Ord)

singleType :: (Eq a, Ord a) => a -> GeneralType a
singleType :: forall a. (Eq a, Ord a) => a -> GeneralType a
singleType = a -> GeneralType a
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 = Set (GeneralType a) -> GeneralType a
forall {a}. Set (GeneralType a) -> GeneralType a
unnest (Set (GeneralType a) -> GeneralType a)
-> (f (GeneralType a) -> Set (GeneralType a))
-> f (GeneralType a)
-> GeneralType a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GeneralType a -> Set (GeneralType a) -> Set (GeneralType a))
-> Set (GeneralType a) -> f (GeneralType a) -> Set (GeneralType a)
forall a b. (a -> b -> b) -> b -> f a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Set (GeneralType a) -> Set (GeneralType a) -> Set (GeneralType a)
forall a. Ord a => Set a -> Set a -> Set a
Set.union (Set (GeneralType a) -> Set (GeneralType a) -> Set (GeneralType a))
-> (GeneralType a -> Set (GeneralType a))
-> GeneralType a
-> Set (GeneralType a)
-> Set (GeneralType a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GeneralType a -> Set (GeneralType a)
forall {a}. Ord a => GeneralType a -> Set (GeneralType a)
flattenAny) Set (GeneralType a)
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               = [GeneralType a] -> Set (GeneralType a)
forall a. Ord a => [a] -> Set a
Set.fromList [GeneralType a
x]
    unnest :: Set (GeneralType a) -> GeneralType a
unnest Set (GeneralType a)
xs = case Set (GeneralType a) -> [GeneralType a]
forall a. Set a -> [a]
Set.toList Set (GeneralType a)
xs of
                     [GeneralType a
x] -> GeneralType a
x
                     [GeneralType a]
_ -> Set (GeneralType a) -> 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 = Set (GeneralType a) -> GeneralType a
forall {a}. Set (GeneralType a) -> GeneralType a
unnest (Set (GeneralType a) -> GeneralType a)
-> (f (GeneralType a) -> Set (GeneralType a))
-> f (GeneralType a)
-> GeneralType a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GeneralType a -> Set (GeneralType a) -> Set (GeneralType a))
-> Set (GeneralType a) -> f (GeneralType a) -> Set (GeneralType a)
forall a b. (a -> b -> b) -> b -> f a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Set (GeneralType a) -> Set (GeneralType a) -> Set (GeneralType a)
forall a. Ord a => Set a -> Set a -> Set a
Set.union (Set (GeneralType a) -> Set (GeneralType a) -> Set (GeneralType a))
-> (GeneralType a -> Set (GeneralType a))
-> GeneralType a
-> Set (GeneralType a)
-> Set (GeneralType a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GeneralType a -> Set (GeneralType a)
forall {a}. Ord a => GeneralType a -> Set (GeneralType a)
flattenAll) Set (GeneralType a)
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                 = [GeneralType a] -> Set (GeneralType a)
forall a. Ord a => [a] -> Set a
Set.fromList [GeneralType a
x]
    unnest :: Set (GeneralType a) -> GeneralType a
unnest Set (GeneralType a)
xs = case Set (GeneralType a) -> [GeneralType a]
forall a. Set a -> [a]
Set.toList Set (GeneralType a)
xs of
                     [GeneralType a
x] -> GeneralType a
x
                     [GeneralType a]
_ -> Set (GeneralType a) -> 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) = [b] -> b
forall a (f :: * -> *). (Mergeable a, Foldable f) => f a -> a
forall (f :: * -> *). Foldable f => f b -> b
mergeAny ([b] -> b) -> [b] -> b
forall a b. (a -> b) -> a -> b
$ (GeneralType a -> b) -> [GeneralType a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map ((T (GeneralType a) -> b) -> GeneralType a -> b
forall a b. (PreserveMerge a, Mergeable b) => (T a -> b) -> a -> b
forall b.
Mergeable b =>
(T (GeneralType a) -> b) -> GeneralType a -> b
convertMerge T (GeneralType a) -> b
f) ([GeneralType a] -> [b]) -> [GeneralType a] -> [b]
forall a b. (a -> b) -> a -> b
$ Set (GeneralType a) -> [GeneralType a]
forall a. Set a -> [a]
Set.toList Set (GeneralType a)
xs
  convertMerge T (GeneralType a) -> b
f (RequireAllOf Set (GeneralType a)
xs) = [b] -> b
forall a (f :: * -> *). (Mergeable a, Foldable f) => f a -> a
forall (f :: * -> *). Foldable f => f b -> b
mergeAll ([b] -> b) -> [b] -> b
forall a b. (a -> b) -> a -> b
$ (GeneralType a -> b) -> [GeneralType a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map ((T (GeneralType a) -> b) -> GeneralType a -> b
forall a b. (PreserveMerge a, Mergeable b) => (T a -> b) -> a -> b
forall b.
Mergeable b =>
(T (GeneralType a) -> b) -> GeneralType a -> b
convertMerge T (GeneralType a) -> b
f) ([GeneralType a] -> [b]) -> [GeneralType a] -> [b]
forall a b. (a -> b) -> a -> b
$ Set (GeneralType a) -> [GeneralType a]
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
T (GeneralType a)
x

instance (Eq a, Ord a) => Bounded (GeneralType a) where
  minBound :: GeneralType a
minBound = Maybe (GeneralType a) -> GeneralType a
forall a (f :: * -> *). (Mergeable a, Foldable f) => f a -> a
forall (f :: * -> *).
Foldable f =>
f (GeneralType a) -> GeneralType a
mergeAny Maybe (GeneralType a)
forall a. Maybe a
Nothing  -- all
  maxBound :: GeneralType a
maxBound = Maybe (GeneralType a) -> GeneralType a
forall a (f :: * -> *). (Mergeable a, Foldable f) => f a -> a
forall (f :: * -> *).
Foldable f =>
f (GeneralType a) -> GeneralType a
mergeAll Maybe (GeneralType a)
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 = ([GeneralType a] -> GeneralType a)
-> ([GeneralType a] -> GeneralType a)
-> (T (GeneralType a) -> GeneralType a)
-> GeneralType a
-> GeneralType a
forall a b.
PreserveMerge a =>
([b] -> b) -> ([b] -> b) -> (T a -> b) -> a -> b
reduceMergeTree [GeneralType a] -> GeneralType a
forall a (f :: * -> *). (Mergeable a, Foldable f) => f a -> a
forall (f :: * -> *).
Foldable f =>
f (GeneralType a) -> GeneralType a
mergeAll [GeneralType a] -> GeneralType a
forall a (f :: * -> *). (Mergeable a, Foldable f) => f a -> a
forall (f :: * -> *).
Foldable f =>
f (GeneralType a) -> GeneralType a
mergeAny a -> GeneralType a
T (GeneralType a) -> GeneralType a
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 = ([GeneralType b] -> GeneralType b)
-> ([GeneralType b] -> GeneralType b)
-> (T (GeneralType a) -> GeneralType b)
-> GeneralType a
-> GeneralType b
forall a b.
PreserveMerge a =>
([b] -> b) -> ([b] -> b) -> (T a -> b) -> a -> b
reduceMergeTree [GeneralType b] -> GeneralType b
forall a (f :: * -> *). (Mergeable a, Foldable f) => f a -> a
forall (f :: * -> *).
Foldable f =>
f (GeneralType b) -> GeneralType b
mergeAny [GeneralType b] -> GeneralType b
forall a (f :: * -> *). (Mergeable a, Foldable f) => f a -> a
forall (f :: * -> *).
Foldable f =>
f (GeneralType b) -> GeneralType b
mergeAll ((a -> GeneralType b) -> GeneralType a -> GeneralType b)
-> ((a -> b) -> a -> GeneralType b)
-> (a -> b)
-> GeneralType a
-> GeneralType b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> GeneralType b
forall a. (Eq a, Ord a) => a -> GeneralType a
singleType (b -> GeneralType b) -> (a -> b) -> a -> GeneralType b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.)