module Data.Schema.Deinline (deinline) where

import           Control.Arrow (first)
import           Data.Fix      (Fix (..), foldFix)
import           Data.List     (nub)
import           Data.Schema   (Schema, SchemaF (..), Type (..))

deinline :: Schema -> Schema
deinline :: Schema -> Schema
deinline = (Schema, [Schema]) -> Schema
forall a b. (a, b) -> a
fst ((Schema, [Schema]) -> Schema)
-> (Schema -> (Schema, [Schema])) -> Schema -> Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SchemaF (Schema, [Schema]) -> (Schema, [Schema]))
-> Schema -> (Schema, [Schema])
forall (f :: * -> *) a. Functor f => (f a -> a) -> Fix f -> a
foldFix SchemaF (Schema, [Schema]) -> (Schema, [Schema])
getTypes

getTypes :: SchemaF (Schema, [Schema]) -> (Schema, [Schema])
getTypes :: SchemaF (Schema, [Schema]) -> (Schema, [Schema])
getTypes (Atom Type
ty)                    = (SchemaF Schema -> Schema
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (SchemaF Schema -> Schema)
-> (Type -> SchemaF Schema) -> Type -> Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> SchemaF Schema
forall a. Type -> SchemaF a
Atom (Type -> Schema) -> Type -> Schema
forall a b. (a -> b) -> a -> b
$ Type
ty, [])
getTypes (Sum dt :: Maybe DatatypeName
dt@(Just (String
_, String
ty)) [(Schema, [Schema])]
cons) = (SchemaF Schema -> Schema
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (SchemaF Schema -> Schema)
-> (String -> SchemaF Schema) -> String -> Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> SchemaF Schema
forall a. Type -> SchemaF a
Atom (Type -> SchemaF Schema)
-> (String -> Type) -> String -> SchemaF Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Type
TyName (String -> Schema) -> String -> Schema
forall a b. (a -> b) -> a -> b
$ String
ty, SchemaF Schema -> Schema
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Maybe DatatypeName -> [Schema] -> SchemaF Schema
forall a. Maybe DatatypeName -> [a] -> SchemaF a
Sum Maybe DatatypeName
dt (((Schema, [Schema]) -> Schema) -> [(Schema, [Schema])] -> [Schema]
forall a b. (a -> b) -> [a] -> [b]
map (Schema, [Schema]) -> Schema
forall a b. (a, b) -> a
fst [(Schema, [Schema])]
cons)) Schema -> [Schema] -> [Schema]
forall a. a -> [a] -> [a]
: ((Schema, [Schema]) -> [Schema])
-> [(Schema, [Schema])] -> [Schema]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Schema, [Schema]) -> [Schema]
forall a b. (a, b) -> b
snd [(Schema, [Schema])]
cons)
getTypes (Prod [(Schema, [Schema])]
fields)                = (SchemaF Schema -> Schema
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (SchemaF Schema -> Schema)
-> ([(Schema, [Schema])] -> SchemaF Schema)
-> [(Schema, [Schema])]
-> Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Schema] -> SchemaF Schema
forall a. [a] -> SchemaF a
Prod ([Schema] -> SchemaF Schema)
-> ([(Schema, [Schema])] -> [Schema])
-> [(Schema, [Schema])]
-> SchemaF Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Schema, [Schema]) -> Schema) -> [(Schema, [Schema])] -> [Schema]
forall a b. (a -> b) -> [a] -> [b]
map (Schema, [Schema]) -> Schema
forall a b. (a, b) -> a
fst ([(Schema, [Schema])] -> Schema) -> [(Schema, [Schema])] -> Schema
forall a b. (a -> b) -> a -> b
$ [(Schema, [Schema])]
fields, ((Schema, [Schema]) -> [Schema])
-> [(Schema, [Schema])] -> [Schema]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Schema, [Schema]) -> [Schema]
forall a b. (a, b) -> b
snd [(Schema, [Schema])]
fields)
getTypes (Field String
name (Schema, [Schema])
ty)              = (Schema -> Schema) -> (Schema, [Schema]) -> (Schema, [Schema])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (SchemaF Schema -> Schema
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (SchemaF Schema -> Schema)
-> (Schema -> SchemaF Schema) -> Schema -> Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Schema -> SchemaF Schema
forall a. String -> a -> SchemaF a
Field String
name) (Schema, [Schema])
ty
getTypes (Con String
name (Schema, [Schema])
ty)                = (Schema -> Schema) -> (Schema, [Schema]) -> (Schema, [Schema])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (SchemaF Schema -> Schema
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (SchemaF Schema -> Schema)
-> (Schema -> SchemaF Schema) -> Schema -> Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Schema -> SchemaF Schema
forall a. String -> a -> SchemaF a
Con String
name) (Schema, [Schema])
ty
getTypes (List (Schema, [Schema])
ty)                    = (Schema -> Schema) -> (Schema, [Schema]) -> (Schema, [Schema])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (SchemaF Schema -> Schema
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (SchemaF Schema -> Schema)
-> (Schema -> SchemaF Schema) -> Schema -> Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> SchemaF Schema
forall a. a -> SchemaF a
List) (Schema, [Schema])
ty
getTypes (Schema [(Schema, [Schema])]
mods)                = (SchemaF Schema -> Schema
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (SchemaF Schema -> Schema)
-> ([(Schema, [Schema])] -> SchemaF Schema)
-> [(Schema, [Schema])]
-> Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Schema] -> SchemaF Schema
forall a. [a] -> SchemaF a
Schema ([Schema] -> SchemaF Schema)
-> ([(Schema, [Schema])] -> [Schema])
-> [(Schema, [Schema])]
-> SchemaF Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Schema] -> [Schema]
forall a. Eq a => [a] -> [a]
nub ([Schema] -> [Schema])
-> ([(Schema, [Schema])] -> [Schema])
-> [(Schema, [Schema])]
-> [Schema]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Schema, [Schema]) -> [Schema])
-> [(Schema, [Schema])] -> [Schema]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Schema, [Schema]) -> [Schema]
forall a b. (a, b) -> b
snd ([(Schema, [Schema])] -> Schema) -> [(Schema, [Schema])] -> Schema
forall a b. (a -> b) -> a -> b
$ [(Schema, [Schema])]
mods, [])
getTypes SchemaF (Schema, [Schema])
x                            = String -> (Schema, [Schema])
forall a. HasCallStack => String -> a
error (String -> (Schema, [Schema])) -> String -> (Schema, [Schema])
forall a b. (a -> b) -> a -> b
$ String
"unhandled: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> SchemaF (Schema, [Schema]) -> String
forall a. Show a => a -> String
show SchemaF (Schema, [Schema])
x