Commits

dp wiz committed 116e263

split code to library/server/generator

  • Participants
  • Parent commits 7ddcd5d

Comments (0)

Files changed (7)

File rest-zero.cabal

 -- extra-source-files:  
 cabal-version:       >=1.10
 
+library
+  default-language:    Haskell2010
+  ghc-options:         -Wall -fno-warn-orphans
+  hs-source-dirs:      src/lib
+  exposed-modules:
+    Api
+    Api.Post
+  build-depends:       base >=4.6 && <5
+                     , mtl
+                     , rest-core
+                     , aeson
+                     , json-schema
+
 executable rest-zero
   default-language:    Haskell2010
   main-is:             Main.hs
   ghc-options:         -Wall -O2 -threaded
-  build-depends:       base >=4.7 && <4.8
-                     , mtl
+  hs-source-dirs:      src/server
+  build-depends:       base >=4.6 && <5
+                     , rest-zero
                      , rest-core
                      , rest-wai
                      , warp
-                     , aeson
-                     , json-schema
-  hs-source-dirs:      src/

File src/Api.hs

-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-module Api where
-
-import Control.Applicative
-import Control.Monad.Reader
-import Control.Monad.Trans (MonadIO)
-
--- * App-specific things
-
-data Env = Env { envSomething :: () }
-
-setupEnv :: IO Env
-setupEnv = Env <$> pure ()
-
--- * Generic things
-
-newtype ApiEnv a = ApiEnv { unApiEnv :: ReaderT Env IO a }
-  deriving ( Functor
-           , Applicative
-           , Monad
-           , MonadIO
-           , MonadReader Env
-           )
-
-runApiEnv :: Env -> ApiEnv a -> IO a
-runApiEnv env = flip runReaderT env . unApiEnv
-
---env :: (Env -> a) -> ApiEnv a
---env = lift . asks

File src/Api/Post.hs

-
-{-# LANGUAGE
-    DeriveDataTypeable
-  , DeriveGeneric
-  #-}
-module Api.Post (resource) where
-
-import Rest
-import qualified Rest.Resource as R
-
-import Data.Aeson
-import Data.JSON.Schema
-import Data.Typeable
-import GHC.Generics
-
-import Control.Monad.Reader
-
-import Api
-
-type Title = String
-
-resource :: Resource ApiEnv (ReaderT Title ApiEnv) Title () Void
-resource = mkResourceReader
-    { R.name   = "post"
-    , R.schema = withListing () $ named [("title", singleBy id)]
-    , R.list   = const list
-    , R.get    = Just get
-    }
-
-data Post = Post { title :: Title, content :: String } deriving (Generic, Typeable)
-
-instance ToJSON Post
-instance FromJSON Post
-instance JSONSchema Post where schema = gSchema
-
-get :: Handler (ReaderT Title ApiEnv)
-get = mkIdHandler (jsonO . someO) getter
-
---getter :: () -> Title -> (ReaderT Title ApiEnv) Post
-getter _ title = lift (evenGetter title)
-
-evenGetter :: Title -> (ReaderT Title ApiEnv) Post
-evenGetter title = lift $ do
-    something <- asks envSomething
-    liftIO $ print (something, title)
-    return $ Post title "some content"
-
-list :: ListHandler ApiEnv
-list = mkListing (jsonO . someO) $ \range -> lift $ readPosts (count range) (offset range)
-
-readPosts :: Int -> Int -> ApiEnv [Post]
-readPosts a b = do
-    liftIO $ print (a, b)
-    return [ Post "some-title" "some content"
-           , Post "other-title" "other content"
-           , Post "more-title" "more content"
-           ]

File src/Main.hs

-module Main where
-
-import Rest.Api
-import Rest.Driver.Wai
-import Network.Wai.Handler.Warp (run)
-
-import Api
-import qualified Api.Post as Post
-
-blog :: Router ApiEnv ApiEnv
-blog = root -/ post
-    where
-        post = route Post.resource
-
-api :: Api ApiEnv
-api = [(mkVersion 1 0 0, Some1 blog)]
-
-main :: IO ()
-main = do
-    env <- setupEnv
-    putStrLn "Take a look: http://localhost:3000/1.0/post"
-    run 3000 $ apiToApplication (runApiEnv env) api

File src/lib/Api.hs

+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+module Api where
+
+import Control.Applicative
+import Control.Monad.Reader
+import Control.Monad.Trans (MonadIO)
+
+-- * App-specific things
+
+data Env = Env { envSomething :: () }
+
+setupEnv :: IO Env
+setupEnv = Env <$> pure ()
+
+-- * Generic things
+
+newtype ApiEnv a = ApiEnv { unApiEnv :: ReaderT Env IO a }
+  deriving ( Functor
+           , Applicative
+           , Monad
+           , MonadIO
+           , MonadReader Env
+           )
+
+runApiEnv :: Env -> ApiEnv a -> IO a
+runApiEnv env = flip runReaderT env . unApiEnv
+
+--env :: (Env -> a) -> ApiEnv a
+--env = lift . asks

File src/lib/Api/Post.hs

+
+{-# LANGUAGE
+    DeriveDataTypeable
+  , DeriveGeneric
+  #-}
+module Api.Post (resource) where
+
+import Rest
+import qualified Rest.Resource as R
+
+import Data.Aeson
+import Data.JSON.Schema
+import Data.Typeable
+import GHC.Generics
+
+import Control.Monad.Reader
+
+import Api
+
+type Title = String
+
+resource :: Resource ApiEnv (ReaderT Title ApiEnv) Title () Void
+resource = mkResourceReader
+    { R.name   = "post"
+    , R.schema = withListing () $ named [("title", singleBy id)]
+    , R.list   = const list
+    , R.get    = Just get
+    }
+
+data Post = Post { title :: Title, content :: String } deriving (Generic, Typeable)
+
+instance ToJSON Post
+instance FromJSON Post
+instance JSONSchema Post where schema = gSchema
+
+get :: Handler (ReaderT Title ApiEnv)
+get = mkIdHandler (jsonO . someO) getter
+
+--getter :: () -> Title -> (ReaderT Title ApiEnv) Post
+getter _ title = lift (evenGetter title)
+
+evenGetter :: Title -> (ReaderT Title ApiEnv) Post
+evenGetter title = lift $ do
+    something <- asks envSomething
+    liftIO $ print (something, title)
+    return $ Post title "some content"
+
+list :: ListHandler ApiEnv
+list = mkListing (jsonO . someO) $ \range -> lift $ readPosts (count range) (offset range)
+
+readPosts :: Int -> Int -> ApiEnv [Post]
+readPosts a b = do
+    liftIO $ print (a, b)
+    return [ Post "some-title" "some content"
+           , Post "other-title" "other content"
+           , Post "more-title" "more content"
+           ]

File src/server/Main.hs

+module Main where
+
+import Rest.Api
+import Rest.Driver.Wai
+import Network.Wai.Handler.Warp (run)
+
+import Api
+import qualified Api.Post as Post
+
+blog :: Router ApiEnv ApiEnv
+blog = root -/ post
+    where
+        post = route Post.resource
+
+api :: Api ApiEnv
+api = [(mkVersion 1 0 0, Some1 blog)]
+
+main :: IO ()
+main = do
+    env <- setupEnv
+    putStrLn "Take a look: http://localhost:3000/1.0/post"
+    run 3000 $ apiToApplication (runApiEnv env) api