servant-ede (empty) → 0.4

raw patch · 11 files changed

+787/−0 lines, 11 filesdep +aesondep +basedep +bytestringsetup-changed

Dependencies added: aeson, base, bytestring, ede, either, filepath, http-media, http-types, semigroups, servant, servant-ede, servant-server, text, transformers, unordered-containers, wai, warp

Files

• LICENSE +30/−0
• README.md +3/−0
• Setup.hs +2/−0
• example/example.hs +33/−0
• servant-ede.cabal +62/−0
• src/Servant/HTML/EDE.hs +229/−0
• src/Servant/HTML/EDE/Internal.hs +12/−0
• src/Servant/HTML/EDE/Internal/Reify.hs +25/−0
• src/Servant/HTML/EDE/Internal/Templates.hs +223/−0
• src/Servant/HTML/EDE/Internal/ToObject.hs +97/−0
• src/Servant/HTML/EDE/Internal/Validate.hs +71/−0

@@ -0,0 +1,30 @@+Copyright (c) 2015, Alp Mestanogullari++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Alp Mestanogullari nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,3 @@+# servant-ede++Support ede templates in servant. See the documentation of the `Servant.HTML.EDE` module for examples and explanations.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,33 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE OverloadedStrings #-}+import Control.Monad+import Data.Monoid+import GHC.Generics+import Network.Wai.Handler.Warp+import Servant+import Servant.HTML.EDE+import Text.EDE++data User = User { name :: String, age :: Int }+  deriving (Eq, Show, Generic)++instance ToObject User where++type API = "index" :> Tpl "index.tpl"+      :<|> "foo"   :> Tpl "foo.tpl"+      :<|> "user"  :> Get '[HTML "user.tpl"] User++api :: Proxy API+api = Proxy++server :: Server API+server = rawTemplate :<|> rawTemplate :<|> return (User "lambdabot" 35)++  where rawTemplate = return mempty++main :: IO ()+main = do+  loadTemplates api "example"+  run 8082 (serve api server)

@@ -0,0 +1,62 @@+-- Initial servant-ede.cabal generated by cabal init.  For further +-- documentation, see http://haskell.org/cabal/users-guide/++name:                servant-ede+version:             0.4+synopsis:            Combinators for rendering EDE templates in servant web applications+description:+  Combinators for rendering EDE templates in servant web applications.+  .+  Documentation and examples available at "Servant.HTML.EDE".+homepage:            http://github.com/alpmestan/servant-ede+license:             BSD3+license-file:        LICENSE+author:              Alp Mestanogullari+maintainer:          alpmestan@gmail.com+copyright:           2015 Alp Mestanogullari+category:            Web+build-type:          Simple+extra-source-files:  README.md+cabal-version:       >=1.10++library+  exposed-modules:     Servant.HTML.EDE+  other-modules:+      Servant.HTML.EDE.Internal+    , Servant.HTML.EDE.Internal.Reify+    , Servant.HTML.EDE.Internal.Templates+    , Servant.HTML.EDE.Internal.ToObject+    , Servant.HTML.EDE.Internal.Validate++  build-depends:+      aeson >= 0.8+    , base >=4.7 && <5+    , bytestring >= 0.10+    , filepath >= 1.2+    , ede >= 0.2+    , either >= 4+    , http-media >= 0.6+    , http-types >= 0.8+    , semigroups >= 0.16+    , servant >= 0.4+    , servant-server >= 0.4+    , text >= 1.0+    , transformers >= 0.4+    , unordered-containers >= 0.2+    , wai >= 3.0++  ghc-options:         -O2 -Wall+  hs-source-dirs:      src+  default-language:    Haskell2010+++executable servant-ede-example+  main-is: example.hs+  hs-source-dirs: example+  default-language: Haskell2010+  build-depends:+      base >= 4.7 && <5+    , ede+    , servant-server+    , servant-ede+    , warp >= 3.0

