Cleanup
This commit is contained in:
parent
092bde3987
commit
2d1098c1cd
2
Setup.hs
2
Setup.hs
@ -1,2 +1,2 @@
|
|||||||
import Distribution.Simple
|
import Distribution.Simple
|
||||||
main = defaultMain
|
main = defaultMain
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
];
|
];
|
||||||
|
@ -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
|
||||||
|
@ -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 }
|
||||||
|
@ -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
|
||||||
|
@ -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{..}
|
||||||
|
@ -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
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user