diff --git a/app/Main.hs b/app/ffi/Main.hs similarity index 100% rename from app/Main.hs rename to app/ffi/Main.hs diff --git a/app/service/Main.hs b/app/service/Main.hs new file mode 100644 index 0000000..b8d6b1d --- /dev/null +++ b/app/service/Main.hs @@ -0,0 +1,6 @@ +module Main where + +import Demo as Demo + +main :: IO () +main = Demo.runDemoApp diff --git a/default.nix b/default.nix index 77c1812..fbac792 100644 --- a/default.nix +++ b/default.nix @@ -1,14 +1,26 @@ -{ mkDerivation, base, hpack, stdenv }: +{ mkDerivation, base, data-default-class, hpack, http-types +, iproute, monad-logger, mtl, network, safe-exceptions, stdenv +, transformers, wai, warp +}: mkDerivation { pname = "haskell-demo"; version = "0.1.0.0"; src = ./.; isLibrary = true; isExecutable = true; - libraryHaskellDepends = [ base ]; + libraryHaskellDepends = [ + base data-default-class http-types iproute monad-logger mtl network + safe-exceptions transformers wai warp + ]; libraryToolDepends = [ hpack ]; - executableHaskellDepends = [ base ]; - testHaskellDepends = [ base ]; + executableHaskellDepends = [ + base data-default-class http-types iproute monad-logger mtl network + safe-exceptions transformers wai warp + ]; + testHaskellDepends = [ + base data-default-class http-types iproute monad-logger mtl network + safe-exceptions transformers wai warp + ]; prePatch = "hpack"; homepage = "https://github.com/MatrixAI/Haskell-Demo#readme"; license = stdenv.lib.licenses.asl20; diff --git a/package.yaml b/package.yaml index 9aadd06..a4f3f09 100644 --- a/package.yaml +++ b/package.yaml @@ -14,6 +14,16 @@ description: Please see the README on Github at = 4.7 && < 5 +- transformers +- mtl +- monad-logger +- safe-exceptions +- network +- iproute +- wai +- warp +- http-types +- data-default-class library: source-dirs: src @@ -28,11 +38,21 @@ library: exposed-modules: - Lib - FFI + - Demo executables: - haskell-demo-exe: + haskell-demo-ffi-exe: main: Main.hs - source-dirs: app + source-dirs: app/ffi + ghc-options: + - -threaded + - -rtsopts + - -with-rtsopts=-N + dependencies: + - haskell-demo + haskell-demo-service-exe: + main: Main.hs + source-dirs: app/service ghc-options: - -threaded - -rtsopts diff --git a/src/Demo.hs b/src/Demo.hs new file mode 100644 index 0000000..5f7f556 --- /dev/null +++ b/src/Demo.hs @@ -0,0 +1,102 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} + +module Demo where + +import Control.Exception.Safe as E +import Control.Exception.Safe ( MonadCatch + , MonadMask + , MonadThrow + ) +import Control.Monad.IO.Class ( MonadIO + , liftIO + ) +import Control.Monad.Logger as L +import Control.Monad.Logger ( LoggingT + , MonadLogger + ) +import Control.Monad.Reader ( MonadReader + , ReaderT + , ask + , runReaderT + ) +import Control.Monad.Trans.Class ( MonadTrans + , lift + ) +import Data.Default.Class ( Default + , def + ) +import Data.IP ( IP ) +import Data.String ( fromString ) +import Network.HTTP.Types as HTTP +import Network.HTTP.Types.Header as HTTPHeaders +import Network.Socket ( PortNumber ) +import Network.Wai ( Application ) +import Network.Wai as Wai +import Network.Wai.Handler.Warp as Warp +import System.Environment ( lookupEnv ) + + +data DemoEnv = DemoEnv { demoEnvHost :: IP, + demoEnvPort :: PortNumber + } deriving (Show) + +-- this is the default demoenv +instance Default DemoEnv where + def = DemoEnv "127.0.0.1" 55555 + +newtype DemoT m a = DemoT + { runDemoT :: ReaderT DemoEnv (LoggingT m) a } + deriving ( + Functor, + Applicative, + Monad, + MonadIO, + MonadThrow, + MonadCatch, + MonadLogger, + MonadReader DemoEnv + ) + +type Demo = DemoT IO + +runDemo :: DemoEnv -> Demo a -> IO a +runDemo env demo = do + runStderrLoggingT $ runReaderT (runDemoT demo) env + +warpApp :: Application +warpApp req respond = E.bracket_ + (runStderrLoggingT ($(L.logInfo) "Try IO Block")) + (runStderrLoggingT ($(L.logInfo) "Clean IO Block")) + (respond $ Wai.responseLBS HTTP.status200 + [(HTTPHeaders.hContentType, "text/plain")] + "Hello from Demo!\n" + ) + +demoApp :: Demo () +demoApp = do + $(L.logInfo) "Starting Demo Server" + DemoEnv ip port <- ask + let settings = + Warp.setHost (fromString $ show ip) + $ Warp.setPort (fromIntegral port) + $ Warp.defaultSettings + $(L.logInfo) $ fromString $ "Running on " ++ show ip ++ ":" ++ show port + liftIO $ Warp.runSettings settings warpApp + $(L.logInfo) "Terminated Demo Server" + +runDemoApp :: IO () +runDemoApp = do + demoHost <- lookupEnv "DEMO_HOST" + demoPort <- lookupEnv "DEMO_PORT" + let defaultEnv = def :: DemoEnv + defaultEnv <- return $ maybe + defaultEnv + (\host -> defaultEnv { demoEnvHost = read host }) + demoHost + defaultEnv <- return $ maybe + defaultEnv + (\port -> defaultEnv { demoEnvPort = read port }) + demoPort + runDemo defaultEnv demoApp