This commit is contained in:
Mats Rauhala 2018-12-23 23:52:19 +02:00
parent 092bde3987
commit 2d1098c1cd
8 changed files with 20 additions and 19 deletions

View File

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

View File

@ -34,10 +34,13 @@ library
, exceptions , exceptions
hs-source-dirs: src hs-source-dirs: src
default-language: Haskell2010 default-language: Haskell2010
ghc-options: -Wall
executable demobot executable demobot
main-is: Main.hs main-is: Main.hs
other-modules: Extensions other-modules: Extensions
, Extension.Hello
, AppM
-- other-extensions: -- other-extensions:
build-depends: base >=4.11 && <4.12 build-depends: base >=4.11 && <4.12
, demobot , demobot
@ -49,3 +52,4 @@ executable demobot
, exceptions , exceptions
hs-source-dirs: src hs-source-dirs: src
default-language: Haskell2010 default-language: Haskell2010
ghc-options: -Wall

View File

@ -9,6 +9,7 @@ let
ghcid ghcid
cabal-install cabal-install
hasktags hasktags
hlint
(ghcWithPackages (_: demobot.buildInputs ++ demobot.propagatedBuildInputs)) (ghcWithPackages (_: demobot.buildInputs ++ demobot.propagatedBuildInputs))
nixpkgs.binutils-unwrapped nixpkgs.binutils-unwrapped
]; ];

View File

@ -8,7 +8,6 @@ import Bot.DSL
import Control.Monad.Catch (MonadCatch, MonadThrow) import Control.Monad.Catch (MonadCatch, MonadThrow)
import Control.Monad.Logger import Control.Monad.Logger
import Control.Monad.Trans (MonadIO, liftIO) import Control.Monad.Trans (MonadIO, liftIO)
import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.IO as T import qualified Data.Text.IO as T
import qualified Data.Time as Time import qualified Data.Time as Time
@ -23,7 +22,7 @@ instance MonadNetwork AppM where
putMsg Response{..} = liftIO . T.putStrLn $ content putMsg Response{..} = liftIO . T.putStrLn $ content
instance MonadData AppM where instance MonadData AppM where
putData key val = liftIO $ T.putStrLn $ "Would put " <> T.pack key <> " = " <> (T.pack $ show val) putData key val = liftIO $ T.putStrLn $ "Would put " <> T.pack key <> " = " <> T.pack (show val)
getData key = liftIO (T.putStrLn $ "Would fetch " <> T.pack key) >> return Nothing getData key = liftIO (T.putStrLn $ "Would fetch " <> T.pack key) >> return Nothing
instance MonadTime AppM where instance MonadTime AppM where

View File

@ -1,9 +1,9 @@
{-# Language Safe #-} {-# LANGUAGE GADTs #-}
{-# Language RankNTypes #-} {-# LANGUAGE RankNTypes #-}
{-# Language GADTs #-} {-# LANGUAGE Safe #-}
module Bot.Extension where module Bot.Extension where
import Bot.DSL import Bot.DSL
data Extension meta = Extension { act :: forall m. (meta ~ Meta m, MonadExtension m) => Request meta -> m (Maybe (Response meta)) data Extension meta = Extension { act :: forall m. (meta ~ Meta m, MonadExtension m) => Request meta -> m (Maybe (Response meta))
, name :: String } , name :: String }

View File

@ -1,7 +1,6 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Safe #-} {-# LANGUAGE Safe #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
module Bot.Lib where module Bot.Lib where
@ -9,10 +8,9 @@ import Bot.DSL
import Bot.Extension import Bot.Extension
import Bot.Log import Bot.Log
import Control.Monad (forever) import Control.Monad (forever)
import Control.Monad.Catch (MonadCatch, SomeException, catch, try) import Control.Monad.Catch (MonadCatch, SomeException, catch)
import Data.Maybe (catMaybes) import Data.Maybe (catMaybes)
import qualified Data.Text as T import qualified Data.Text as T
import GHC.Stack
tshow :: Show a => a -> T.Text tshow :: Show a => a -> T.Text
tshow = T.pack . show tshow = T.pack . show
@ -25,5 +23,5 @@ mainLoop extensions = forever $ catch go handleFail
go :: m () go :: m ()
go = do go = do
msg <- recvMsg msg <- recvMsg
responses <- catMaybes <$> mapM (\ext -> (act ext) msg) extensions responses <- catMaybes <$> mapM (`act` msg) extensions
mapM_ putMsg responses mapM_ putMsg responses

View File

@ -1,11 +1,11 @@
{-# Language RecordWildCards #-} {-# LANGUAGE OverloadedStrings #-}
{-# Language OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}
{-# Language ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
module Extension.Hello where module Extension.Hello where
import Bot.Extension import Bot.DSL
import Bot.DSL import Bot.Extension
import qualified Data.Text as T import qualified Data.Text as T
extension :: Extension () extension :: Extension ()
extension = Extension{..} extension = Extension{..}

View File

@ -2,7 +2,6 @@
module Extensions where module Extensions where
import Bot.DSL
import Bot.Extension import Bot.Extension
import qualified Extension.Hello as Hello import qualified Extension.Hello as Hello