Skip to content

Instantly share code, notes, and snippets.

@kosmikus
Last active November 6, 2015 05:20
Show Gist options
  • Save kosmikus/6ccdda13fd7938b2857e to your computer and use it in GitHub Desktop.
Save kosmikus/6ccdda13fd7938b2857e to your computer and use it in GitHub Desktop.
{-# 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)]
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment