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

View File

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

View File

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

View File

@ -8,7 +8,6 @@ import Bot.DSL
import Control.Monad.Catch (MonadCatch, MonadThrow)
import Control.Monad.Logger
import Control.Monad.Trans (MonadIO, liftIO)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Time as Time
@ -23,7 +22,7 @@ instance MonadNetwork AppM where
putMsg Response{..} = liftIO . T.putStrLn $ content
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
instance MonadTime AppM where

View File

@ -1,9 +1,9 @@
{-# Language Safe #-}
{-# Language RankNTypes #-}
{-# Language GADTs #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE Safe #-}
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))
, name :: String }

View File

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

View File

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

View File

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