Add procfile

3 files changed, 21 insertions, 144 deletions

diff --git a/Procfile b/Procfile
new file mode 100644
index 0000000..4d2a4e1
--- /dev/null
+++ b/Procfile
@@ -0,0 +1 @@
+web: tomatobot-exe $PORT
diff --git a/app/Main.hs b/app/Main.hs
index 3f1dcf5..1b40313 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -23,6 +23,7 @@ import Network.HTTP.Types (status200, status500)
 import Network.Wai (responseBuilder, responseLBS, Response)
 import Network.Wai.Conduit (sourceRequestBody)
 import Network.Wai.Handler.Warp (run)
+import System.Environment (getArgs)
 
 import Data.Message (InMessage (..))
 import Data.Tomato (Tomato)
@@ -31,6 +32,7 @@ import Tomato.Validate (isTomato)
 
 import qualified Data.Aeson as Ae
 import qualified Data.ByteString.Lazy.Char8 as BL8
+import qualified RIO.List.Partial as L'
 
 
 data App = App
@@ -77,19 +79,24 @@ tomatoBot = do
   logInfo $ "All done"
 
 main :: IO ()
-main = run 3000 $ \request send -> do
-    eres <- tryAnyDeep $ do
-      val <- runConduit
-           $ sourceRequestBody request
-          .| sinkParser Ae.json
-      case Ae.fromJSON val of
-          Ae.Success r -> return r
-          Ae.Error _s  -> error "handle this later"
-    case eres of
-      Left e -> send $ errorResponse e
-      Right inMes -> do
-          when (isTomato inMes) $ runApp tomatoBot
-          send $ validResponse inMes
+main = do
+    args <- getArgs
+    when (null args) (error "no port")
+    let portS = readMaybe $ L'.head args
+    let port = maybe (error "invalid port") id portS
+    run port $ \request send -> do
+        eres <- tryAnyDeep $ do
+          val <- runConduit
+               $ sourceRequestBody request
+              .| sinkParser Ae.json
+          case Ae.fromJSON val of
+              Ae.Success r -> return r
+              Ae.Error _s  -> error "handle this later"
+        case eres of
+          Left e -> send $ errorResponse e
+          Right inMes -> do
+              when (isTomato inMes) $ runApp tomatoBot
+              send $ validResponse inMes
   where
     errorResponse :: SomeException -> Response
     errorResponse e = responseLBS
diff --git a/tomatobot.cabal b/tomatobot.cabal
deleted file mode 100644
index f4202d1..0000000
--- a/tomatobot.cabal
+++ /dev/null
@@ -1,131 +0,0 @@
-cabal-version: 1.12
-
--- This file has been generated from package.yaml by hpack version 0.34.4.
---
--- see: https://github.com/sol/hpack
-
-name:           tomatobot
-version:        0.1.0.0
-description:    Please see the README on GitHub at <https://github.com/githubuser/tomatobot#readme>
-homepage:       https://github.com/githubuser/tomatobot#readme
-bug-reports:    https://github.com/githubuser/tomatobot/issues
-author:         Author name here
-maintainer:     example@example.com
-copyright:      2022 Author name here
-license:        BSD3
-build-type:     Simple
-extra-source-files:
-    README.md
-
-source-repository head
-  type: git
-  location: https://github.com/githubuser/tomatobot
-
-library
-  exposed-modules:
-      Data.Message
-      Data.Tomato
-      Tomato.Post
-      Tomato.Validate
-  other-modules:
-      Paths_tomatobot
-  hs-source-dirs:
-      src
-  default-extensions:
-      ApplicativeDo
-      BangPatterns
-      ConstraintKinds
-      DataKinds
-      EmptyCase
-      ExistentialQuantification
-      FlexibleContexts
-      FlexibleInstances
-      GADTs
-      GeneralizedNewtypeDeriving
-      InstanceSigs
-      KindSignatures
-      LambdaCase
-      MultiParamTypeClasses
-      NoImplicitPrelude
-      NoStarIsType
-      OverloadedStrings
-      PatternSynonyms
-      PolyKinds
-      RankNTypes
-      ScopedTypeVariables
-      StandaloneDeriving
-      StandaloneKindSignatures
-      TupleSections
-      TypeApplications
-      TypeFamilies
-      TypeFamilyDependencies
-      TypeOperators
-  ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wredundant-constraints -Wmissing-local-signatures -Wmissing-export-lists -Wpartial-fields -Wmonomorphism-restriction -Widentities -Wno-unticked-promoted-constructors -fprint-expanded-synonyms
-  build-depends:
-      aeson
-    , base >=4.7 && <5
-    , bytestring
-    , conduit
-    , conduit-extra
-    , http-types
-    , modern-uri
-    , req
-    , rio
-    , unliftio
-    , wai
-    , wai-conduit
-    , warp
-  default-language: Haskell2010
-
-executable tomatobot-exe
-  main-is: Main.hs
-  other-modules:
-      Paths_tomatobot
-  hs-source-dirs:
-      app
-  default-extensions:
-      ApplicativeDo
-      BangPatterns
-      ConstraintKinds
-      DataKinds
-      EmptyCase
-      ExistentialQuantification
-      FlexibleContexts
-      FlexibleInstances
-      GADTs
-      GeneralizedNewtypeDeriving
-      InstanceSigs
-      KindSignatures
-      LambdaCase
-      MultiParamTypeClasses
-      NoImplicitPrelude
-      NoStarIsType
-      OverloadedStrings
-      PatternSynonyms
-      PolyKinds
-      RankNTypes
-      ScopedTypeVariables
-      StandaloneDeriving
-      StandaloneKindSignatures
-      TupleSections
-      TypeApplications
-      TypeFamilies
-      TypeFamilyDependencies
-      TypeOperators
-  ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wredundant-constraints -Wmissing-local-signatures -Wmissing-export-lists -Wpartial-fields -Wmonomorphism-restriction -Widentities -Wno-unticked-promoted-constructors -fprint-expanded-synonyms -threaded -rtsopts -with-rtsopts=-N
-  build-depends:
-      aeson
-    , base >=4.7 && <5
-    , bytestring
-    , conduit
-    , conduit-extra
-    , http-types
-    , modern-uri
-    , req
-    , rio
-    , tomatobot
-    , unliftio
-    , wai
-    , wai-conduit
-    , warp
-  default-language: Haskell2010