funbot (empty) → 0.1.0.0
raw patch · 23 files changed
+2231/−0 lines, 23 filesdep +HTTPdep +aesondep +basesetup-changed
Dependencies added: HTTP, aeson, base, bytestring, feed, feed-collect, http-listen, irc-fun-bot, irc-fun-color, network-uri, settings, text, time, time-interval, time-units, transformers, unordered-containers, vcs-web-hook-parse
Files
- AUTHORS +3/−0
- COPYING +121/−0
- ChangeLog +6/−0
- INSTALL +13/−0
- NEWS +23/−0
- README.md +58/−0
- Setup.hs +2/−0
- funbot.cabal +74/−0
- src/FunBot/Commands.hs +223/−0
- src/FunBot/Config.hs +48/−0
- src/FunBot/ExtHandlers.hs +160/−0
- src/FunBot/IrcHandlers.hs +58/−0
- src/FunBot/Memos.hs +294/−0
- src/FunBot/Settings.hs +383/−0
- src/FunBot/Sources.hs +23/−0
- src/FunBot/Sources/FeedWatcher.hs +58/−0
- src/FunBot/Sources/WebListener.hs +42/−0
- src/FunBot/Sources/WebListener/Client.hs +172/−0
- src/FunBot/Sources/WebListener/GitLab.hs +93/−0
- src/FunBot/Sources/WebListener/Gogs.hs +56/−0
- src/FunBot/Types.hs +192/−0
- src/FunBot/Util.hs +40/−0
- src/Main.hs +89/−0
+ AUTHORS view
@@ -0,0 +1,3 @@+The Freepost community <https://freepo.st>. Specifically, the following people:++fr33domlover <fr33domlover@rel4tion.org>
+ COPYING view
@@ -0,0 +1,121 @@+Creative Commons Legal Code++CC0 1.0 Universal++ CREATIVE COMMONS CORPORATION IS NOT A LAW FIRM AND DOES NOT PROVIDE+ LEGAL SERVICES. DISTRIBUTION OF THIS DOCUMENT DOES NOT CREATE AN+ ATTORNEY-CLIENT RELATIONSHIP. CREATIVE COMMONS PROVIDES THIS+ INFORMATION ON AN "AS-IS" BASIS. CREATIVE COMMONS MAKES NO WARRANTIES+ REGARDING THE USE OF THIS DOCUMENT OR THE INFORMATION OR WORKS+ PROVIDED HEREUNDER, AND DISCLAIMS LIABILITY FOR DAMAGES RESULTING FROM+ THE USE OF THIS DOCUMENT OR THE INFORMATION OR WORKS PROVIDED+ HEREUNDER.++Statement of Purpose++The laws of most jurisdictions throughout the world automatically confer+exclusive Copyright and Related Rights (defined below) upon the creator+and subsequent owner(s) (each and all, an "owner") of an original work of+authorship and/or a database (each, a "Work").++Certain owners wish to permanently relinquish those rights to a Work for+the purpose of contributing to a commons of creative, cultural and+scientific works ("Commons") that the public can reliably and without fear+of later claims of infringement build upon, modify, incorporate in other+works, reuse and redistribute as freely as possible in any form whatsoever+and for any purposes, including without limitation commercial purposes.+These owners may contribute to the Commons to promote the ideal of a free+culture and the further production of creative, cultural and scientific+works, or to gain reputation or greater distribution for their Work in+part through the use and efforts of others.++For these and/or other purposes and motivations, and without any+expectation of additional consideration or compensation, the person+associating CC0 with a Work (the "Affirmer"), to the extent that he or she+is an owner of Copyright and Related Rights in the Work, voluntarily+elects to apply CC0 to the Work and publicly distribute the Work under its+terms, with knowledge of his or her Copyright and Related Rights in the+Work and the meaning and intended legal effect of CC0 on those rights.++1. Copyright and Related Rights. A Work made available under CC0 may be+protected by copyright and related or neighboring rights ("Copyright and+Related Rights"). Copyright and Related Rights include, but are not+limited to, the following:++ i. the right to reproduce, adapt, distribute, perform, display,+ communicate, and translate a Work;+ ii. moral rights retained by the original author(s) and/or performer(s);+iii. publicity and privacy rights pertaining to a person's image or+ likeness depicted in a Work;+ iv. rights protecting against unfair competition in regards to a Work,+ subject to the limitations in paragraph 4(a), below;+ v. rights protecting the extraction, dissemination, use and reuse of data+ in a Work;+ vi. database rights (such as those arising under Directive 96/9/EC of the+ European Parliament and of the Council of 11 March 1996 on the legal+ protection of databases, and under any national implementation+ thereof, including any amended or successor version of such+ directive); and+vii. other similar, equivalent or corresponding rights throughout the+ world based on applicable law or treaty, and any national+ implementations thereof.++2. Waiver. To the greatest extent permitted by, but not in contravention+of, applicable law, Affirmer hereby overtly, fully, permanently,+irrevocably and unconditionally waives, abandons, and surrenders all of+Affirmer's Copyright and Related Rights and associated claims and causes+of action, whether now known or unknown (including existing as well as+future claims and causes of action), in the Work (i) in all territories+worldwide, (ii) for the maximum duration provided by applicable law or+treaty (including future time extensions), (iii) in any current or future+medium and for any number of copies, and (iv) for any purpose whatsoever,+including without limitation commercial, advertising or promotional+purposes (the "Waiver"). Affirmer makes the Waiver for the benefit of each+member of the public at large and to the detriment of Affirmer's heirs and+successors, fully intending that such Waiver shall not be subject to+revocation, rescission, cancellation, termination, or any other legal or+equitable action to disrupt the quiet enjoyment of the Work by the public+as contemplated by Affirmer's express Statement of Purpose.++3. Public License Fallback. Should any part of the Waiver for any reason+be judged legally invalid or ineffective under applicable law, then the+Waiver shall be preserved to the maximum extent permitted taking into+account Affirmer's express Statement of Purpose. In addition, to the+extent the Waiver is so judged Affirmer hereby grants to each affected+person a royalty-free, non transferable, non sublicensable, non exclusive,+irrevocable and unconditional license to exercise Affirmer's Copyright and+Related Rights in the Work (i) in all territories worldwide, (ii) for the+maximum duration provided by applicable law or treaty (including future+time extensions), (iii) in any current or future medium and for any number+of copies, and (iv) for any purpose whatsoever, including without+limitation commercial, advertising or promotional purposes (the+"License"). The License shall be deemed effective as of the date CC0 was+applied by Affirmer to the Work. Should any part of the License for any+reason be judged legally invalid or ineffective under applicable law, such+partial invalidity or ineffectiveness shall not invalidate the remainder+of the License, and in such case Affirmer hereby affirms that he or she+will not (i) exercise any of his or her remaining Copyright and Related+Rights in the Work or (ii) assert any associated claims and causes of+action with respect to the Work, in either case contrary to Affirmer's+express Statement of Purpose.++4. Limitations and Disclaimers.++ a. No trademark or patent rights held by Affirmer are waived, abandoned,+ surrendered, licensed or otherwise affected by this document.+ b. Affirmer offers the Work as-is and makes no representations or+ warranties of any kind concerning the Work, express, implied,+ statutory or otherwise, including without limitation warranties of+ title, merchantability, fitness for a particular purpose, non+ infringement, or the absence of latent or other defects, accuracy, or+ the present or absence of errors, whether or not discoverable, all to+ the greatest extent permissible under applicable law.+ c. Affirmer disclaims responsibility for clearing rights of other persons+ that may apply to the Work or any use thereof, including without+ limitation any person's Copyright and Related Rights in the Work.+ Further, Affirmer disclaims responsibility for obtaining any necessary+ consents, permissions or other rights required for any use of the+ Work.+ d. Affirmer understands and acknowledges that Creative Commons is not a+ party to this document and has no duty or obligation with respect to+ this CC0 or use of the Work.
+ ChangeLog view
@@ -0,0 +1,6 @@+If you have a local clone of the repository, you can see a detailed list of+changes using:++ $ git log++There is also a web interface in NotABug which can display commit history.
+ INSTALL view
@@ -0,0 +1,13 @@+Install from Hackage:++ $ cabal install funbot++Install from unpacked release tarball or source repo:++ $ cd funbot+ $ cabal install++Just play with it without installing:++ $ cabal build+ $ cabal repl
+ NEWS view
@@ -0,0 +1,23 @@+This file lists the user-visible interesting changes between releases. For a+full list of changes to the source, see the ChangeLog.++++funbot 0.1.0.0 -- 0.1.0.0+=========================++General, build and documentation changes:++* (This is the first release, so everything is new)++New APIs, features and enhancements:++* (This is the first release, so everything is a new feature)++Bug fixes:++* (This is just the first release)++Dependency changes:++* (This is the first release)
+ README.md view
@@ -0,0 +1,58 @@+# funbot++An IRC bot for learning, fun and collaboration in the Freepost community.+There is a project page [here][proj].++## Using++See the .cabal file for more info and link to project website and version+control.++The official download location is the Git repository:++<https://notabug.org/fr33domlover/funbot.git>++Occasionally, releases may be made to Hackage, the Haskell package repository.+See <http://hackage.haskell.org/package/funbot>.++Some of the dependency libraries may have recent features not released to+Hackage yet. See the guide linked at the bottom for their clone URLs. If you+use a released version of funbot, you can safely install all the dependencies+from Hackage as usual.++This program is free software, and is committed to software freedom. It is+released to the public domain using the CC0 Public Domain Dedication. For the+boring "legal" details see the file 'COPYING'.++See the file 'INSTALL' for hints on installation. The file 'ChangeLog' explains+how to see the history log of the changes done in the code. 'NEWS' provides a+friendly overview of the changes for each release.++## Reporting Bugs and Suggesting Features++If you found a bug, or you have an idea, a feature request or a wishlist item,+open a ticket for it! Even if you're goint to implement something or try to+solve it.++This project uses [Rel4tion][rel4tion]'s [ticket system][rel4tkt]. See the+[project page][proj] for details.++You *can* open an issue in NotABug if you prefer, and it will then be moved to+Rel4tion's ticket system. But it is generally preferred you use that system+directly.++## User/Contributor Guide++There is a detailed guide for running the bot and creating a development setup.+It's [here][guide]. If anything happens and it's unavailable, there is a+(maybe lagging 1-2 hours behind) mirror of the guide source [here][mirror].++If you're going to implement some feature or fix some bug you found,+**start by opening a ticket** so that other people will know which features are+being developed and who does what.++[proj]: http://rel4tion.org/projects/funbot/+[rel4tion]: http://rel4tion.org/+[rel4tkt]: http://rel4tion.org/tickets/+[guide]: http://rel4tion.org/projects/funbot/guide/+[mirror]: https://notabug.org/fr33domlover/Rel4tion-Wiki/src/master/projects/funbot.mdwn
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ funbot.cabal view
@@ -0,0 +1,74 @@+name: funbot+version: 0.1.0.0+synopsis: IRC bot for fun, learning, creativity and collaboration.+description:+ One day an idea came up on the #freepost IRC channel: We didn't need much of+ the serious features IRC bots provide, but we could develop an IRC bot+ collaboratively, for fun and for learning new skills and languages! I also+ thought this is a great chance for people to quickly see their code in real+ use, which is motivating when learning programming, and it's a chance to+ introduce Haskell to the community.+ .+ While the bot is made for and by the <https://freepo.st Freepost> community,+ it is fully intended for use any anyone else! For experienced Haskell+ developers, this bot can perhaps provide space for creativity and custom+ advanced plugins and features.+ .+ Since this bot is meant for collaborative development while really running+ it, the running instance in @#freepost@ is built from the git repository.+ Occasionally releases will be made to Hackage. If you want to be sure you+ have all the latest features, check out the git repository (and/or ask us to+ make a release if you think it's been long enough).+homepage: https://notabug.org/fr33domlover/funbot/+bug-reports: https://notabug.org/fr33domlover/funbot/issues/+license: PublicDomain+license-file: COPYING+author: The Freepost community, see AUTHORS file+maintainer: fr33domlover@riseup.net+copyright: ♡ Copying is an act of love. Please copy, reuse and share.+category: Network+build-type: Simple+extra-source-files: AUTHORS ChangeLog COPYING INSTALL NEWS README.md+cabal-version: >=1.10++source-repository head+ type: git+ location: https://notabug.org/fr33domlover/funbot.git++executable funbot+ main-is: Main.hs+ other-modules: FunBot.Commands+ , FunBot.Config+ , FunBot.ExtHandlers+ , FunBot.IrcHandlers+ , FunBot.Memos+ , FunBot.Settings+ , FunBot.Sources+ , FunBot.Sources.FeedWatcher+ , FunBot.Sources.WebListener+ , FunBot.Sources.WebListener.Client+ , FunBot.Sources.WebListener.Gogs+ , FunBot.Sources.WebListener.GitLab+ , FunBot.Types+ , FunBot.Util+ -- other-extensions: + build-depends: aeson+ , base >=4.7 && <5+ , bytestring+ , feed+ , feed-collect+ , HTTP+ , http-listen+ , irc-fun-bot >=0.2+ , irc-fun-color+ , network-uri+ , settings+ , text+ , time+ , time-interval+ , time-units+ , transformers+ , unordered-containers >=0.2.5+ , vcs-web-hook-parse+ hs-source-dirs: src+ default-language: Haskell2010
+ src/FunBot/Commands.hs view
@@ -0,0 +1,223 @@+{- This file is part of funbot.+ -+ - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.+ -+ - ♡ Copying is an act of love. Please copy, reuse and share.+ -+ - The author(s) have dedicated all copyright and related and neighboring+ - rights to this software to the public domain worldwide. This software is+ - distributed without any warranty.+ -+ - You should have received a copy of the CC0 Public Domain Dedication along+ - with this software. If not, see+ - <http://creativecommons.org/publicdomain/zero/1.0/>.+ -}++module FunBot.Commands+ ( commandSet+ )+where++import Data.List (find, intercalate)+import Data.Settings.Types (showOption)+import FunBot.Memos (submitMemo)+import FunBot.Settings+import FunBot.Types (BotSession)+import Network.IRC.Fun.Bot.Behavior+import Network.IRC.Fun.Bot.Chat+import Network.IRC.Fun.Bot.Types+import Text.Printf (printf)++-- | The main command set, the only one currently+commandSet = CommandSet+ { prefix = '!'+ , commands =+ [ makeCmdHelp commandSet+ , cmdInfo+ , cmdEcho+ , cmdTell+ , cmdGet+ , cmdSet+ , cmdReset+ , cmdEnable+ , cmdDisable+ ]+ }++-------------------------------------------------------------------------------+-- Echo command+-- Send the input back to the IRC channel+-------------------------------------------------------------------------------++respondEcho :: String -> String -> [String] -> BotSession ()+respondEcho chan _ [] = sendToChannel chan " "+respondEcho chan _ [param] = sendToChannel chan param+respondEcho chan _ params = sendToChannel chan $ unwords params++cmdEcho = Command+ { names = ["echo"]+ , respond = respondEcho+ , help = "‘echo <text>’ - display the given text. Probably not a \+ \useful command. Exists as an example and for testing."+ }++-------------------------------------------------------------------------------+-- Help command+-- Show command help strings+-------------------------------------------------------------------------------++respondHelp :: CommandSet e s -> String -> String -> [String] -> BotSession ()+respondHelp cset chan _ [cname] =+ case find (any (== cname) . names) $ commands cset of+ Just cmd -> sendToChannel chan $+ help cmd+ ++ "\nCommand names: "+ ++ listNames Nothing Nothing True (names cmd)+ Nothing -> sendToChannel chan "No such command, try just ‘help’ \+ \without a parameter."+respondHelp cset chan _ _ =+ sendToChannel chan $+ help (makeCmdHelp cset)+ ++ "\nAvailable commands: "+ ++ listPrimaryNames (Just $ prefix cset) Nothing False (commands cset)++makeCmdHelp cset = Command+ { names = ["help", "h", "?"]+ , respond = respondHelp cset+ , help = "‘help [<command>]’ - display help for the given command. \+ \Passing no parameters, or passing 2 or more, displays the \+ \general help (i.e. this text)."+ }++-------------------------------------------------------------------------------+-- Info command+-- Ask the bot to display some information+-------------------------------------------------------------------------------++respondInfo :: String -> String -> [String] -> BotSession ()+respondInfo chan _ ["intro"] = sendToChannel chan $+ "I’m fpbot. An instance of funbot, written in Haskell. I run in #freepost \+ \(and some extra channels). Developed in the Freepost community, I exist \+ \for fun, collaboration and learning. But I also aim to provide useful \+ \tools, in particular to Freepost and related projects and communities.\n\+ \You can start by trying ‘!help’."+respondInfo chan _ ["features"] = sendToChannel chan $+ "This is a high-level list of features and subsystems I provide. It will \+ \hopefully be kept up-to-date by updating it every time new features are \+ \added.\n\+ \• Help and information system (!help, !info)\n\+ \• A settings system (!get, !set, etc.)\n\+ \• Announcing commits in Git repositories\n\+ \• Announcing RSS/Atom feed items\n\+ \• Leaving memos (requires enabling nick tracking for the channel)\n\+ \There is also an overview of the bot API features, useful to \+ \contributors/developers, in the guide at \+ \<http://rel4tion.org/projects/funbot/guide>."+respondInfo chan _ ["contrib"] = sendToChannel chan $+ "Thinking about contributing to my development? Opening a ticket, fixing \+ \a bug, implementing a feature? Check out the project page at \+ \<http://rel4tion.org/projects/funbot>, which links to the contribution \+ \guide, to the tickets page and more."+respondInfo chan _ ["copying"] = sendToChannel chan $+ "♡ Copying is an act of love. Please copy, reuse and share me! \+ \Grab a copy of me from <https://notabug.org/fr33domlover/funbot>."+respondInfo chan _ ["links"] = sendToChannel chan $+ "Website: http://rel4tion.org/projects/funbot\n\+ \Code: https://notabug.org/fr33domlover/funbot\n\+ \Tickets: http://rel4tion.org/projects/funbot/tickets\n\+ \Roadmap: http://rel4tion.org/projects/funbot/ideas\n\+ \Dev guide: http://rel4tion.org/projects/funbot/guide\n\+ \User manual: http://rel4tion.org/projects/funbot/manual"+respondInfo chan nick [arg] =+ failToChannel chan nick $ InvalidArg (Just 1) (Just arg)+respondInfo chan nick args =+ failToChannel chan nick $ WrongNumArgsN (Just $ length args) (Just 1)++cmdInfo = Command+ { names = ["info", "i"]+ , respond = respondInfo+ , help = "‘info ( intro | features | contrib | copying | links)’ - \+ \display information."+ }++-------------------------------------------------------------------------------+-- Tell command+-- Tell something to some other user+-------------------------------------------------------------------------------++respondTell :: String -> String -> [String] -> BotSession ()+respondTell chan sender (recip:msghead:msgtail) =+ submitMemo sender (Just chan) recip (unwords $ msghead : msgtail)+respondTell chan nick args =+ failToChannel chan nick $ WrongNumArgsN (Just $ length args) Nothing++cmdTell = Command+ { names = ["tell"]+ , respond = respondTell+ , help = "‘tell <nick> <text>’ - leave a memo for a user to see later"+ }++-------------------------------------------------------------------------------+-- Get, set, enable and disable commands+-- Manage bot settings+-------------------------------------------------------------------------------++respondGet :: String -> String -> [String] -> BotSession ()+respondGet chan _ [] = respondGet' "" chan+respondGet chan _ [path] = respondGet' path chan+respondGet chan nick args =+ failToChannel chan nick $ WrongNumArgsN (Just $ length args) (Just 1)++respondSet :: String -> String -> [String] -> BotSession ()+respondSet chan _ [name, val] = respondSet' name val chan+respondSet chan nick args =+ failToChannel chan nick $ WrongNumArgsN (Just $ length args) (Just 2)++respondReset :: String -> String -> [String] -> BotSession ()+respondReset chan _ [name] = respondReset' name chan+respondReset chan nick args =+ failToChannel chan nick $ WrongNumArgsN (Just $ length args) (Just 1)++respondBool :: Bool -> String -> String -> [String] -> BotSession ()+respondBool val chan _ [name] = respondSet' name (showOption val) chan+respondBool _ chan nick args =+ failToChannel chan nick $ WrongNumArgsN (Just $ length args) (Just 1)++respondEnable = respondBool True++respondDisable = respondBool False++cmdGet = Command+ { names = ["get"]+ , respond = respondGet+ , help = "‘get <option>’ - get the value of a settings option at the \+ \given path"+ }++cmdSet = Command+ { names = ["set"]+ , respond = respondSet+ , help = "‘set <option> <value>’ - set a settings option at the given \+ \path to the given value"+ }++cmdReset = Command+ { names = ["reset"]+ , respond = respondReset+ , help = "‘reset <option>’ - set a settings option at the given path to \+ \its default value"+ }++cmdEnable = Command+ { names = ["enable"]+ , respond = respondEnable+ , help = "‘enable <option>’ - set a settings option at the given path \+ \to True"+ }++cmdDisable = Command+ { names = ["disable"]+ , respond = respondDisable+ , help = "‘disable <option>’ - set a settings option at the given path \+ \to False"+ }
+ src/FunBot/Config.hs view
@@ -0,0 +1,48 @@+{- This file is part of funbot.+ -+ - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.+ -+ - ♡ Copying is an act of love. Please copy, reuse and share.+ -+ - The author(s) have dedicated all copyright and related and neighboring+ - rights to this software to the public domain worldwide. This software is+ - distributed without any warranty.+ -+ - You should have received a copy of the CC0 Public Domain Dedication along+ - with this software. If not, see+ - <http://creativecommons.org/publicdomain/zero/1.0/>.+ -}++module FunBot.Config+ ( configuration+ , webListenerPort+ , devAnnChans+ , feedErrorLogFile+ )+where++import qualified Data.HashMap.Lazy as M+import Data.Time.Interval (time)+import Data.Time.Units+import Network.IRC.Fun.Bot.Types (Connection (..), Config (..))++configuration = Config+ { connection = Connection+ { server = "irc.freenode.net"+ , port = 6667+ , tls = False -- not supported yet+ , nick = "bot_test_joe"+ , password = Nothing+ }+ , channels = ["#freepost-bot-test"]+ , logDir = "state/chanlogs"+ , stateFile = "state/state.json"+ , saveInterval = time (3 :: Second)+ , botEventLogFile = "state/bot.log"+ }++webListenerPort = 8998 :: Int++devAnnChans = M.empty++feedErrorLogFile = "state/feed-error.log"
+ src/FunBot/ExtHandlers.hs view
@@ -0,0 +1,160 @@+{- This file is part of funbot.+ -+ - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.+ -+ - ♡ Copying is an act of love. Please copy, reuse and share.+ -+ - The author(s) have dedicated all copyright and related and neighboring+ - rights to this software to the public domain worldwide. This software is+ - distributed without any warranty.+ -+ - You should have received a copy of the CC0 Public Domain Dedication along+ - with this software. If not, see+ - <http://creativecommons.org/publicdomain/zero/1.0/>.+ -}++{-# LANGUAGE OverloadedStrings #-}++module FunBot.ExtHandlers+ ( handler+ )+where++import Control.Monad (forM_, when)+import Control.Monad.IO.Class (liftIO)+import Data.Char (toLower)+import qualified Data.HashMap.Lazy as M+import Data.Maybe (fromMaybe)+import Data.Monoid ((<>))+import qualified Data.Text as T+import FunBot.Types+import FunBot.Util (passes)+import Network.HTTP (Request (..), RequestMethod (..))+import Network.IRC.Fun.Bot.Chat (sendToChannel)+import Network.IRC.Fun.Bot.State (askEnvS, getStateS)+import Network.IRC.Fun.Color+import qualified Web.Hook.GitLab as GitLab+import qualified Web.Hook.Gogs as Gogs++formatCommit branch repo (Commit author msg url) =+ encode $+ Green #> Pure author <> " " <>+ Maroon #> Pure branch <> " " <>+ Purple #> Pure repo <> " | " <>+ Teal #> Pure msg <> " " <>+ Gray #> Pure url++formatEllipsis branch repo n =+ encode $+ Green #> "..." <> " " <>+ Maroon #> Pure branch <> " " <>+ Purple #> Pure repo <> " | " <>+ Navy #> Pure ("... another " ++ show n ++ " commits ...")++formatTag (Tag author ref repo _owner) =+ encode $+ Green #> Pure author <> " " <>+ Purple #> Pure repo <> " " <>+ Teal #> Pure ref++formatMR (MR author iid _repo _owner title url action) =+ encode $+ Green #> Pure author <> " " <>+ Maroon #> Pure action <> " " <>+ Purple #> Pure ('#' : show iid) <> " | " <>+ Teal #> Pure title <> " " <>+ Gray #> Pure url++formatNews item fields =+ let -- Filtered fields+ filt pass val = if pass then val else Nothing+ authorF = filt (dispAuthor fields) (itemAuthor item)+ fTitleF = filt (dispFeedTitle fields) (itemFeedTitle item)+ urlF = filt (dispUrl fields) (itemUrl item)+ -- Separate components+ author = fmap (\ a -> Green #> Pure a) authorF+ fTitle = fmap (\ ft -> Purple #> Pure ft) fTitleF+ iTitle = Teal #> Pure (itemTitle item)+ url = fmap (\ u -> Gray #> Pure u) urlF+ -- Now combine them+ af = case (author, fTitle) of+ (Nothing, Nothing) -> Nothing+ (a@(Just _), Nothing) -> a+ (Nothing, t@(Just _)) -> t+ (Just a, Just t) -> Just $ a <> " @ " <> t+ iu = case url of+ Nothing -> iTitle+ Just u -> iTitle <> " " <> u+ in encode $ case af of+ Nothing -> iu+ Just af' -> af' <> " | " <> iu++lower = map toLower++keyb b = (branchRepo b, lower $ branchRepoOwner b)++keyt t = (tagRepo t, lower $ tagRepoOwner t)++keym mr = (mrRepo mr, lower $ mrRepoOwner mr)++annCommits branch msgs ellip spec =+ let chan = pAnnChannel spec+ in when (branch `passes` pAnnBranches spec) $+ if pAnnAllCommits spec || length msgs <= 3+ then mapM_ (sendToChannel chan) msgs+ else do+ let firstCommit = head msgs+ lastCommit = last msgs+ between = length msgs - 2+ sendToChannel chan firstCommit+ sendToChannel chan ellip+ sendToChannel chan lastCommit++handler (GitPush (Push branch commits)) = do+ chans <- askEnvS gitAnnChans+ case M.lookup (keyb branch) chans of+ Just specs ->+ let fmt = formatCommit (branchName branch) (branchRepo branch)+ msgs = map fmt commits+ ellip =+ formatEllipsis+ (branchName branch)+ (branchRepo branch)+ (length msgs - 2)+ in mapM_ (annCommits (branchName branch) msgs ellip) specs+ Nothing ->+ liftIO $ putStrLn $+ "Ext handler: Git push for unregistered repo: " +++ show (keyb branch)+handler (GitTag tag) = do+ chans <- askEnvS gitAnnChans+ case M.lookup (keyt tag) chans of+ Just specs ->+ let msg = formatTag tag+ ann chan = sendToChannel chan msg+ in mapM_ (ann . pAnnChannel) specs+ Nothing ->+ liftIO $ putStrLn $+ "Ext handler: Tag for unregistered repo: " +++ show (keyt tag)+handler (MergeRequest mr) = do+ chans <- askEnvS gitAnnChans+ case M.lookup (keym mr) chans of+ Just specs ->+ let msg = formatMR mr+ ann chan = sendToChannel chan msg+ in mapM_ (ann . pAnnChannel) specs+ Nothing ->+ liftIO $ putStrLn $+ "Ext handler: MR for unregistered repo: " +++ show (keym mr)+handler (NewsItem item) = do+ feeds <- getStateS $ watchedFeeds . settings+ let label = itemFeedLabel item+ case M.lookup label feeds of+ Just (_url, spec) ->+ let msg = formatNews item (nAnnFields spec)+ in mapM_ (\ chan -> sendToChannel chan msg) (nAnnChannels spec)+ Nothing -> liftIO $ do+ putStrLn $ "Ext handler: Feed item with unknown label: " ++ label+ print item
+ src/FunBot/IrcHandlers.hs view
@@ -0,0 +1,58 @@+{- This file is part of funbot.+ -+ - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.+ -+ - ♡ Copying is an act of love. Please copy, reuse and share.+ -+ - The author(s) have dedicated all copyright and related and neighboring+ - rights to this software to the public domain worldwide. This software is+ - distributed without any warranty.+ -+ - You should have received a copy of the CC0 Public Domain Dedication along+ - with this software. If not, see+ - <http://creativecommons.org/publicdomain/zero/1.0/>.+ -}++module FunBot.IrcHandlers+ ( handleBotMsg+ , handleJoin+ --, handlePart+ --, handleQuit+ --, handleNames+ )+where++import Data.Char (toLower)+import FunBot.Memos (reportMemos)+import Network.IRC.Fun.Bot.Chat (sendToChannel)++helloWords :: [String]+helloWords = ["hello", "hi", "hey", "yo"]++waveWordsL :: [String]+waveWordsL = ["\\o", "\\O", "\\0"]++waveWordsR :: [String]+waveWordsR = ["o/", "O/", "0/"]++isHello :: String -> Bool+isHello s =+ let s' = map toLower s+ in null s+ || s' `elem` helloWords+ || init s' `elem` helloWords && last s' `elem` ".!?"++handleBotMsg chan nick msg+ | isHello msg = sendToChannel chan $ "Hello, " ++ nick+ | map toLower msg == "ping" = sendToChannel chan $ nick ++ ", pong"+ | msg `elem` waveWordsL = sendToChannel chan $ nick ++ ": o/"+ | msg `elem` waveWordsR = sendToChannel chan $ nick ++ ": \\o"+ | otherwise = return ()++handleJoin _chan nick = reportMemos nick++--handlePart chan nick _why = removeMemberOnce chan nick++--handleQuit nick _why = removeMember nick++--handleNames chan _priv pnicks = addChannel chan $ map snd pnicks
+ src/FunBot/Memos.hs view
@@ -0,0 +1,294 @@+{- This file is part of funbot.+ -+ - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.+ -+ - ♡ Copying is an act of love. Please copy, reuse and share.+ -+ - The author(s) have dedicated all copyright and related and neighboring+ - rights to this software to the public domain worldwide. This software is+ - distributed without any warranty.+ -+ - You should have received a copy of the CC0 Public Domain Dedication along+ - with this software. If not, see+ - <http://creativecommons.org/publicdomain/zero/1.0/>.+ -}++-- For JSON field names and irc-fun-color StyledString+{-# LANGUAGE OverloadedStrings #-}++module FunBot.Memos+ ( submitMemo+ , reportMemos+ , loadBotMemos+ , mkSaveBotMemos+ --, saveBotMemos+ )+where++import Control.Applicative ((<$>), (<*>))+import Control.Monad (liftM, mzero, unless)+import Control.Monad.IO.Class (liftIO)+import Data.Aeson hiding (encode)+import qualified Data.HashMap.Lazy as M+import Data.Monoid ((<>))+import Data.Settings.Persist+import Data.Time.Units (Second)+import FunBot.Types+import FunBot.Util ((!?))+import Network.IRC.Fun.Bot.Chat (sendToChannel, sendToUser)+import Network.IRC.Fun.Bot.Nicks (isInChannel, presence)+import Network.IRC.Fun.Bot.State+import Network.IRC.Fun.Color+import Text.Printf (printf)++-------------------------------------------------------------------------------+-- Utilities+-------------------------------------------------------------------------------++getMemos :: BotSession (M.HashMap String [Memo])+getMemos = getStateS memos++putMemos :: M.HashMap String [Memo] -> BotSession ()+putMemos ms = modifyState $ \ s -> s { memos = ms }++modifyMemos :: (M.HashMap String [Memo] -> M.HashMap String [Memo])+ -> BotSession ()+modifyMemos f = modifyState $ \ s -> s { memos = f $ memos s }++getTimeStr :: BotSession String+getTimeStr = do+ getTime <- askTimeGetter+ liftIO $ liftM snd getTime++-- | Get a list of the memos saved for a user, in the order they were sent.+getUserMemos :: String -- ^ User nickname+ -> BotSession [Memo]+getUserMemos recip = liftM (M.lookupDefault [] recip) getMemos++insertMemo :: String -> Memo -> BotSession ()+insertMemo recip memo = do+ ms <- getMemos+ let oldList = M.lookupDefault [] recip ms+ newList = oldList ++ [memo]+ putMemos $ M.insert recip newList ms++-- | Delete all memos for a given recipient, if any exist.+deleteUserMemos :: String -- ^ Recipient nickname+ -> BotSession ()+deleteUserMemos recip = modifyMemos $ M.delete recip++-- | Prepare an IRC message which displays a memo.+formatMemo :: Maybe String -- ^ Optional recipient nickname to mention+ -> Int -- ^ Memo index to display+ -> Memo -- ^ Memo to format+ -> String+formatMemo (Just recip) _idx memo =+ printf "%v, %v said in %v UTC:\n\"%v\""+ recip+ (memoSender memo)+ (memoTime memo)+ (memoContent memo)+formatMemo Nothing idx memo =+ let n = Maroon #> ("[" <> Pure (show idx) <> "]")+ time = Purple #> Pure (memoTime memo ++ " UTC")+ sender = Gray #> "<" <> Green #> Pure (memoSender memo) <> Gray #> ">"+ content = Pure $ memoContent memo+ in encode $ n <> " " <> time <> " " <> sender <> " " <> content++-- | Send a memo to its destination, nicely formatted.+sendMemo :: String -- ^ Recipient nickname+ -> Int -- ^ Memo index number for display (i.e. 1-based)+ -> Memo -- ^ Memo to display on IRC+ -> BotSession ()+sendMemo recip idx memo =+ case memoSendIn memo of+ Just chan -> sendToChannel chan $ formatMemo (Just recip) idx memo+ Nothing -> sendToUser recip $ formatMemo Nothing idx memo++-- | Send a memo to its destination, nicely formatted.+sendMemoList :: String -- ^ Recipient nickname+ -> Int -- ^ First memo's index number for display+ -> [Memo] -- ^ Memos to display on IRC+ -> BotSession ()+sendMemoList recip idx ms =+ let send (i, m) = sendMemo recip i m+ in mapM_ send $ zip [idx..] ms++-- | An instant memo response into the source channel or in PM.+sendInstant :: String -- ^ Sender nickname+ -> Maybe String -- ^ Source channel+ -> String -- ^ Recipient nickname+ -> String -- ^ Message+ -> BotSession ()+sendInstant sender mchan recip content =+ case mchan of+ Just chan -> sendToChannel chan msg+ Nothing -> sendToUser recip msg+ where+ msg = printf "%v, %v says: %v" recip sender content++-- | Report to sender than their memo has been saved.+confirm :: String -- ^ Sender nickname+ -> Maybe String -- ^ Whether sent 'Just' in channel or in PM.+ -> String -- ^ Recipient nickname+ -> BotSession ()+confirm sender (Just chan) recip =+ sendToChannel chan $+ printf "%v, your memo for %v has been saved." sender recip+confirm sender Nothing recip =+ sendToUser sender $+ printf "Your memo for %v has been saved." recip++-------------------------------------------------------------------------------+-- Operations+-------------------------------------------------------------------------------++-- | Record a new memo for a given user.+addMemo :: String -- ^ Sender nickname+ -> Maybe String -- ^ Whether received in 'Just' a channel, or in PM+ -> Maybe String -- ^ Whether to send in 'Just' a channel, or in PM+ -> String -- ^ Recipient nickname+ -> String -- ^ Memo content+ -> BotSession ()+addMemo sender recv send recip content = do+ time <- getTimeStr+ let memo = Memo+ { memoTime = time+ , memoSender = sender+ , memoRecvIn = recv+ , memoSendIn = send+ , memoContent = content+ }+ insertMemo recip memo++-- | Send a memo with the given index if exists. Return 'Nothing' on success,+-- or 'Just' the number of saved memos for the nickname on failure (invalid+-- index).+sendOneMemo :: String -- ^ Recipient nickname+ -> Int -- ^ Memo number, 0-based+ -> BotSession (Maybe Int)+sendOneMemo recip idx = do+ ms <- getMemos+ case M.lookup recip ms of+ Just l -> case l !? idx of+ Just memo -> sendMemo recip (idx + 1) memo >> return Nothing+ Nothing -> return $ Just $ length l+ Nothing -> return $ Just 0++-- | Delete a memo for a given recipient with the given index (position in the+-- memo list). On success, return 'Nothing'. On error, return 'Just' the number+-- of saved memos the receipient has.+deleteOneMemo :: String -- ^ Recipient nickname+ -> Int -- ^ Memo index number, 0-based+ -> BotSession (Maybe Int)+deleteOneMemo recip idx = do+ ms <- getMemos+ case M.lookup recip ms of+ Just l -> case splitAt idx l of+ ([], _:[]) -> do+ putMemos $ M.delete recip ms+ return Nothing+ (b, _:a) -> do+ putMemos $ M.insert recip (b ++ a) ms+ return Nothing+ _ -> return $ Just $ length l+ Nothing -> return $ Just 0++-------------------------------------------------------------------------------+-- Handlers+-------------------------------------------------------------------------------++-- | React to a user's request to make a new memo.+--+-- If user is online in same channel, send instantly to channel.+-- If user is online in another channel, send in PM (and report to sender).+-- If user not online, save memo and report to sender.+submitMemo :: String -- ^ Sender nickname+ -> Maybe String -- ^ Whether sent in 'Just' a channel, or in PM+ -> String -- ^ Recipient nickname+ -> String -- ^ Memo content+ -> BotSession ()+submitMemo sender source recip content = do+ let instantToChan =+ case source of+ Just chan -> do+ isin <- recip `isInChannel` chan+ if isin+ then do+ sendInstant sender (Just chan) recip content+ return True+ else return False+ Nothing -> return False+ instantToUser = do+ p <- presence recip+ if not $ null p+ then do+ sendInstant sender Nothing recip content+ return True+ else return False+ keepForLater = do+ addMemo sender source Nothing recip content+ saveBotMemos+ confirm sender source recip+ succ1 <- instantToChan+ unless succ1 $ do+ succ2 <- instantToUser+ unless succ2 keepForLater++-- | When a user logs in, use this to send them a report of the memos saved for+-- them, if any exist.+reportMemos :: String -- ^ User nickname+ -> BotSession ()+reportMemos recip = do+ ms <- getUserMemos recip+ unless (null ms) $ do+ sendToUser recip $ "You have " ++ show (length ms) ++ " memos:"+ sendMemoList recip 1 ms+ deleteUserMemos recip+ saveBotMemos++-------------------------------------------------------------------------------+-- Persistence+-------------------------------------------------------------------------------++instance FromJSON Memo where+ parseJSON (Object o) =+ Memo <$>+ o .: "time" <*>+ o .: "sender" <*>+ o .: "recv-in" <*>+ o .: "send-in" <*>+ o .: "content" {-<*>+ o .: "read"-}+ parseJSON _ = mzero++instance ToJSON Memo where+ toJSON (Memo time sender recvIn sendIn content {-rd-}) = object+ [ "time" .= time+ , "sender" .= sender+ , "recv-in" .= recvIn+ , "send-in" .= sendIn+ , "content" .= content+ --, "read" .= rd+ ]++memosFilename = "state/memos.json"++saveInterval = 3 :: Second++loadBotMemos :: IO (M.HashMap String [Memo])+loadBotMemos = do+ r <- loadSettings memosFilename+ case r of+ Left (False, e) -> error $ "Failed to read memos file: " ++ e+ Left (True, e) -> error $ "Failed to parse memos file: " ++ e+ Right s -> return s++mkSaveBotMemos :: IO (M.HashMap String [Memo] -> IO ())+mkSaveBotMemos = mkSaveSettings saveInterval memosFilename++saveBotMemos :: BotSession ()+saveBotMemos = do+ ms <- getStateS memos+ save <- askEnvS saveMemos+ liftIO $ save ms
+ src/FunBot/Settings.hs view
@@ -0,0 +1,383 @@+{- This file is part of funbot.+ -+ - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.+ -+ - ♡ Copying is an act of love. Please copy, reuse and share.+ -+ - The author(s) have dedicated all copyright and related and neighboring+ - rights to this software to the public domain worldwide. This software is+ - distributed without any warranty.+ -+ - You should have received a copy of the CC0 Public Domain Dedication along+ - with this software. If not, see+ - <http://creativecommons.org/publicdomain/zero/1.0/>.+ -}++-- For the 'MonadSettings' instance+{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances, FlexibleInstances #-}++-- For JSON field names and irc-fun-color StyledString+{-# LANGUAGE OverloadedStrings #-}++module FunBot.Settings+ ( respondGet'+ , respondSet'+ , respondReset'+ , initTree+ --, addChanLogOpt+ --, addChanLogVal+ , loadBotSettings+ , mkSaveBotSettings+ )+where++import Control.Applicative ((<$>), (<*>))+import Control.Monad (mzero)+import Control.Monad.IO.Class (liftIO)+import Data.Aeson hiding (encode)+import Data.Bool (bool)+import Data.Char (toLower)+import qualified Data.HashMap.Lazy as M+import Data.List (intercalate, intersperse, isSuffixOf)+import Data.Monoid+import Data.Settings.Interface+import Data.Settings.Option+import Data.Settings.Route (showRoute)+import Data.Settings.Persist+import Data.Settings.Section (insert)+import Data.Settings.Types+import Data.Time.Units (Second)+import FunBot.Types+import Network.IRC.Fun.Bot.Chat+import Network.IRC.Fun.Bot.IrcLog+import Network.IRC.Fun.Bot.Nicks+import Network.IRC.Fun.Bot.State+import Network.IRC.Fun.Color++instance MonadSettings BotSession Settings where+ getSettings = getStateS settings++ putSettings s = modifyState $ \ st -> st { settings = s }++ modifySettings f = modifyState $ \ st -> st { settings = f $ settings st }++ getSTree = getStateS stree++instance OptionValue Bool where+ readOption s+ | s' `elem` ["off", "false", "no", "n", "0", "[_]"] = Just False+ | s' `elem` ["on", "true", "yes", "y", "1", "[x]"] = Just True+ | otherwise = Nothing+ where+ s' = map toLower s+ showOption = show+ typeName = const "Boolean"++instance OptionValue String where+ readOption = Just+ showOption = id+ typeName = const "String"++parseList :: String -> Maybe [String]+parseList s =+ case break (== ',') s of+ ("", _) -> Nothing+ (p, "") -> Just [p]+ (p, (c:cs)) ->+ case parseList cs of+ Nothing -> Nothing+ Just ps -> Just $ p : ps++instance OptionValue [String] where+ readOption s = parseList s >>= mapM readOption+ showOption = intercalate "," . map showOption+ typeName = const "List"++instance FromJSON NewsItemFields where+ parseJSON (Object o) =+ NewsItemFields <$>+ o .: "show-feed-title" <*>+ o .: "show-author" <*>+ o .: "show-url"+ parseJSON _ = mzero++instance ToJSON NewsItemFields where+ toJSON (NewsItemFields ftitle author url) = object+ [ "show-feed-title" .= ftitle+ , "show-author" .= author+ , "show-url" .= url+ ]++instance FromJSON NewsAnnSpec where+ parseJSON (Object o) =+ NewsAnnSpec <$>+ o .: "channels" <*>+ o .: "fields"+ parseJSON _ = mzero++instance ToJSON NewsAnnSpec where+ toJSON (NewsAnnSpec channels fields) = object+ [ "channels" .= channels+ , "fields" .= fields+ ]++instance FromJSON Settings where+ parseJSON (Object o) =+ Settings <$>+ o .: "feeds"+ parseJSON _ = mzero++instance ToJSON Settings where+ toJSON (Settings feeds) = object+ [ "feeds" .= feeds+ ]++-- An option whose value is held by funbot's 'Settings' and saved into its+-- settings file+mkOptionF :: OptionValue v+ => (Settings -> v) -- Get+ -> (v -> Settings -> Settings) -- Set which never fails+ -> v -- Default value for reset+ -> SettingsOption+mkOptionF get set defval = mkOptionS get set' reset cb+ where+ set' v s = Just $ set v s+ reset s = (Just defval, set defval s)+ cb = const saveBotSettings++-- An option whose value is held by irc-fun-bot's 'BotState' and saved into its+-- state file+mkOptionB :: OptionValue v+ => BotSession v -- Get+ -> (v -> BotSession ()) -- Set which never fails+ -> v -- Default value for reset+ -> SettingsOption+mkOptionB get set defval = mkOptionV get set' reset+ where+ setTo val = set val >> cb val+ set' val = setTo val >> return True+ reset = setTo defval+ cb = const saveBotState++{-chanLogOpt chan =+ mkOptionF+ (M.lookupDefault False chan . chanLogging)+ (\ b s -> s { chanLogging = M.insert chan b $ chanLogging s })+ False-}++feedSec :: String -> SettingsTree+feedSec label = Section+ { secOpts = M.fromList+ [ ( "channels"+ , mkOptionF+ getChans+ (\ chans s ->+ let feeds = watchedFeeds s+ (url, spec) = getPair s+ pair = (url, spec { nAnnChannels = chans })+ in s { watchedFeeds = M.insert label pair feeds }+ )+ defChans+ )+ ]+ , secSubs = M.fromList+ [ ( "show"+ , Section+ { secOpts = M.fromList+ [ ( "feed-title"+ , mkOptionF+ (dispFeedTitle . getFields)+ (\ b s ->+ let (url, spec) = getPair s+ fieldsOld = nAnnFields spec+ fields = fieldsOld { dispFeedTitle = b }+ pair = (url, spec { nAnnFields = fields })+ in s { watchedFeeds = M.insert label pair $+ watchedFeeds s }+ )+ (dispFeedTitle defFields)+ )+ , ( "author"+ , mkOptionF+ (dispAuthor . getFields)+ (\ b s ->+ let (url, spec) = getPair s+ fieldsOld = nAnnFields spec+ fields = fieldsOld { dispAuthor = b }+ pair = (url, spec { nAnnFields = fields })+ in s { watchedFeeds = M.insert label pair $+ watchedFeeds s }+ )+ (dispAuthor defFields)+ )+ , ( "url"+ , mkOptionF+ (dispUrl . getFields)+ (\ b s ->+ let (url, spec) = getPair s+ fieldsOld = nAnnFields spec+ fields = fieldsOld { dispUrl = b }+ pair = (url, spec { nAnnFields = fields })+ in s { watchedFeeds = M.insert label pair $+ watchedFeeds s }+ )+ (dispUrl defFields)+ )+ ]+ , secSubs = M.empty+ }+ )+ ]+ }+ where+ defChans = []+ defFields = NewsItemFields True True True+ defSpec = NewsAnnSpec defChans defFields+ defUrl = ""+ defPair = (defUrl, defSpec)++ getPair = M.lookupDefault defPair label . watchedFeeds+ getUrl = maybe defUrl fst . M.lookup label . watchedFeeds+ getSpec = maybe defSpec snd . M.lookup label . watchedFeeds+ getChans = nAnnChannels . getSpec+ getFields = nAnnFields . getSpec++chanSec :: String -> SettingsTree+chanSec chan = Section+ { secOpts = M.fromList+ [ ( "track"+ , mkOptionB+ (channelIsTracked chan)+ (bool (stopTrackingChannel chan) (startTrackingChannel chan))+ False+ )+ , ( "log"+ , mkOptionB+ (channelIsLogged chan)+ (bool (stopLoggingChannel chan) (startLoggingChannel chan))+ False+ )+ ]+ , secSubs = M.empty+ }++initTree :: BotSession ()+initTree = do+ cstates <- getChannelState+ sets <- getSettings+ let mapKey f = M.mapWithKey $ \ key _val -> f key+ tree = Section+ { secOpts = M.empty+ , secSubs = M.fromList+ [ ( "channels"+ , Section+ { secOpts = M.empty+ , secSubs = mapKey chanSec cstates+ }+ )+ , ( "feeds"+ , Section+ { secOpts = M.empty+ , secSubs = mapKey feedSec $ watchedFeeds sets+ }+ )+ ]+ }+ modifyState $ \ s -> s { stree = tree }++{-addChanLogOpt :: String -> SettingsTree -> SettingsTree+addChanLogOpt chan = insert ["chanlog", chan] $ chanLogOpt chan++addChanLogVal :: String -> Bool -> Settings -> Settings+addChanLogVal chan b s = s { chanLogging = M.insert chan b $ chanLogging s }-}++showError :: SettingsError -> String+showError (InvalidPath s) = s ++ " : Invalid path"+showError (NoSuchNode r) = showRoute r ++ " : No such option/section"+showError (NoSuchOption r) = showRoute r ++ " : No such option"+showError (NoSuchSection r) = showRoute r ++ " : No such section"+showError (InvalidValueForType s) = s ++ " : Invalid value for option type"+showError (InvalidValue s) = s ++ " : Invalid value"++showGet :: String -> String -> String+showGet opt val = opt ++ " = " ++ val++showSec :: String -> [String] -> [String] -> String+showSec path subs opts =+ let showSub = Pure . ('‣' :)+ showOpt = Pure . ('•' :)+ showList = mconcat . intersperse " "+ pathF = Pure path+ subsF = Green #> (showList $ map showSub subs)+ optsF = Purple #> (showList $ map showOpt opts)+ in encode $ case (null subs, null opts) of+ (False, False) -> pathF <> " : " <> subsF <> " | " <> optsF+ (False, True) -> pathF <> " : " <> subsF+ (True, False) -> pathF <> " : " <> optsF+ (True, True) -> pathF <> " : Empty section"++respondGet' :: String -> String -> BotSession ()+respondGet' opt chan+ | opt == "*" = respSec ""+ | ".*" `isSuffixOf` opt = respSec $ take (length opt - 2) opt+ | otherwise = respAny opt+ where+ respAny path = do+ result <- query path+ sendToChannel chan $ case result of+ Left err -> showError err+ Right (Left (subs, opts)) -> showSec path subs opts+ Right (Right val) -> showGet path val+ respSec path = do+ result <- querySection path+ sendToChannel chan $ case result of+ Left err -> showError err+ Right (subs, opts) -> showSec path subs opts++showSet :: String -> String -> String+showSet opt val = opt ++ " ← " ++ val++respondSet' :: String -> String -> String -> BotSession ()+respondSet' opt val chan = do+ merr <- updateOption opt val+ case merr of+ Just err -> sendToChannel chan (showError err)+ Nothing -> sendToChannel chan (showSet opt val)++showReset :: String -> String -> String+showReset opt val = opt ++ " ↩ " ++ val++showResetStrange :: String -> String+showResetStrange opt = opt ++ " : got reset, but I can't find it now"++respondReset' :: String -> String -> BotSession ()+respondReset' opt chan = do+ merr <- resetOption opt+ case merr of+ Just err -> sendToChannel chan $ showError err+ Nothing -> do+ me <- queryOption opt+ sendToChannel chan $ case me of+ Left _ -> showResetStrange opt+ Right val -> showReset opt val++settingsFilename = "state/settings.json"++saveInterval = 3 :: Second++loadBotSettings :: IO Settings+loadBotSettings = do+ r <- loadSettings settingsFilename+ case r of+ Left (False, e) -> error $ "Failed to read settings file: " ++ e+ Left (True, e) -> error $ "Failed to parse settings file: " ++ e+ Right s -> return s++mkSaveBotSettings :: IO (Settings -> IO ())+mkSaveBotSettings = mkSaveSettings saveInterval settingsFilename++saveBotSettings :: BotSession ()+saveBotSettings = do+ sets <- getSettings+ save <- askEnvS saveSettings+ liftIO $ save sets
+ src/FunBot/Sources.hs view
@@ -0,0 +1,23 @@+{- This file is part of funbot.+ -+ - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.+ -+ - ♡ Copying is an act of love. Please copy, reuse and share.+ -+ - The author(s) have dedicated all copyright and related and neighboring+ - rights to this software to the public domain worldwide. This software is+ - distributed without any warranty.+ -+ - You should have received a copy of the CC0 Public Domain Dedication along+ - with this software. If not, see+ - <http://creativecommons.org/publicdomain/zero/1.0/>.+ -}++module FunBot.Sources+ ( feedWatcherSource+ , webListenerSource+ )+where++import FunBot.Sources.FeedWatcher (feedWatcherSource)+import FunBot.Sources.WebListener (webListenerSource)
+ src/FunBot/Sources/FeedWatcher.hs view
@@ -0,0 +1,58 @@+{- This file is part of funbot.+ -+ - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.+ -+ - ♡ Copying is an act of love. Please copy, reuse and share.+ -+ - The author(s) have dedicated all copyright and related and neighboring+ - rights to this software to the public domain worldwide. This software is+ - distributed without any warranty.+ -+ - You should have received a copy of the CC0 Public Domain Dedication along+ - with this software. If not, see+ - <http://creativecommons.org/publicdomain/zero/1.0/>.+ -}++module FunBot.Sources.FeedWatcher+ ( feedWatcherSource+ )+where++import qualified Data.HashMap.Lazy as M+import Data.Maybe (fromMaybe)+import Data.Time.Units+import FunBot.Types+import Network.IRC.Fun.Bot.Logger+import Text.Feed.Query+import Web.Feed.Collect (run)++makeItem label ftitle item = NewsItem $ FeedItem+ { itemFeedLabel = label+ , itemFeedTitle = Just ftitle+ , itemTitle = fromMaybe "(no title)" $ getItemTitle item+ , itemAuthor = getItemAuthor item+ , itemUrl = getItemLink item+ }++collect push label _url feed item =+ push $ makeItem label (getFeedTitle feed) item++logError logger err = logLine logger $ show err++feeds state =+ let l = M.toList $ watchedFeeds $ settings state+ f (label, (url, _spec)) = (label, url)+ in map f l++feedWatcherSource :: FilePath -> BotState -> ExtEventSource+feedWatcherSource file state _config _env push _pushMany mkLogger = do+ logger <- mkLogger file+ putStrLn "Bot: Feed watcher source loop running"+ run+ (collect push)+ Nothing+ (logError logger)+ Nothing+ (1 :: Minute)+ 3+ (feeds state)
+ src/FunBot/Sources/WebListener.hs view
@@ -0,0 +1,42 @@+{- This file is part of funbot.+ -+ - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.+ -+ - ♡ Copying is an act of love. Please copy, reuse and share.+ -+ - The author(s) have dedicated all copyright and related and neighboring+ - rights to this software to the public domain worldwide. This software is+ - distributed without any warranty.+ -+ - You should have received a copy of the CC0 Public Domain Dedication along+ - with this software. If not, see+ - <http://creativecommons.org/publicdomain/zero/1.0/>.+ -}++module FunBot.Sources.WebListener+ ( webListenerSource+ )+where++import FunBot.Sources.WebListener.Client (dispatchClient)+import FunBot.Sources.WebListener.GitLab (dispatchGitLab)+import FunBot.Sources.WebListener.Gogs (dispatchGogs)+import FunBot.Types+import Network.HTTP (Request (..), RequestMethod (..))+import Network.HTTP.Listen (run)+import Network.IRC.Fun.Bot.State (askEnvS)+import Network.URI (uriPath)++listener push pushMany request = do+ case (uriPath $ rqURI request, rqMethod request) of+ ("/gogs", POST) -> dispatchGogs push pushMany request+ ("/gitlab", POST) -> dispatchGitLab push pushMany request+ ("/client", POST) -> dispatchClient push pushMany request+ _ -> do+ putStrLn "Web listener source: Unrecognized request received:"+ print request+ return Nothing++webListenerSource _config env push pushMany _mkLogger = do+ putStrLn "Bot: Web listener source listening to HTTP requests"+ run (webHookSourcePort env) $ listener push pushMany
+ src/FunBot/Sources/WebListener/Client.hs view
@@ -0,0 +1,172 @@+{- This file is part of funbot.+ -+ - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.+ -+ - ♡ Copying is an act of love. Please copy, reuse and share.+ -+ - The author(s) have dedicated all copyright and related and neighboring+ - rights to this software to the public domain worldwide. This software is+ - distributed without any warranty.+ -+ - You should have received a copy of the CC0 Public Domain Dedication along+ - with this software. If not, see+ - <http://creativecommons.org/publicdomain/zero/1.0/>.+ -}++{-# LANGUAGE OverloadedStrings #-}++module FunBot.Sources.WebListener.Client+ ( dispatchClient+ )+where++import Control.Applicative+import Control.Monad (mzero)+import Data.Aeson+import Data.Aeson.Types (Parser)+import qualified Data.ByteString.Lazy as B+import qualified Data.Text as T+import FunBot.Types+import Network.HTTP (Request (..))++instance FromJSON Branch where+ parseJSON (Object o) =+ Branch <$>+ o .: "name" <*>+ o .: "repo" <*>+ o .: "user"+ parseJSON _ = mzero++instance ToJSON Branch where+ toJSON (Branch name repo owner) = object+ [ "name" .= name+ , "repo" .= repo+ , "user" .= owner+ ]++instance FromJSON Commit where+ parseJSON (Object o) =+ Commit <$>+ o .: "author" <*>+ o .: "title" <*>+ o .: "url"+ parseJSON _ = mzero++instance ToJSON Commit where+ toJSON (Commit author title url) = object+ [ "author" .= author+ , "title" .= title+ , "url" .= url+ ]++instance FromJSON Push where+ parseJSON (Object o) =+ Push <$>+ o .: "branch" <*>+ o .: "commits"+ parseJSON _ = mzero++instance ToJSON Push where+ toJSON (Push branch commits) = object+ [ "branch" .= branch+ , "commits" .= commits+ ]++instance FromJSON Tag where+ parseJSON (Object o) =+ Tag <$>+ o .: "author" <*>+ o .: "ref" <*>+ o .: "repo" <*>+ o .: "user"+ parseJSON _ = mzero++instance ToJSON Tag where+ toJSON tag = object+ [ "author" .= tagAuthor tag+ , "ref" .= tagRef tag+ , "repo" .= tagRepo tag+ , "user" .= tagRepoOwner tag+ ]++instance FromJSON MR where+ parseJSON (Object o) =+ MR <$>+ o .: "author" <*>+ o .: "id" <*>+ o .: "repo" <*>+ o .: "user" <*>+ o .: "title" <*>+ o .: "url" <*>+ o .: "action"+ parseJSON _ = mzero++instance ToJSON MR where+ toJSON mr = object+ [ "author" .= mrAuthor mr+ , "id" .= mrId mr+ , "repo" .= mrRepo mr+ , "user" .= mrRepoOwner mr+ , "title" .= mrTitle mr+ , "url" .= mrUrl mr+ , "action" .= mrAction mr+ ]++instance FromJSON FeedItem where+ parseJSON (Object o) =+ FeedItem <$>+ o .: "feed-label" <*>+ o .: "feed-title" <*>+ o .: "title" <*>+ o .: "author" <*>+ o .: "url"+ parseJSON _ = mzero++instance ToJSON FeedItem where+ toJSON (FeedItem fLabel fTitle title author url) = object+ [ "feed-label" .= fLabel+ , "feed-title" .= fTitle+ , "title" .= title+ , "author" .= author+ , "url" .= url+ ]++text :: Parser T.Text -> T.Text -> Parser T.Text+text parser expected = do+ got <- parser+ if got == expected+ then return got+ else mzero++instance FromJSON ExtEvent where+ parseJSON (Object o) =+ let kind = text $ o .: "type"+ in kind "push" *> (GitPush <$> o .: "data") <|>+ kind "tag" *> (GitTag <$> o .: "data") <|>+ kind "mr" *> (MergeRequest <$> o .: "data") <|>+ kind "news" *> (NewsItem <$> o .: "data")+ parseJSON _ = mzero++instance ToJSON ExtEvent where+ toJSON (GitPush commits) = object [ "type" .= ("push" :: T.Text)+ , "data" .= commits+ ]+ toJSON (GitTag tag) = object [ "type" .= ("tag" :: T.Text)+ , "data" .= tag+ ]+ toJSON (MergeRequest mr) = object [ "type" .= ("mr" :: T.Text)+ , "data" .= mr+ ]+ toJSON (NewsItem item) = object [ "type" .= ("news" :: T.Text)+ , "data" .= item+ ]++parse :: B.ByteString -> Either String ExtEvent+parse = eitherDecode++dispatchClient push _pushMany request =+ case parse $ rqBody request of+ Left e -> do+ putStrLn $ "Web listener source: Client: " ++ show e ++ ":"+ print $ rqBody request+ Right event -> push event
+ src/FunBot/Sources/WebListener/GitLab.hs view
@@ -0,0 +1,93 @@+{- This file is part of funbot.+ -+ - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.+ -+ - ♡ Copying is an act of love. Please copy, reuse and share.+ -+ - The author(s) have dedicated all copyright and related and neighboring+ - rights to this software to the public domain worldwide. This software is+ - distributed without any warranty.+ -+ - You should have received a copy of the CC0 Public Domain Dedication along+ - with this software. If not, see+ - <http://creativecommons.org/publicdomain/zero/1.0/>.+ -}++{-# LANGUAGE OverloadedStrings #-}++module FunBot.Sources.WebListener.GitLab+ ( dispatchGitLab+ )+where++import qualified Data.ByteString.Lazy.Char8 as BC+import Data.Maybe (fromMaybe)+import qualified Data.Text as T+import FunBot.Types+import Network.HTTP (Request (..))+import Network.URI+import qualified Web.Hook.GitLab as G++refToBranch :: T.Text -> T.Text+refToBranch ref = fromMaybe ref $ T.stripPrefix "refs/heads/" ref++refToTag :: T.Text -> T.Text+refToTag ref = fromMaybe ref $ T.stripPrefix "refs/tags/" ref++nl c = c == '\n' || c == '\r'++urlToOwner url =+ case parseAbsoluteURI url of+ Just (URI { uriPath = _ : p }) -> takeWhile (/= '/') p+ _ -> ""++makeCommit commit =+ let author = T.unpack $ G.authorName $ G.commitAuthor commit+ msg = T.unpack $ T.takeWhile (not . nl) $ G.commitMessage commit+ url = T.unpack $ G.commitUrl commit+ in Commit author msg url++makeBranch ref repo =+ let branch = T.unpack $ refToBranch ref+ repo' = T.unpack $ G.repoName repo+ owner = urlToOwner $ T.unpack $ G.repoHomepage repo+ in Branch branch repo' owner++makeTag ref repo user =+ let user' = T.unpack user+ ref' = T.unpack $ refToTag ref+ repo' = T.unpack $ G.repoName repo+ owner = urlToOwner $ T.unpack $ G.repoHomepage repo+ in GitTag $ Tag user' ref' repo' owner++makeMR mre =+ let mr = G.mreRequest mre+ author = T.unpack $ G.userName $ G.mreUser mre+ iid = G.mrId mr+ repo = T.unpack $ G.mepName $ G.mrTarget mr+ owner = T.unpack $ G.mepNamespace $ G.mrTarget mr+ title = T.unpack $ T.takeWhile (not . nl) $ G.mrTitle mr -- to be safe+ url = T.unpack $ G.mrUrl mr+ action = T.unpack $ G.mreAction mre+ in MergeRequest $ MR author iid repo owner title url action++dispatchPush push _pushMany p =+ let commits = map makeCommit $ G.pushCommits p+ branch = makeBranch (G.pushRef p) (G.pushRepository p)+ in push $ GitPush $ Push branch commits++dispatchTag push pushMany p =+ push $ makeTag (G.pushRef p) (G.pushRepository p) (G.pushUserName p)++dispatchMR push pushMany e = push $ makeMR e++dispatchGitLab push pushMany request =+ case G.parse $ rqBody request of+ Left e -> do+ putStr "Web hook source: GitLab: "+ print e+ BC.putStrLn $ rqBody request+ Right (G.EventPush e) -> dispatchPush push pushMany e+ Right (G.EventPushTag e) -> dispatchTag push pushMany e+ Right (G.EventIssue e) -> putStrLn ">>> GitLab Issue"+ Right (G.EventMergeRequest e) -> dispatchMR push pushMany e
+ src/FunBot/Sources/WebListener/Gogs.hs view
@@ -0,0 +1,56 @@+{- This file is part of funbot.+ -+ - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.+ -+ - ♡ Copying is an act of love. Please copy, reuse and share.+ -+ - The author(s) have dedicated all copyright and related and neighboring+ - rights to this software to the public domain worldwide. This software is+ - distributed without any warranty.+ -+ - You should have received a copy of the CC0 Public Domain Dedication along+ - with this software. If not, see+ - <http://creativecommons.org/publicdomain/zero/1.0/>.+ -}++{-# LANGUAGE OverloadedStrings #-}++module FunBot.Sources.WebListener.Gogs+ ( dispatchGogs+ )+where++import Data.Maybe (fromMaybe)+import qualified Data.Text as T+import FunBot.Types+import Network.HTTP (Request (..))+import qualified Web.Hook.Gogs as G++refToBranch :: T.Text -> T.Text+refToBranch ref = fromMaybe ref $ T.stripPrefix "refs/heads/" ref++nl c = c == '\n' || c == '\r'++makeCommit commit =+ let author = T.unpack $ G.userName $ G.commitAuthor commit+ msg = T.unpack $ T.takeWhile (not . nl) $ G.commitMessage commit+ url = T.unpack $ G.commitUrl commit+ in Commit author msg url++makeBranch ref repo =+ let branch = T.unpack $ refToBranch ref+ repo' = T.unpack $ G.repoName repo+ owner = T.unpack $ G.userUsername $ G.repoOwner repo+ in Branch branch repo' owner++fromGogs push =+ let commits = map makeCommit $ G.pushCommits push+ branch = makeBranch (G.pushRef push) (G.pushRepository push)+ in GitPush $ Push branch (reverse commits)++dispatchGogs push _pushMany request =+ case G.parse $ rqBody request of+ Left e -> do+ putStrLn $ "Web hook source: Gogs: " ++ show e ++ ":"+ print $ rqBody request+ Right pushInfo -> push $ fromGogs pushInfo
+ src/FunBot/Types.hs view
@@ -0,0 +1,192 @@+{- This file is part of funbot.+ -+ - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.+ -+ - ♡ Copying is an act of love. Please copy, reuse and share.+ -+ - The author(s) have dedicated all copyright and related and neighboring+ - rights to this software to the public domain worldwide. This software is+ - distributed without any warranty.+ -+ - You should have received a copy of the CC0 Public Domain Dedication along+ - with this software. If not, see+ - <http://creativecommons.org/publicdomain/zero/1.0/>.+ -}++module FunBot.Types+ ( Filter (..)+ , BranchFilter+ , PushAnnSpec (..)+ , NewsItemFields (..)+ , NewsAnnSpec (..)+ , BotEnv (..)+ , Settings (..)+ , SettingsOption+ , SettingsTree+ , Memo (..)+ , BotState (..)+ , Branch (..)+ , Commit (..)+ , Push (..)+ , Tag (..)+ , MR (..)+ , FeedItem (..)+ , ExtEvent (..)+ , BotSession+ , ExtEventSource+ , ExtEventHandler+ )+where++import qualified Data.HashMap.Lazy as M+import qualified Data.HashSet as S+import Data.Settings.Types (Section (..), Option (..))+import Data.Time.Clock (UTCTime)+import Network.IRC.Fun.Bot.Types (Session, EventSource, EventHandler)++-- | Generic item filter+data Filter a = Accept [a] | Reject [a]++-- | Chooser for repo branches whose commits should be announced to IRC+type BranchFilter = Filter String++-- | Configuration for announcing a git repo's commits to a specific channel+data PushAnnSpec = PushAnnSpec+ { -- | IRC channel into which to announce+ pAnnChannel :: String+ -- Branch filter to choose which branches to announce+ , pAnnBranches :: BranchFilter+ -- Whether to report all commits in a push ('True') or shorten long+ -- pushes to avoid channel spam ('False').+ , pAnnAllCommits :: Bool+ }++-- | Pick news item fields to display+data NewsItemFields = NewsItemFields+ { dispFeedTitle :: Bool+ , dispAuthor :: Bool+ , dispUrl :: Bool+ }++-- | Configuration for announcing news items+data NewsAnnSpec = NewsAnnSpec+ { -- | IRC channels into which to announce+ nAnnChannels :: [String]+ -- | Filter for picking news item fields to display or hide+ , nAnnFields :: NewsItemFields+ }++-- | Read-only custom bot environment+data BotEnv = BotEnv+ { -- | Port on which the web hook event source will run+ webHookSourcePort :: Int+ -- | Maps a Git repo name+owner to annoucement details+ , gitAnnChans :: M.HashMap (String, String) [PushAnnSpec]+ -- | An 'IO' action which schedules saving settings to disk. There is a+ -- wrapper in the 'Session' monad which uses this with the settings+ -- stored in bot state, so you probably don't need this field directly.+ , saveSettings :: Settings -> IO ()+ -- | An 'IO' action which schedules saving memos to disk. There is a+ -- wrapper in the 'Session' monad which uses this with the memos+ -- stored in bot state, so you probably don't need this field directly.+ , saveMemos :: M.HashMap String [Memo] -> IO ()+ -- | Filename for logging feed listener errors+ , feedErrorLogFile :: FilePath+ }++-- | User-modifiable bot behavior settings+data Settings = Settings+ { -- | Maps a feed label to its URL and announcement details+ watchedFeeds :: M.HashMap String (String, NewsAnnSpec)+ }++-- | Alias for the settings option type+type SettingsOption = Option BotSession++-- | Alias for the settings section type+type SettingsTree = Section BotSession++-- | A message left to an offline user, for them to read later.+data Memo = Memo+ { memoTime :: String+ , memoSender :: String+ , memoRecvIn :: Maybe String+ , memoSendIn :: Maybe String+ , memoContent :: String+ --, memoRead :: Bool+ }++-- | Read-write custom bot state+data BotState = BotState+ { -- | User-modifiable bot behavior settings+ settings :: Settings+ -- | Settings tree and access definition for UI+ , stree :: SettingsTree+ -- | Memos waiting for users to connect.+ , memos :: M.HashMap String [Memo]+ }++data Branch = Branch+ { branchName :: String+ , branchRepo :: String+ , branchRepoOwner :: String+ }+ deriving Show++data Commit = Commit+ { commitAuthor :: String+ , commitTitle :: String+ , commitUrl :: String+ }+ deriving Show++data Push = Push+ { pushBranch :: Branch+ , pushCommits :: [Commit]+ }+ deriving Show++data Tag = Tag+ { tagAuthor :: String+ , tagRef :: String+ , tagRepo :: String+ , tagRepoOwner :: String+ }+ deriving Show++data MR = MR+ { mrAuthor :: String+ , mrId :: Int+ , mrRepo :: String+ , mrRepoOwner :: String+ , mrTitle :: String+ , mrUrl :: String+ , mrAction :: String+ }+ deriving Show++data FeedItem = FeedItem+ { itemFeedLabel :: String+ , itemFeedTitle :: Maybe String+ , itemTitle :: String+ , itemAuthor :: Maybe String+ , itemUrl :: Maybe String+ }+ deriving Show++-- | An event coming from one of the extra event sources.+data ExtEvent+ = GitPush Push+ | GitTag Tag+ | MergeRequest MR+ | NewsItem FeedItem+ deriving Show++-- | Shortcut alias for bot session monad+type BotSession = Session BotEnv BotState++-- | Shortcut alias for event source function type+type ExtEventSource = EventSource BotEnv BotState ExtEvent++-- | Shortcut alias for event handler function type+type ExtEventHandler = EventHandler BotEnv BotState ExtEvent
+ src/FunBot/Util.hs view
@@ -0,0 +1,40 @@+{- This file is part of funbot.+ -+ - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.+ -+ - ♡ Copying is an act of love. Please copy, reuse and share.+ -+ - The author(s) have dedicated all copyright and related and neighboring+ - rights to this software to the public domain worldwide. This software is+ - distributed without any warranty.+ -+ - You should have received a copy of the CC0 Public Domain Dedication along+ - with this software. If not, see+ - <http://creativecommons.org/publicdomain/zero/1.0/>.+ -}++module FunBot.Util+ ( (!?)+ , passes+ , passesBy+ )+where++import Data.Maybe (listToMaybe)+import FunBot.Types++-- List index operator, starting from 0. Like @!!@ but returns a 'Maybe'+-- instead of throwing an exception. On success, returns 'Just' the item. On+-- out-of-bounds index, returns 'Nothing'.+(!?) :: [a] -> Int -> Maybe a+l !? i = listToMaybe $ drop i l++-- | Check whether a value passes a given filter.+passes :: Eq a => a -> Filter a -> Bool+v `passes` (Accept l) = v `elem` l+v `passes` (Reject l) = v `notElem` l++-- | Like 'passes', but using a given predicate to compare items.+passesBy :: (a -> a -> Bool) -> a -> Filter a -> Bool+passesBy p v (Accept l) = any (p v) l+passesBy p v (Reject l) = all (not . p v) l
+ src/Main.hs view
@@ -0,0 +1,89 @@+{- This file is part of funbot.+ -+ - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.+ -+ - ♡ Copying is an act of love. Please copy, reuse and share.+ -+ - The author(s) have dedicated all copyright and related and neighboring+ - rights to this software to the public domain worldwide. This software is+ - distributed without any warranty.+ -+ - You should have received a copy of the CC0 Public Domain Dedication along+ - with this software. If not, see+ - <http://creativecommons.org/publicdomain/zero/1.0/>.+ -}++module Main (main) where++import Control.Monad.IO.Class (liftIO)+import qualified Data.HashMap.Lazy as M (empty)+import Data.Settings.Section (empty)+import FunBot.Commands (commandSet)+import qualified FunBot.Config as C+import FunBot.ExtHandlers (handler)+import qualified FunBot.IrcHandlers as H+import FunBot.Memos+import FunBot.Settings+import FunBot.Sources+import FunBot.Types+import Network.IRC.Fun.Bot (runBot)+import Network.IRC.Fun.Bot.Behavior (defaultBehavior)+import Network.IRC.Fun.Bot.EventMatch+import Network.IRC.Fun.Bot.Types (Behavior (..))++-- | Bot environment content+env saveS saveM = BotEnv+ { webHookSourcePort = C.webListenerPort+ , gitAnnChans = C.devAnnChans+ , saveSettings = saveS+ , saveMemos = saveM+ , feedErrorLogFile = C.feedErrorLogFile+ }++-- | Initial content of the bot state+initialState sets ms = BotState+ { settings = sets+ , stree = empty+ , memos = ms+ }++-- | Event detector specification+matchers =+ [ matchPrefixedCommandC+ , matchRefCommandFromSetC+ , matchRef+ , defaultMatch+ ]++-- | Bot behavior definition+behavior = defaultBehavior+ { handleBotMsg = H.handleBotMsg+ , handleJoin = H.handleJoin+ --, handlePart = H.handlePart+ --, handleQuit = H.handleQuit+ , commandSets = [commandSet]+ --, handleNames = H.handleNames+ }++-- | Additional events sources+mkSources state =+ [ webListenerSource+ , feedWatcherSource C.feedErrorLogFile state+ ]++main = do+ liftIO $ putStrLn "Loading bot settings"+ sets <- loadBotSettings+ ms <- loadBotMemos+ saveS <- mkSaveBotSettings+ saveM <- mkSaveBotMemos+ let state = initialState sets ms+ runBot+ C.configuration+ matchers+ behavior+ (mkSources state)+ handler+ (env saveS saveM)+ state+ initTree