packages feed

rest-example (empty) → 0.1.0.1

raw patch · 22 files changed

+931/−0 lines, 22 filesdep +aesondep +basedep +containerssetup-changed

Dependencies added: aeson, base, containers, filepath, happstack-server, hxt, json-schema, monad-control, mtl, regular, regular-xmlpickler, rest-core, rest-example, rest-gen, rest-happstack, rest-snap, rest-types, rest-wai, safe, snap-core, snap-server, stm, text, time, transformers, transformers-base, unordered-containers, wai, warp

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2014, Silk B.V.++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 Silk B.V. 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ example-api/Api.hs view
@@ -0,0 +1,23 @@+-- | The API path hierarchy+module Api where++import Rest.Api++import ApiTypes (BlogApi)+import qualified Api.Post as Post+import qualified Api.User as User+import qualified Api.Post.Comment as Post.Comment++-- | Defines a versioned api+api :: Api BlogApi+api = [(mkVersion 1 0 0, Some1 blog)]++-- _ The entire routing table for v1.0.0 of the blog+blog :: Router BlogApi BlogApi+blog =+  root -/ user+       -/ post --/ comment+  where+    user = route User.resource+    post = route Post.resource+    comment = route Post.Comment.resource
+ example-api/Api/Post.hs view
@@ -0,0 +1,142 @@+{-# LANGUAGE DeriveDataTypeable #-}+module Api.Post+  ( Identifier (..)+  , WithPost+  , resource+  , postFromIdentifier+  ) where++import Control.Applicative+import Control.Concurrent.STM (STM, TVar, atomically, modifyTVar, readTVar)+import Control.Monad (unless)+import Control.Monad.Error (ErrorT, throwError)+import Control.Monad.Reader (ReaderT, asks)+import Control.Monad.Trans (lift, liftIO)+import Data.List (sortBy)+import Data.Ord (comparing)+import Data.Set (Set)+import Data.Time+import Data.Typeable+import Safe+import qualified Data.Foldable as F+import qualified Data.Set      as Set+import qualified Data.Text     as T++import Rest+import Rest.Info+import Rest.Types.ShowUrl+import qualified Rest.Resource as R++import ApiTypes+import Type.CreatePost (CreatePost)+import Type.Post (Post (Post))+import Type.PostError (PostError (..))+import Type.User (User)+import Type.UserPost (UserPost (UserPost))+import qualified Type.CreatePost as CreatePost+import qualified Type.Post       as Post+import qualified Type.User       as User++data Identifier+  = Latest+  | ById Int+  deriving (Eq, Show, Read, Typeable)++instance Info Identifier where+  describe _ = "identifier"++instance ShowUrl Identifier where+  showUrl Latest = "latest"+  showUrl (ById i) = show i++-- | Post extends the root of the API with a reader containing the ways to identify a Post in our URLs.+-- Currently only by the title of the post.+type WithPost = ReaderT Identifier BlogApi++-- | Defines the /post api end-point.+resource :: Resource BlogApi WithPost Identifier () Void+resource = mkResourceReader+  { R.name   = "post" -- Name of the HTTP path segment.+  , R.schema = withListing () $ named [("id", singleRead ById), ("latest", single Latest)]+  , R.list   = const list -- list is requested by GET /post which gives a listing of posts.+  , R.create = Just create -- PUT /post to create a new Post.+  , R.get    = Just get+  , R.remove = Just remove+  }++postFromIdentifier :: Identifier -> TVar (Set Post) -> STM (Maybe Post)+postFromIdentifier i pv = finder <$> readTVar pv+  where+    finder = case i of+      ById ident -> F.find ((== ident) . Post.id) . Set.toList+      Latest     -> headMay . sortBy (flip $ comparing Post.createdTime) . Set.toList++get :: Handler WithPost+get = mkIdHandler xmlJsonO $ \_ i -> do+  mpost <- liftIO . atomically . postFromIdentifier i =<< (lift . lift) (asks posts)+  case mpost of+    Nothing -> throwError NotFound+    Just a  -> return a++-- | List Posts with the most recent posts first.+list :: ListHandler BlogApi+list = mkListing xmlJsonO $ \r -> do+  psts <- liftIO . atomically . readTVar =<< asks posts+  return . take (count r) . drop (offset r) . sortBy (flip $ comparing Post.createdTime) . Set.toList $ psts++create :: Handler BlogApi+create = mkInputHandler (xmlJsonE . xmlJson) $ \(UserPost usr pst) -> do+  -- Make sure the credentials are valid+  checkLogin usr+  pstsVar <- asks posts+  psts <- liftIO . atomically . readTVar $ pstsVar+  post <- liftIO $ toPost (Set.size psts + 1) usr pst+  -- Validate and save the post in the same transaction.+  merr <- liftIO . atomically $ do+    let vt = validTitle pst psts+    if not vt+      then return . Just $ domainReason (const 400) InvalidTitle+      else if not (validContent pst)+        then return . Just $ domainReason (const 400) InvalidContent+        else modifyTVar pstsVar (Set.insert post) >> return Nothing+  maybe (return post) throwError merr++remove :: Handler WithPost+remove = mkIdHandler id $ \_ i -> do+  pstsVar <- lift . lift $ asks posts+  merr <- liftIO . atomically $ do+    mpost <- postFromIdentifier i pstsVar+    case mpost of+      Nothing -> return . Just $ NotFound+      Just post -> modifyTVar pstsVar (Set.delete post) >> return Nothing+  maybe (return ()) throwError merr++-- | Convert a User and CreatePost into a Post that can be saved.+toPost :: Int -> User -> CreatePost -> IO Post+toPost i u p = do+  t <- getCurrentTime+  return Post+    { Post.id          = i+    , Post.author      = User.name u+    , Post.createdTime = t+    , Post.title       = CreatePost.title p+    , Post.content     = CreatePost.content p+    }++-- | A Post's title must be unique and non-empty.+validTitle :: CreatePost -> Set Post -> Bool+validTitle p psts =+  let pt        = CreatePost.title p+      nonEmpty  = (>= 1) . T.length $ pt+      available = F.all ((pt /=) . Post.title) psts+  in available && nonEmpty++-- | A Post's content must be non-empty.+validContent :: CreatePost -> Bool+validContent = (>= 1) . T.length . CreatePost.content++-- | Throw an error if the user isn't logged in.+checkLogin :: User -> ErrorT (Reason e) BlogApi ()+checkLogin usr = do+  usrs <- liftIO . atomically . readTVar =<< asks users+  unless (usr `F.elem` usrs) $ throwError NotAllowed
+ example-api/Api/Post/Comment.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE ScopedTypeVariables #-}+module Api.Post.Comment (resource) where++import Control.Concurrent.STM (atomically, modifyTVar', readTVar)+import Control.Monad.Reader+import Control.Monad.Trans.Error+import Data.List+import Data.Monoid+import Data.Ord+import Data.Time+import qualified Data.HashMap.Strict as H+import qualified Data.Set            as Set++import Rest+import qualified Rest.Resource as R++import Api.Post (WithPost, postFromIdentifier)+import ApiTypes+import Type.Comment (Comment (Comment))+import Type.UserComment (UserComment (UserComment))+import qualified Type.Comment as Comment+import qualified Type.Post    as Post+import qualified Type.User    as User++type Identifier = String++type WithComment = ReaderT Identifier WithPost++resource :: Resource WithPost WithComment Identifier () Void+resource = mkResourceReader+  { R.name   = "comment"+  , R.schema = withListing () $ named [("id", singleRead id)]+  , R.list   = const list+  , R.create = Just create -- PUT /post to create a new Post.+  }++list :: ListHandler WithPost+list = mkListing xmlJsonO $ \r -> do+  postId <- getPostId `orThrow` NotFound+  comms <- liftIO . atomically . readTVar+       =<< (lift . lift) (asks comments)+  return . take (count r) . drop (offset r)+         . sortBy (flip $ comparing Comment.createdTime)+         . maybe [] Set.toList . H.lookup postId $ comms++create :: Handler WithPost+create = mkInputHandler (xmlJson) $ \ucomm -> do+  postId <- getPostId `orThrow` NotFound+  comm   <- liftIO $ userCommentToComment ucomm+  comms  <- lift . lift $ asks comments+  liftIO . atomically $+    modifyTVar' comms (H.insertWith (<>) postId (Set.singleton comm))+  return comm++getPostId :: ErrorT (Reason ()) WithPost (Maybe Post.Id)+getPostId = do+  postIdent <- ask+  return . fmap Post.id+        =<< liftIO . atomically . postFromIdentifier postIdent+        =<< (lift . lift) (asks posts)++userCommentToComment :: UserComment -> IO Comment+userCommentToComment (UserComment u content) = do+  t <- getCurrentTime+  return $ Comment (User.name u) t content
+ example-api/Api/User.hs view
@@ -0,0 +1,66 @@+module Api.User (resource) where++import Control.Applicative ((<$>))+import Control.Concurrent.STM (atomically, modifyTVar, readTVar)+import Control.Monad.Error (throwError)+import Control.Monad.Reader (ReaderT, asks)+import Control.Monad.Trans (liftIO)+import Data.Set (Set)+import qualified Data.Foldable as F+import qualified Data.Set      as Set+import qualified Data.Text     as T++import Rest (Handler, ListHandler, Range (count, offset), Resource, Void, domainReason, mkInputHandler, mkListing, mkResourceReader, named, singleRead,+             withListing, xmlJsonE, xmlJsonI, xmlJsonO)+import qualified Rest.Resource as R++import ApiTypes (BlogApi, ServerData (..))+import Type.User (User)+import Type.UserInfo (UserInfo (..))+import Type.UserSignupError (UserSignupError (..))+import qualified Type.User     as User+import qualified Type.UserInfo as UserInfo++-- | User extends the root of the API with a reader containing the ways to identify a user in our URLs.+-- Currently only by the user name.+type WithUser = ReaderT User.Name BlogApi++-- | Defines the /user api end-point.+resource :: Resource BlogApi WithUser User.Name () Void+resource = mkResourceReader+  { R.name   = "user" -- Name of the HTTP path segment.+  , R.schema = withListing () $ named [("name", singleRead id)]+  , R.list   = const list -- requested by GET /user, gives a paginated listing of users.+  , R.create = Just create -- PUT /user creates a new user+  }++list :: ListHandler BlogApi+list = mkListing xmlJsonO $ \r -> do+  usrs <- liftIO . atomically . readTVar =<< asks users+  return . map toUserInfo . take (count r) . drop (offset r) . Set.toList $ usrs++-- | Convert a User into a representation that is safe to show to the public.+toUserInfo :: User -> UserInfo+toUserInfo u = UserInfo { UserInfo.name = User.name u }++create :: Handler BlogApi+create = mkInputHandler (xmlJsonE . xmlJsonO . xmlJsonI) $ \usr -> do+  usrs <- asks users+  merr <- liftIO . atomically $ do+    vu <- validUserName usr <$> readTVar usrs+    if not (validPassword usr)+      then return . Just $ domainReason (const 400) InvalidPassword+      else if not vu+        then return . Just $ domainReason (const 400) InvalidUserName+        else modifyTVar usrs (Set.insert usr) >> return Nothing+  maybe (return $ toUserInfo usr) throwError merr++validPassword :: User.User -> Bool+validPassword = (> 1) . T.length . User.password++validUserName :: User -> Set User -> Bool+validUserName u usrs =+  let un        = User.name u+      available = F.all ((un /=). User.name) usrs+      nonEmpty  = (> 1) . T.length $ un+  in available && nonEmpty
+ example-api/ApiTypes.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module ApiTypes where++import Control.Applicative (Applicative)+import Control.Concurrent.STM (TVar)+import Control.Monad.Reader (MonadReader, ReaderT (..))+import Control.Monad.Trans (MonadIO)+import Data.HashMap.Strict (HashMap)+import Data.Set (Set)++import Type.Comment (Comment)+import Type.Post (Post)+import Type.User (User)+import qualified Type.Post as Post++data ServerData = ServerData+  { users    :: TVar (Set User)+  , posts    :: TVar (Set Post)+  , comments :: TVar (HashMap Post.Id (Set Comment))+  }++newtype BlogApi a = BlogApi { unBlogApi :: ReaderT ServerData IO a }+  deriving ( Applicative+           , Functor+           , Monad+           , MonadIO+           , MonadReader ServerData+           )++runBlogApi :: ServerData -> BlogApi a -> IO a+runBlogApi serverdata = flip runReaderT serverdata . unBlogApi
+ example-api/Example.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE OverloadedStrings #-}+module Example (exampleBlog) where++import Control.Applicative+import Control.Concurrent.STM (newTVarIO)+import Data.HashMap.Strict (HashMap)+import Data.Set (Set)+import qualified Data.HashMap.Strict as H+import qualified Data.Set            as Set++import ApiTypes (ServerData (..))+import Type.Comment (Comment (Comment))+import Type.Post (Post (Post))+import Type.User (User (User))++-- Set up the server state+exampleBlog :: IO ServerData+exampleBlog = ServerData+          <$> newTVarIO mockUsers+          <*> newTVarIO mockPosts+          <*> newTVarIO mockComments++-- | Prepoulated users+mockUsers :: Set User+mockUsers = Set.fromList+  [ User "adam" "1234"+  , User "erik" "2345"+  , User "sebas" "3456"+  ]++-- | Prepopulated posts+mockPosts :: Set Post+mockPosts = Set.fromList+  [ Post 0 "adam" (read "2014-03-31 15:34:00") "First post" "Hello world!"+  , Post 1 "erik" (read "2014-04-01 13:37:00") "Rest is awesome" "Just wanted to tell the world!"+  ]++mockComments :: HashMap Int (Set Comment)+mockComments = H.fromList+  [(0, Set.fromList [Comment "adam" (read "2014-06-08 14:00:00") "This is the best post I've ever written, please be gentle"])]
+ example-api/Type/Comment.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE+    DeriveDataTypeable+  , DeriveGeneric+  , TemplateHaskell+  , TypeFamilies+  #-}+module Type.Comment (Comment (..)) where++import Data.Aeson+import Data.JSON.Schema+import Data.Text (Text)+import Data.Time+import Data.Typeable+import GHC.Generics+import Generics.Regular+import Generics.Regular.XmlPickler+import Text.XML.HXT.Arrow.Pickle++import Type.Post ()+import qualified Type.User as User++data Comment = Comment+  { author      :: User.Name+  , createdTime :: UTCTime+  , content     :: Text+  } deriving (Eq, Generic, Ord, Show, Typeable)++deriveAll ''Comment "PFComment"+type instance PF Comment = PFComment++instance XmlPickler Comment where xpickle = gxpickle+instance JSONSchema Comment where schema = gSchema+instance FromJSON   Comment+instance ToJSON     Comment
+ example-api/Type/CreatePost.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE+    DeriveDataTypeable+  , DeriveGeneric+  , TemplateHaskell+  , TypeFamilies+  #-}+module Type.CreatePost where++import Data.Aeson+import Data.JSON.Schema+import Data.Text (Text)+import Data.Typeable+import GHC.Generics+import Generics.Regular+import Generics.Regular.XmlPickler+import Text.XML.HXT.Arrow.Pickle++type Title = Text++data CreatePost = CreatePost+  { title   :: Title+  , content :: Text+  } deriving (Eq, Generic, Ord, Show, Typeable)++deriveAll ''CreatePost "PFCreatePost"+type instance PF CreatePost = PFCreatePost++instance XmlPickler CreatePost where xpickle = gxpickle+instance JSONSchema CreatePost where schema = gSchema+instance FromJSON   CreatePost+instance ToJSON     CreatePost
+ example-api/Type/Post.hs view
@@ -0,0 +1,41 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE+    DeriveDataTypeable+  , DeriveGeneric+  , TemplateHaskell+  , TypeFamilies+  #-}+module Type.Post where++import Data.Aeson+import Data.JSON.Schema+import Data.Text (Text)+import Data.Time (UTCTime)+import Data.Typeable+import GHC.Generics+import Generics.Regular+import Generics.Regular.XmlPickler+import Text.XML.HXT.Arrow.Pickle++import qualified Type.User as User++type Id = Int+type Title = Text++data Post = Post+  { id          :: Id+  , author      :: User.Name+  , createdTime :: UTCTime+  , title       :: Title+  , content     :: Text+  } deriving (Eq, Generic, Ord, Show, Typeable)++deriveAll ''Post "PFPost"+type instance PF Post = PFPost++instance XmlPickler Post where xpickle = gxpickle+instance JSONSchema Post where schema = gSchema+instance ToJSON     Post+instance FromJSON   Post++instance XmlPickler UTCTime where xpickle = xpPrim
+ example-api/Type/PostError.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE+    DeriveDataTypeable+  , DeriveGeneric+  , TemplateHaskell+  , TypeFamilies+  #-}+module Type.PostError where++import Data.Aeson+import Data.JSON.Schema+import Data.Typeable+import GHC.Generics+import Generics.Regular+import Generics.Regular.XmlPickler+import Text.XML.HXT.Arrow.Pickle++data PostError = InvalidTitle | InvalidContent+  deriving (Eq, Generic, Ord, Show, Typeable)++deriveAll ''PostError "PFPostError"+type instance PF PostError = PFPostError++instance XmlPickler PostError where xpickle = gxpickle+instance JSONSchema PostError where schema = gSchema+instance FromJSON   PostError+instance ToJSON     PostError
+ example-api/Type/User.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE+    DeriveDataTypeable+  , DeriveGeneric+  , TemplateHaskell+  , TypeFamilies+  #-}+module Type.User where++import Data.Aeson+import Data.JSON.Schema+import Data.Text (Text)+import Data.Typeable+import GHC.Generics+import Generics.Regular+import Generics.Regular.XmlPickler+import Text.XML.HXT.Arrow.Pickle++type Name = Text+type Password = Text++data User = User+  { name     :: Name+  , password :: Password+  } deriving (Eq, Generic, Ord, Show, Typeable)++deriveAll ''User "PFUser"+type instance PF User = PFUser++instance XmlPickler User where xpickle = gxpickle+instance JSONSchema User where schema = gSchema+instance FromJSON   User+instance ToJSON     User+-- We might want to skip the ToJSON instance so we don't accidentally+-- serve passwords, but this type is accepted on signup which means a+-- haskell client needs to be able to serialize it.
+ example-api/Type/UserComment.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE+    DeriveDataTypeable+  , DeriveGeneric+  , TemplateHaskell+  , TypeFamilies+  #-}+module Type.UserComment where++import Data.Aeson+import Data.JSON.Schema+import Data.Text (Text)+import Data.Typeable+import GHC.Generics+import Generics.Regular+import Generics.Regular.XmlPickler+import Text.XML.HXT.Arrow.Pickle++import Type.User (User)++data UserComment = UserComment+  { user    :: User+  , comment :: Text+  } deriving (Eq, Generic, Ord, Show, Typeable)++deriveAll ''UserComment "PFUserComment"+type instance PF UserComment = PFUserComment++instance XmlPickler UserComment where xpickle = gxpickle+instance JSONSchema UserComment where schema = gSchema+instance FromJSON   UserComment+instance ToJSON     UserComment
+ example-api/Type/UserInfo.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE+    DeriveDataTypeable+  , DeriveGeneric+  , TemplateHaskell+  , TypeFamilies+  #-}+module Type.UserInfo where++import Data.Aeson+import Data.JSON.Schema+import Data.Typeable+import GHC.Generics+import Generics.Regular+import Generics.Regular.XmlPickler+import Text.XML.HXT.Arrow.Pickle++import qualified Type.User as User++data UserInfo = UserInfo+  { name :: User.Name+  } deriving (Generic, Show, Typeable)++deriveAll ''UserInfo "PFUserInfo"+type instance PF UserInfo = PFUserInfo++instance XmlPickler UserInfo where xpickle = gxpickle+instance JSONSchema UserInfo where schema = gSchema+instance ToJSON     UserInfo+instance FromJSON   UserInfo
+ example-api/Type/UserPost.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE+    DeriveDataTypeable+  , DeriveGeneric+  , TemplateHaskell+  , TypeFamilies+  #-}+module Type.UserPost where++import Data.Aeson+import Data.JSON.Schema+import Data.Typeable+import GHC.Generics+import Generics.Regular+import Generics.Regular.XmlPickler+import Text.XML.HXT.Arrow.Pickle++import Type.CreatePost (CreatePost)+import Type.User (User)++data UserPost = UserPost { user :: User, post :: CreatePost }+  deriving (Eq, Generic, Ord, Show, Typeable)++deriveAll ''UserPost "PFUserPost"+type instance PF UserPost = PFUserPost++instance XmlPickler UserPost where xpickle = gxpickle+instance JSONSchema UserPost where schema = gSchema+instance FromJSON   UserPost+instance ToJSON     UserPost
+ example-api/Type/UserSignupError.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE+    DeriveDataTypeable+  , DeriveGeneric+  , TemplateHaskell+  , TypeFamilies+  #-}+module Type.UserSignupError where++import Data.Aeson+import Data.JSON.Schema+import Data.Typeable+import GHC.Generics+import Generics.Regular+import Generics.Regular.XmlPickler+import Text.XML.HXT.Arrow.Pickle++data UserSignupError = InvalidPassword | InvalidUserName+  deriving (Eq, Generic, Ord, Show, Typeable)++deriveAll ''UserSignupError "PFUserSignupError"+type instance PF UserSignupError = PFUserSignupError++instance XmlPickler UserSignupError where xpickle = gxpickle+instance JSONSchema UserSignupError where schema = gSchema+instance FromJSON   UserSignupError+instance ToJSON     UserSignupError
+ generate/Main.hs view
@@ -0,0 +1,21 @@+module Main (main) where++import Rest.Gen.Types+import qualified Rest.Gen        as Gen+import qualified Rest.Gen.Config as Gen++import qualified Api++main :: IO ()+main = do+  config <- Gen.configFromArgs "rest-example-gen"+  Gen.generate+    config+    "RestExample"+    Api.api+    [] -- Additional modules to put in the generated cabal file+    [] -- Additional imports in every module, typically used for orphan instances+    -- rest-gen finds the originating module for each data type, when+    -- these are re-exported from an internal module they can be+    -- rewritten to something more stable.+    [(ModuleName "Data.Text.Internal", ModuleName "Data.Text")]
+ happstack/Main.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE OverloadedStrings #-}+module Main (main) where++import Control.Concurrent (forkIO, killThread)+import Control.Monad.Trans (liftIO)+import Happstack.Server.SimpleHTTP++import Rest.Driver.Happstack (apiToHandler')++import Api (api)+import ApiTypes (ServerData (..), runBlogApi)+import Example (exampleBlog)++-- | Run the server+main :: IO ()+main = do+  -- Set up the server state+  serverData <- exampleBlog++  -- Start happstack+  putStrLn "Starting happstack server on http://localhost:3000"+  tid <- forkIO $ simpleHTTP (Conf 3000 Nothing Nothing 60 Nothing) (handle serverData)++  -- Exit gracefully+  waitForTermination+  killThread tid++-- | Request handler+handle :: ServerData -> ServerPartT IO Response+handle serverData = apiToHandler' (liftIO . runBlogApi serverData) api+
+ rest-example.cabal view
@@ -0,0 +1,148 @@+name:                rest-example+version:             0.1.0.1+synopsis:            Example project for rest+homepage:            http://www.github.com/silkapp/rest+license:             BSD3+license-file:        LICENSE+author:              Silk B.V.+maintainer:          code@silk.co+copyright:           2014 Silk B.V.+category:            Web+build-type:          Simple+cabal-version:       >=1.10++extra-source-files:  LICENSE++library+  default-language:  Haskell2010+  ghc-options:       -Wall+  hs-source-dirs:    example-api+  exposed-modules:+    Api+    Api.Post+    Api.Post.Comment+    Api.User+    ApiTypes+    Example+    Type.Comment+    Type.CreatePost+    Type.Post+    Type.PostError+    Type.User+    Type.UserComment+    Type.UserInfo+    Type.UserPost+    Type.UserSignupError+  build-depends:+      base >= 4.6 && < 4.8+    , aeson >= 0.7 && < 0.9+    , containers >= 0.3 && < 0.6+    , filepath >= 1.1 && < 1.4+    , hxt == 9.3.*+    , json-schema == 0.6.*+    , monad-control == 0.3.*+    , mtl >= 2.0 && < 2.3+    , regular == 0.3.*+    , regular-xmlpickler == 0.2.*+    , rest-core >= 0.31 && < 0.33+    , rest-types == 1.10.*+    , safe >= 0.2 && < 0.4+    , transformers >= 0.2 && < 0.4+    , stm >= 2.1 && < 2.5+    , text >= 0.10 && < 1.2+    , time >= 1.1 && < 1.5+    , transformers-base == 0.4.*+    , unordered-containers == 0.2.*++-------------------------------------------------------------------------------+-- Executables linking against the rest-example library.++flag happstack+  description: Build the rest on happstack example.+  default:     False+  manual:      True++flag wai+  description: Build the rest on wai example.+  default:     False+  manual:      True++flag snap+  description: Build the rest on snap example.+  default:     False+  manual:      True++flag gen+  description: Build the rest on happstack example.+  default:     True+  manual:      True++executable rest-example-happstack+  default-language:  Haskell2010+  ghc-options:       -Wall+  main-is:           Main.hs+  hs-source-dirs:    happstack+  if flag(happstack)+    buildable: True+    build-depends:+        base >= 4.6 && < 4.8+      , happstack-server >= 7.1 && < 7.4+      , mtl >= 2.0 && < 2.3+      , rest-core >= 0.31 && < 0.33+      , rest-example+      , rest-happstack == 0.2.*+  else+    buildable: False++executable rest-example-wai+  default-language:  Haskell2010+  ghc-options:       -Wall+  main-is:           Main.hs+  hs-source-dirs:    wai+  if flag(wai)+    buildable: True+    build-depends:+        base >= 4.6 && < 4.8+      , mtl >= 2.0 && < 2.3+      , rest-core >= 0.31 && < 0.33+      , rest-example+      , rest-wai == 0.1.*+      , wai >= 2.1 && < 3.1+      , warp >= 2.1 && < 3.1+  else+    buildable: False++executable rest-example-snap+  default-language:  Haskell2010+  ghc-options:       -Wall+  main-is:           Main.hs+  hs-source-dirs:    snap+  if flag(snap)+    buildable: True+    build-depends:+        base >= 4.6 && < 4.8+      , mtl >= 2.0 && < 2.3+      , rest-core >= 0.31 && < 0.33+      , rest-example+      , rest-snap == 0.1.*+      , snap-core == 0.9.*+      , snap-server == 0.9.*+  else+    buildable: False++executable rest-example-gen+  default-language:  Haskell2010+  ghc-options:       -Wall+  main-is:           Main.hs+  hs-source-dirs:    generate+  if flag(gen)+    buildable: True+    build-depends:+        base >= 4.6 && < 4.8+      , mtl >= 2.0 && < 2.3+      , rest-core >= 0.31 && < 0.33+      , rest-example+      , rest-gen == 0.14.*+  else+    buildable: False+
+ snap/Main.hs view
@@ -0,0 +1,31 @@+module Main (main) where++import Control.Monad.Trans (liftIO)+import Snap.Http.Server+import Snap.Core++import Rest.Driver.Snap (apiToHandler')++import Api (api)+import ApiTypes (ServerData (..), runBlogApi)+import Example (exampleBlog)++-- | Run the server+main :: IO ()+main = do+  -- Set up the server state+  serverData <- exampleBlog++  -- Setup the Snap configuration.+  let cfg = setPort 3000+          . setAccessLog ConfigNoLog+          . setErrorLog  ConfigNoLog+          $ defaultConfig++  -- Start snap+  httpServe cfg (handle serverData)++-- | Request handler+handle :: ServerData -> Snap ()+handle serverData = apiToHandler' (liftIO . runBlogApi serverData) api+
+ wai/Main.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE OverloadedStrings #-}+module Main (main) where++import Network.Wai.Handler.Warp+import Rest.Driver.Wai (apiToApplication)++import Api (api)+import ApiTypes (runBlogApi)+import Example (exampleBlog)++main :: IO ()+main = do++  -- Set up the server state for the blog and start warp.+  putStrLn "Starting warp server on http://localhost:3000"+  serverData <- exampleBlog+  run 3000 $+    apiToApplication (runBlogApi serverData) api+