Schema.hs

{-# Language ConstraintKinds #-}
{-# Language DataKinds #-}
{-# Language FlexibleInstances #-}
{-# Language KindSignatures #-}
{-# Language MultiParamTypeClasses #-}
{-# Language PolyKinds #-}
{-# Language RankNTypes #-}
{-# Language ScopedTypeVariables #-}
{-# Language TypeOperators #-}
module Schema where

import Data.Proxy
import Data.Typeable
import GHC.Types

class Typeable a => ToJSON a where
instance ToJSON Int
instance ToJSON Float

class Typeable a => ToYAML a
instance ToYAML Int
instance ToYAML Float

makeJSONSchema :: ToJSON a => Proxy a -> String
makeJSONSchema = show . typeRep

makeYAMLSchema :: ToYAML a => Proxy a -> String
makeYAMLSchema = show . typeRep

class HCFoldMap (c :: * -> Constraint) (ts :: [*]) where
  hcFoldMap :: Monoid a => Proxy c -> Proxy ts -> (forall t. c t => Proxy t -> a) -> a

instance HCFoldMap c '[] where
  hcFoldMap _ _ _ = mempty

instance (HCFoldMap c ts, c t) => HCFoldMap c (t ': ts) where
  hcFoldMap pc _ f = f (Proxy :: Proxy t) <> hcFoldMap pc (Proxy :: Proxy ts) f

type SchemaTypes = [Int, Float]

jsonSchema :: String
jsonSchema = hcFoldMap (Proxy :: Proxy ToJSON) (Proxy :: Proxy SchemaTypes) makeJSONSchema

yamlSchema :: String
yamlSchema = hcFoldMap (Proxy :: Proxy ToYAML) (Proxy :: Proxy SchemaTypes) makeYAMLSchema