@@ -0,0 +1,229 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+-- |+-- Module:      Servant.HTML.EDE+-- Copyright:   (c) 2015 Alp Mestanogullari+-- License:     BSD3+-- Maintainer:  Alp Mestanogullari <alpmestan@gmail.com>+-- Stability:   experimental+--+-- Combinators for rendering <http://hackage.haskell.org/package/ede ede>+-- templates in servant web applications.+module Servant.HTML.EDE (+    -- * Introduction+    -- $intro++    -- * Explicitly binding data to a template+    -- $explicit++    -- * Template rendering as a content-type+    -- $contenttype+    +    -- * Reference++    -- ** 'Tpl' combinator, for explicit data binding+    Tpl+  +  , -- ** 'HTML' content type, for serializing data types to HTML+    HTML+  , ToObject(..)++  , -- ** Loading templates+    loadTemplates+  , TemplateError+  , Errors++  , -- ** Helpers+    TemplateFiles+  , Reify(..)++  , -- * Global template store+    -- $templatestore+  ) where++import Control.Applicative+import Control.Concurrent.MVar+import Control.Monad.IO.Class+import Data.Aeson+import Data.Foldable+import Data.HashMap.Strict+import Data.Traversable+import Servant+import Servant.HTML.EDE.Internal++-- | Same as 'loadTemplates', except that it initializes a global+--   template store (i.e a 'Templates' value) and fills it with+--   the resulting compiled templates if all of them are compiled+--   successfully. If that's not the case, the global template store+--   (under an 'MVar') is left empty.+--+--   /IMPORTANT/: Must /always/ be called before starting your /servant/ application.+loadTemplates :: (Reify (TemplateFiles api), Applicative m, MonadIO m)+              => Proxy api+              -> FilePath -- ^ root directory for the templates+              -> m Errors+loadTemplates proxy dir = do+  res <- loadTemplates' proxy dir+  case res of+    Left errs  -> return errs+    Right tpls -> do+      liftIO $ putMVar __template_store tpls+      return []++loadTemplates' :: (Reify (TemplateFiles api), Applicative m, MonadIO m)+               => Proxy api+               -> FilePath   -- ^ root directory for the templates+               -> m (Either Errors Templates)+loadTemplates' proxy templatedir =+  fmap (eitherValidate . fmap fold) . runValidateT $+    traverse (processFile templatedir) files++  where files :: [FilePath]+        files = templateFiles proxy++-- $intro+--+-- The <http://hackage.haskell.org/package/ede ede> library provides+-- a reasonably good template engine. This package explores+-- a smooth integration of /ede/ into <http://haskell-servant.github.io/ servant>+-- through two combinators.++-- $explicit+--+-- The first combinator is 'Tpl', which is used for generating web pages+-- from /ede/ templates by explicitly returning an 'Object'+-- (which is a synonym for @'HashMap' 'Text' 'Value'@, i.e a /JSON object/)+-- from the handler which will then be rendered against a given template.+--+-- @+-- -- we want our template file, index.html,+-- -- to be rendered under /index+-- type API = "index" :> 'Tpl' "index.html"+--+-- api :: 'Proxy' API+-- api = Proxy+--+-- server :: 'Server' API+-- server = return indexData+--+--   where indexData :: 'Object'+--         indexData =+--           HM.fromList [ ("company_name", "Foo Inc.")+--                       , ("ceo", "Bar Baz")+--                       ]+--+-- main :: IO ()+-- main = do+--   -- this tells the library to look for index.html+--   -- under the ./templates directory+--   'loadTemplates' api "./templates"+--   run 8080 server+-- @+--+-- Note that if your template doesn't need any data, you can just+-- return the empty 'Object', with "Data.Monoid"\'s 'mempty'.+--+-- The call to 'loadTemplates' is mandatory. It loads and compiles all the+-- templates used in your API and puts them in a global \"compiled template store\".+-- I'm not really satisfied with this, see the /Global template store/ section+-- for more on this topic.++-- $contenttype+--+-- The other way to use this package is reminiscent of how you can render HTML+-- with <http://hackage.haskell.org/package/servant-blaze servant-blaze> or+-- its cousin <http://hackage.haskell.org/package/servant-lucid servant-lucid>.+-- Indeed, this package provides an 'HTML' content type just like the two+-- aforementionned libraries. However, unlike in these packages, this 'HTML'+-- type is parametrised by a type-level string meant to be the name of the+-- template file (or path to the template file starting from a \"root\" directory+-- of templates).+--+-- In the same way that /servant/'s standard 'JSON' combinator+-- carries the precise way in which we encode haskell values to JSON,+-- in addition to representing the @application/json@ content type,+-- 'HTML' carries the template used to render values of a given type.+--+-- If we wanted to have a @/user@ endpoint accessible in JSON or HTML,+-- returning a user, we could write:+--+-- @+-- type UserAPI = "user" :> 'Get' '['JSON', 'HTML' "user.tpl"] User+--+-- userAPI :: Proxy UserAPI+-- userAPI = Proxy+-- @+--+-- How, then, can /servant/ know how to marshall @User@ to the template+-- in order to render it? Simple, you just have to provide an instance of+-- the following 'ToObject' class:+--+-- @+-- class ToObject a where+--   toObject :: a -> 'Object'+-- @+--+-- If our @User@ data type is:+--+-- > data User = User { name :: String, age :: Int }+--+-- we can simply do, using functions from "Text.EDE":+--+-- @+-- instance ToObject User where+--   toObject u =+--     fromPairs [ "name" .= name u+--               , "age"  .= age u+--               ]+-- @+--+-- However, this is actually not necessary. This library provides can+-- derive the 'ToObject' instance for you as long as your data type+-- derives the "GHC.Generics.Generic" class, which can be done by specifying+-- @{-# LANGUAGE DeriveGeneric #-}@ at the top of your module, adding+-- @import GHC.Generics@ and by changing the @User@ data type declaration to:+--+-- > data User = User { name :: String, age :: Int } deriving Generic+--+-- You can then simply write:+--+-- > instance ToObject User+--+-- and the library will figure out how to encode @User@ to JSON for you.+-- /IMPORTANT/: This only works with data types with a single record and+-- field selectors.+--+-- Now we can put this all to work with a simple webservice:+--+-- @+-- server :: Server UserAPI+-- server = return (User "lambdabot" 31)+--+-- main :: IO ()+-- main = do+--   loadTemplates userAPI "./templates"+--   run 8082 (serve userAPI server)+-- @+--+-- Again, the call to 'loadTemplates' is mandatory because the 'HTML'+-- content type relies on having its hands on already-compiled templates.+--+-- You can now write a @user.tpl@ template under the @./templates@ directory+-- using any of <http://hackage.haskell.org/package/ede ede>'s constructs,+-- assuming that a @name@ string variable and an @age@ int variable are in scope.++-- $templatestore+--+-- Why have a global template store? Well, while for 'Tpl' we can run arbitrary code+-- in the handlers, take arguments and what not, that's not the case when writing the+-- 'MimeRender' instance for 'HTML'.+--+-- All we have is a value of some type and we have to pull a compiled template out of+-- thin air. That's why we use a global 'MVar'-protected template store indexed by filename.+-- It's filled once at the beginning when you call 'loadTemplates' and is then only accessed+-- in a /read-only/ fashion. I would be interested in hearing about any suggestion,+-- improvement or replacement for this. If you have an idea, feel free to shoot me an+-- email at the address specified in the cabal description.

