SwaggerExample.hs

{-# LANGUAGE DeriveGeneric, FlexibleInstances, ScopedTypeVariables, FlexibleContexts, DataKinds, TypeFamilies #-}
module SwaggerExample where

import Data.Proxy
import qualified GHC.Generics as G
import Generics.SOP

data Todo = Todo {
    created :: Int
  , description :: String
  } deriving (Show, Eq, G.Generic)

instance Generic Todo
instance HasDatatypeInfo Todo

data SwaggerType =
    IntegerSwag
  | StringSwag
  deriving Show

class ToSwaggerType a where
  toSwaggerType :: Proxy a -> SwaggerType

instance ToSwaggerType Int where
  toSwaggerType _ = IntegerSwag

instance ToSwaggerType String where
  toSwaggerType _ = StringSwag

sig :: (Generic a, HasDatatypeInfo a, Code a ~ '[ xs ], All ToSwaggerType xs)
    => Proxy a -> [(String, SwaggerType)]
sig = hcollapse
    . hcliftA (Proxy :: Proxy ToSwaggerType)
              (\ (K n :: K String a) -> K (n, toSwaggerType (Proxy :: Proxy a)))
    . fieldNames
    . constructorInfo
    . datatypeInfo

constructorInfo :: DatatypeInfo '[ xs ] -> ConstructorInfo xs
constructorInfo (ADT     _ _ (p :* Nil)) = p
constructorInfo (Newtype _ _ p         ) = p

fieldNames :: ConstructorInfo xs -> NP (K String) xs
fieldNames (Record _ p) = hliftA (\ (FieldInfo n) -> K n) p
fieldNames _            = error "not a record / or invent field names / what does aeson do?"

-- Example:
--
-- GHCi> sig (Proxy :: Proxy Todo)
-- [("created",IntegerSwag),("description",StringSwag)]