@@ -0,0 +1,12 @@+module Servant.HTML.EDE.Internal+  ( module Servant.HTML.EDE.Internal.Reify+  , module Servant.HTML.EDE.Internal.Templates+  , module Servant.HTML.EDE.Internal.ToObject+  , module Servant.HTML.EDE.Internal.Validate+  ) where++import Servant.HTML.EDE.Internal.Reify+import Servant.HTML.EDE.Internal.Templates+import Servant.HTML.EDE.Internal.ToObject+import Servant.HTML.EDE.Internal.Validate+

@@ -0,0 +1,25 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Servant.HTML.EDE.Internal.Reify (Reify(..)) where++import Data.Proxy+import GHC.TypeLits++-- | Helper class to reify a type-level list of strings+--   into a value-level list of string. Used to turn+--   the type-level list of template file names into+--   a value-level list.+class Reify (symbols :: [Symbol]) where+  reify :: Proxy symbols -> [String]++instance Reify '[] where+  reify _ = []++instance (KnownSymbol s, Reify symbols)+      => Reify (s ': symbols) where+  reify _ = symbolVal ps : reify psymbols++    where ps = Proxy :: Proxy s+          psymbols = Proxy :: Proxy symbols

@@ -0,0 +1,223 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+module Servant.HTML.EDE.Internal.Templates+  ( Tpl+  , HTML+  , Templates(..)+  , templateMap+  , __template_store+  , TemplateFiles+  , TemplateError+  , Errors+  , processFile+  , templateFiles+  ) where++import Control.Concurrent.MVar+import Control.Monad.IO.Class+import Control.Monad.Trans.Either+import Data.Aeson (Object)+import Data.ByteString.Lazy.Char8 (pack)+import Data.HashMap.Strict+import Data.Proxy+import Data.Semigroup+import Data.Text.Lazy.Encoding (encodeUtf8)+import GHC.TypeLits+import Network.HTTP.Media hiding (Accept)+import Network.HTTP.Types+import Network.Wai+import Servant+import Servant.HTML.EDE.Internal.Reify+import Servant.HTML.EDE.Internal.ToObject+import Servant.HTML.EDE.Internal.Validate+import Servant.Server.Internal+import Servant.Server.Internal.ServantErr+import System.FilePath+import System.IO.Unsafe (unsafePerformIO)+import Text.EDE++import qualified Data.HashMap.Strict as HM++__template_store :: MVar Templates+__template_store = unsafePerformIO newEmptyMVar++-- | Combinator for serving EDE templates without arguments. Usage:+--+-- > type API = "index" :> Tpl "index.tpl"+-- >       :<|> "about" :> Tpl "about.tpl"+-- >+-- > api :: Proxy API+-- > api = Proxy+-- >+-- > server :: Templates -> Server API+-- > server tpls = return mempty :<|> return mempty+-- >+-- > main :: IO ()+-- > main = do+-- >   loadTemplates_ api "./templates"+-- >   run 8080 (serve api server)+data Tpl (tplfile :: Symbol)+++-- | The so-called "request handler" for an endpoint ending+--   with 'Tpl' just has to be the opaque 'Templates' value+--   returned by 'Servant.HTML.EDE.loadTemplates' applied to your API, which+--   is just a compiled template store indexed by file name.+instance KnownSymbol tplfile => HasServer (Tpl tplfile) where+  type ServerT (Tpl tplfile) m = m Object++  route Proxy mobj request respond+    | pathIsEmpty request && requestMethod request == methodGet = do+        tpls <- getTemplates+        val <- runEitherT mobj+        case val of+          Left e -> respond . succeedWith $ responseServantErr e+          Right v  -> +            case mbody tpls v of+              Success body -> respond . succeedWith $+                responseLBS ok200 [("Content-Type", "text/html")] (encodeUtf8 body)+              Failure doc  -> respond . succeedWith $+                responseLBS status500 [] ("template error: " <> pack (show doc))++    | pathIsEmpty request && requestMethod request /= methodGet =+        respond (failWith WrongMethod)++    | otherwise = respond (failWith NotFound)++    where filename = symbolVal (Proxy :: Proxy tplfile)+          mbody ts val = render (ts HM.! filename) val+          getTemplates = fmap templateMap (readMVar __template_store)++-- | 'HTML' content type, but more than just that.+--+--   'HTML' takes a type-level string which is+--   a filename for the template you want to use to+--   render values. Example:+--+-- @+-- type UserAPI = "user" :> Get '[JSON, HTML "user.tpl"] User+--+-- userAPI :: Proxy UserAPI+-- userAPI = Proxy+--+-- data User = User { name :: String, age :: Int } deriving Generic+--+-- instance ToJSON User+-- instance ToObject User+--+-- server :: Server API+-- server = return (User "lambdabot" 31)+--+-- main :: IO ()+-- main = do+--   loadTemplates userAPI "./templates"+--   run 8082 (serve userAPI server)+-- @+--+-- This will look for a template at @.\/templates\/user.tpl@, which could+-- for example be:+--+-- > <ul>+-- >   <li><strong>Name:</strong> {{ name }}</li>+-- >   <li><strong>Age:</strong> {{ age }}</li>+-- > </ul>+data HTML (tplfile :: Symbol)++-- | @text\/html;charset=utf-8@+instance Accept (HTML tplfile) where+  contentType _ = "text" // "html" /: ("charset", "utf-8")++instance (KnownSymbol tplfile, ToObject a)+      => MimeRender (HTML tplfile) a where+  mimeRender _ val = encodeUtf8 . result (error . show) id $+    render templ (toObject val)++    where templ = tmap ! filename+          filename = symbolVal (Proxy :: Proxy tplfile)+          tmap = templateMap $ unsafePerformIO (readMVar __template_store)++type family Append (xs :: [k]) (ys :: [k]) :: [k] where+  Append '[]       ys = ys+  Append (x ': xs) ys = x ': Append xs ys++type family Member (x :: k) (xs :: [k]) :: Bool where+  Member x (x ': xs) = 'True+  Member x (y ': xs) = Member x xs+  Member x       '[] = False++-- | Collect all the template filenames of an API as a type-level+--   list of strings, by simply looking at all occurences of the+--   'Tpl' and 'HTML' combinators and keeping the filenames associated to them.+type family TemplateFiles (api :: k) :: [Symbol]+type instance TemplateFiles (a :<|> b)    = Append (TemplateFiles a) (TemplateFiles b)+type instance TemplateFiles (a :> r)      = TemplateFiles r+type instance TemplateFiles (Tpl f)       = '[f]+type instance TemplateFiles (Delete cs a) = CTFiles cs+type instance TemplateFiles (Get cs a)    = CTFiles cs+type instance TemplateFiles (Patch cs a)  = CTFiles cs+type instance TemplateFiles (Post cs a)   = CTFiles cs+type instance TemplateFiles (Put cs a)    = CTFiles cs++type family CTFiles (cts :: [*]) :: [Symbol] where+  CTFiles '[]        = '[]+  CTFiles (c ': cts) = Append (CTFile c) (CTFiles cts)++type family CTFile c :: [Symbol] where+  CTFile (HTML fp) = '[fp]+  CTFile         a = '[]++templates :: Proxy api -> Proxy (TemplateFiles api)+templates Proxy = Proxy++templateFiles :: Reify (TemplateFiles api) => Proxy api -> [FilePath]+templateFiles = reify . templates++-- | An opaque "compiled-template store".+--+-- The only way to get a value of this type is to use+-- 'Servant.EDE.loadTemplates' on a proxy of your API.+--+-- This ensures that when we lookup a template (in order+-- to render it) in our 'Templates' store, we are+-- guaranteed to find it.+newtype Templates = Templates (HashMap String Template)+  deriving Eq++templateMap :: Templates -> HashMap String Template+templateMap (Templates m) = m++instance Semigroup Templates where+  Templates a <> Templates b = Templates (a <> b)++instance Monoid Templates where+  mempty = Templates mempty++  a `mappend` b = a <> b++tpl :: FilePath -> Template -> Templates+tpl fp t = Templates $ HM.singleton fp t++-- | A 'TemplateError' is a pair of a template filename+--   and the error string for that file.+type TemplateError = (FilePath, String)++-- | A list of 'TemplateError's.+type Errors = [TemplateError]++err :: Show a => FilePath -> a -> Errors+err fp d = [(fp, show d)]++processFile :: MonadIO m => FilePath -> FilePath -> ValidateT Errors m Templates+processFile d fp = validate . liftIO $ parseFile' (d </> fp)++  where parseFile' f = fmap validateResult (parseFile f)+        validateResult (Success t) = OK (tpl fp t)+        validateResult (Failure e) = NotOK (err fp e)

@@ -0,0 +1,97 @@+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE FlexibleInstances #-}+-- {-# LANGUAGE OverloadedStrings #-}+module Servant.HTML.EDE.Internal.ToObject where++import Data.Aeson+import Data.HashMap.Strict+import Data.Monoid+import Data.Text+import GHC.Generics++-- | Turn haskell values into JSON objects.+--+-- This is the mechanism used by EDE to marshall data from Haskell+-- to the templates. The rendering is then just about feeding the+-- resulting 'Object' to a compiled 'Template'. Example:+--+-- > import Text.EDE+-- >+-- > data User = User { name :: String, age :: Int }+-- > instance ToObject User where+-- >   toObject user =+-- >     fromPairs [ "name" .= name user+-- >               , "age"  .= age user+-- >               ]+--+-- However, you're not forced to write the instance yourself for such a type.+-- Indeed, for any record type (i.e a datatype with a single constructor and+-- with field selectors) you can let @GHC.Generics@ derive the 'ToObject' instance+-- for you.+--+-- > data User = User { name :: String, age :: Int } deriving Generic+-- > instance ToObject User+--+-- This will generate an equivalent instance to the previous one.+class ToObject a where++  -- | Turn values of type @a@ into JSON 'Object's.+  --+  -- @ +  -- -- Reminder:+  -- type Object = 'HashMap' 'Text' 'Value'+  -- @+  toObject :: a -> Object+  +  default toObject :: (Generic a, GToObject (Rep a)) => a -> Object+  toObject = genericToObject++instance ToObject (HashMap Text Value) where+  toObject = id++class GToObject f where+  gtoObject :: f a -> Object++instance GToObject V1 where+  gtoObject _ = mempty++instance GToObject U1 where+  gtoObject U1 = mempty++instance (GToObject f, GToObject g)+      => GToObject (f :*: g) where+  gtoObject (f :*: g) = gtoObject f <> gtoObject g++instance GToObject a => GToObject (M1 D d a) where+  gtoObject (M1 x) = gtoObject x++instance GToObject a => GToObject (M1 C c a) where+  gtoObject (M1 x) = gtoObject x++instance (Selector s, ToJSON a) => GToObject (M1 S s (K1 r a)) where+  gtoObject s@(M1 (K1 x)) = fromList [(fieldname, value)]+    where fieldname = pack (selName s)+          value     = toJSON x++genericToObject :: (Generic a, GToObject (Rep a)) => a -> Object+genericToObject = gtoObject . from++++++++++++++++++

@@ -0,0 +1,71 @@+module Servant.HTML.EDE.Internal.Validate where++import Control.Applicative+import Data.Foldable+import Data.Traversable+import Data.Functor.Compose+import Data.Semigroup++data Validated e a = OK a | NotOK e+  deriving (Eq, Show)++instance Functor (Validated e) where+  fmap f (OK x)    = OK (f x)+  fmap _ (NotOK e) = NotOK e++instance Semigroup e => Applicative (Validated e) where+  pure x = OK x++  OK f    <*> OK x     = OK (f x)+  OK _    <*> NotOK e  = NotOK e+  NotOK e <*> OK _     = NotOK e+  NotOK e <*> NotOK e' = NotOK (e <> e')++instance Foldable (Validated e) where+  foldMap f (OK x)    = f x+  foldMap _ (NotOK _) = mempty++instance Traversable (Validated e) where+  traverse f (OK x)    = fmap OK (f x)+  traverse _ (NotOK x) = pure (NotOK x)++instance (Semigroup e, Semigroup a) => Semigroup (Validated e a) where+  NotOK e <> NotOK e' = NotOK (e <> e')+  NotOK e <> OK _     = NotOK e+  OK a    <> OK b     = OK (a <> b)+  OK _    <> NotOK e  = NotOK e++validateEither :: Either e a -> Validated e a+validateEither (Left e)  = NotOK e+validateEither (Right x) = OK x++eitherValidate :: Validated e a -> Either e a+eitherValidate (OK x)    = Right x+eitherValidate (NotOK e) = Left e++ok :: Applicative m => a -> ValidateT e m a+ok = VT . pure . OK++no :: Applicative m => e -> ValidateT e m a+no = VT . pure . NotOK++validated :: (e -> r) -> (a -> r) -> Validated e a -> r+validated f _ (NotOK e) = f e+validated _ f (OK x)    = f x++newtype ValidateT e m a = VT+  { runValidateT :: m (Validated e a) }++validate :: m (Validated e a) -> ValidateT e m a+validate = VT++instance Functor m => Functor (ValidateT e m) where+  fmap f (VT m) = VT $ fmap (fmap f) m++instance (Applicative m, Semigroup e) => Applicative (ValidateT e m) where+  pure = VT . pure . pure++  VT f <*> VT x = VT . getCompose $ Compose f <*> Compose x++instance (Applicative m, Semigroup e, Semigroup a) => Semigroup (ValidateT e m a) where+  VT a <> VT b = VT $ (<>) <$> a <*> b