Compare commits
No commits in common. "d253cbaa8253e8ad6c994740568d041fa022a375" and "c9a7d79bcfa1dfe1128737366e0b170aa74b56a7" have entirely different histories.
d253cbaa82
...
c9a7d79bcf
@ -1 +0,0 @@
|
||||
packages: */*
|
@ -1,6 +1,6 @@
|
||||
{ mkDerivation, aeson, amqp, base, bytestring, containers, dhall
|
||||
, hedgehog, hspec, hspec-hedgehog, lens, lens-aeson, lib, mtl
|
||||
, pipes, reddit-lib, sqlite-simple, text, wreq
|
||||
, pipes, sqlite-simple, text, wreq
|
||||
}:
|
||||
mkDerivation {
|
||||
pname = "reddit-pub";
|
||||
@ -8,10 +8,9 @@ mkDerivation {
|
||||
src = ./.;
|
||||
isLibrary = true;
|
||||
isExecutable = true;
|
||||
enableSeparateDataOutput = true;
|
||||
libraryHaskellDepends = [
|
||||
aeson amqp base bytestring containers dhall lens lens-aeson mtl
|
||||
pipes reddit-lib sqlite-simple text wreq
|
||||
pipes sqlite-simple text wreq
|
||||
];
|
||||
executableHaskellDepends = [ base ];
|
||||
testHaskellDepends = [
|
@ -12,10 +12,8 @@
|
||||
{
|
||||
overlay = final: prev: {
|
||||
haskellPackages = prev.haskellPackages.override ( old: {
|
||||
overrides = final.lib.composeExtensions ( old.overrides or (_: _: {})) (f: p: rec {
|
||||
reddit-pub = f.callPackage ./reddit_pub {};
|
||||
reddit-lib = f.callPackage ./reddit_lib {};
|
||||
reddit-tags = f.callPackage ./reddit_tags {};
|
||||
overrides = final.lib.composeExtensions ( old.overrides or (_: _: {})) (f: p: {
|
||||
reddit-pub = f.callPackage ./. {};
|
||||
});
|
||||
} );
|
||||
};
|
||||
@ -30,13 +28,12 @@
|
||||
|
||||
packages.reddit-pub = pkgs.haskell.lib.justStaticExecutables hp.reddit-pub;
|
||||
packages.reddit-pub-dhall = pkgs.dhallPackages.callPackage ./dhall.nix {};
|
||||
packages.reddit-tags = pkgs.haskell.lib.justStaticExecutables hp.reddit-tags;
|
||||
|
||||
defaultPackage = packages.reddit-pub;
|
||||
|
||||
devShell =
|
||||
hp.shellFor {
|
||||
packages = h: [h.reddit-pub h.reddit-tags];
|
||||
packages = h: [h.reddit-pub];
|
||||
withHoogle = true;
|
||||
buildInputs = with pkgs; [
|
||||
dhall-lsp-server
|
||||
|
16
rabbitmq.nix
16
rabbitmq.nix
@ -1,27 +1,11 @@
|
||||
{ lib, config, pkgs, ... }:
|
||||
|
||||
let
|
||||
cookie = "dontusethisinprod";
|
||||
setup = pkgs.writeScriptBin "setup-rabbitmq.sh" ''
|
||||
rabbitmqctl --erlang-cookie "${cookie}" add_vhost reddit
|
||||
rabbitmqctl --erlang-cookie "${cookie}" add_user admin_user password
|
||||
rabbitmqctl --erlang-cookie "${cookie}" set_user_tags admin_user administrator
|
||||
rabbitmqctl --erlang-cookie "${cookie}" set_permissions -p / admin_user ".*" ".*" ".*"
|
||||
rabbitmqctl --erlang-cookie "${cookie}" set_permissions -p reddit admin_user ".*" ".*" ".*"
|
||||
|
||||
rabbitmqctl --erlang-cookie "${cookie}" add_user reddit_user password
|
||||
rabbitmqctl --erlang-cookie "${cookie}" set_permissions -p reddit reddit_user ".*" ".*" ".*"
|
||||
'';
|
||||
in
|
||||
{
|
||||
services.rabbitmq = {
|
||||
enable = true;
|
||||
listenAddress = "0.0.0.0";
|
||||
managementPlugin.enable = true;
|
||||
cookie = "dontusethisinprod";
|
||||
};
|
||||
networking.firewall.allowedTCPPorts = [ 5672 15672 ];
|
||||
|
||||
environment.systemPackages = [ setup ];
|
||||
}
|
||||
|
||||
|
@ -32,6 +32,7 @@ library
|
||||
Data.Deriving.Aeson
|
||||
Network.Reddit
|
||||
Data.SubReddit
|
||||
Publish
|
||||
Membership
|
||||
|
||||
-- Modules included in this library but not exported.
|
||||
@ -52,7 +53,6 @@ library
|
||||
, pipes
|
||||
, containers
|
||||
, sqlite-simple
|
||||
, reddit-lib
|
||||
hs-source-dirs: src
|
||||
default-language: Haskell2010
|
||||
|
@ -1,5 +0,0 @@
|
||||
# Revision history for reddit-lib
|
||||
|
||||
## 0.1.0.0 -- YYYY-mm-dd
|
||||
|
||||
* First version. Released on an unsuspecting world.
|
@ -1,10 +0,0 @@
|
||||
{ mkDerivation, base, lib }:
|
||||
mkDerivation {
|
||||
pname = "reddit-lib";
|
||||
version = "0.1.0.0";
|
||||
src = ./.;
|
||||
libraryHaskellDepends = [ base ];
|
||||
testHaskellDepends = [ base ];
|
||||
license = "unknown";
|
||||
hydraPlatforms = lib.platforms.none;
|
||||
}
|
@ -1,38 +0,0 @@
|
||||
cabal-version: 3.0
|
||||
name: reddit-lib
|
||||
version: 0.1.0.0
|
||||
synopsis:
|
||||
|
||||
-- A longer description of the package.
|
||||
-- description:
|
||||
homepage:
|
||||
|
||||
-- A URL where users can report bugs.
|
||||
-- bug-reports:
|
||||
license: NONE
|
||||
author: Mats Rauhala
|
||||
maintainer: mats.rauhala@iki.fi
|
||||
|
||||
-- A copyright notice.
|
||||
-- copyright:
|
||||
category: Web
|
||||
extra-source-files: CHANGELOG.md
|
||||
|
||||
library
|
||||
exposed-modules: Reddit.Publish
|
||||
|
||||
-- Modules included in this library but not exported.
|
||||
-- other-modules:
|
||||
|
||||
-- LANGUAGE extensions used by modules in this package.
|
||||
-- other-extensions:
|
||||
build-depends: base ^>=4.15.1.0
|
||||
hs-source-dirs: src
|
||||
default-language: Haskell2010
|
||||
|
||||
test-suite reddit-lib-test
|
||||
default-language: Haskell2010
|
||||
type: exitcode-stdio-1.0
|
||||
hs-source-dirs: test
|
||||
main-is: MyLibTest.hs
|
||||
build-depends: base ^>=4.15.1.0
|
@ -1,4 +0,0 @@
|
||||
module Main (main) where
|
||||
|
||||
main :: IO ()
|
||||
main = putStrLn "Test suite not yet implemented."
|
@ -1,5 +0,0 @@
|
||||
# Revision history for reddit-tags
|
||||
|
||||
## 0.1.0.0 -- YYYY-mm-dd
|
||||
|
||||
* First version. Released on an unsuspecting world.
|
@ -1,8 +0,0 @@
|
||||
module Main where
|
||||
|
||||
import qualified MyLib (someFunc)
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
putStrLn "Hello, Haskell!"
|
||||
MyLib.someFunc
|
@ -1,18 +0,0 @@
|
||||
{ mkDerivation, aeson, amqp, attoparsec, base, hspec, lens
|
||||
, lens-aeson, lib, mtl, reddit-lib, text, transformers
|
||||
}:
|
||||
mkDerivation {
|
||||
pname = "reddit-tags";
|
||||
version = "0.1.0.0";
|
||||
src = ./.;
|
||||
isLibrary = true;
|
||||
isExecutable = true;
|
||||
libraryHaskellDepends = [
|
||||
aeson amqp attoparsec base lens lens-aeson mtl reddit-lib text
|
||||
transformers
|
||||
];
|
||||
executableHaskellDepends = [ base ];
|
||||
testHaskellDepends = [ base hspec ];
|
||||
license = "unknown";
|
||||
hydraPlatforms = lib.platforms.none;
|
||||
}
|
@ -1,67 +0,0 @@
|
||||
cabal-version: 3.0
|
||||
name: reddit-tags
|
||||
version: 0.1.0.0
|
||||
synopsis:
|
||||
|
||||
-- A longer description of the package.
|
||||
-- description:
|
||||
homepage:
|
||||
|
||||
-- A URL where users can report bugs.
|
||||
-- bug-reports:
|
||||
license: NONE
|
||||
author: Mats Rauhala
|
||||
maintainer: mats.rauhala@iki.fi
|
||||
|
||||
-- A copyright notice.
|
||||
-- copyright:
|
||||
category: Web
|
||||
extra-source-files: CHANGELOG.md
|
||||
|
||||
library
|
||||
exposed-modules: MyLib
|
||||
Tags
|
||||
Transformer
|
||||
|
||||
-- Modules included in this library but not exported.
|
||||
-- other-modules:
|
||||
|
||||
-- LANGUAGE extensions used by modules in this package.
|
||||
-- other-extensions:
|
||||
build-depends: base ^>=4.15.1.0
|
||||
, amqp
|
||||
, reddit-lib
|
||||
, mtl
|
||||
, text
|
||||
, aeson
|
||||
, lens
|
||||
, lens-aeson
|
||||
, transformers
|
||||
, attoparsec
|
||||
, bytestring
|
||||
hs-source-dirs: src
|
||||
default-language: Haskell2010
|
||||
|
||||
executable reddit-tags
|
||||
main-is: Main.hs
|
||||
|
||||
-- Modules included in this executable, other than Main.
|
||||
-- other-modules:
|
||||
|
||||
-- LANGUAGE extensions used by modules in this package.
|
||||
-- other-extensions:
|
||||
build-depends:
|
||||
base ^>=4.15.1.0,
|
||||
reddit-tags
|
||||
|
||||
hs-source-dirs: app
|
||||
default-language: Haskell2010
|
||||
|
||||
test-suite reddit-tags-test
|
||||
default-language: Haskell2010
|
||||
type: exitcode-stdio-1.0
|
||||
hs-source-dirs: test
|
||||
main-is: MyLibTest.hs
|
||||
build-depends: base ^>=4.15.1.0
|
||||
, hspec
|
||||
, reddit-tags
|
@ -1,57 +0,0 @@
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
module MyLib (someFunc) where
|
||||
import System.Environment (lookupEnv)
|
||||
import Control.Monad.Trans.Maybe (MaybeT(..))
|
||||
import Network.AMQP
|
||||
import qualified Data.Text as T
|
||||
import Data.Text (Text)
|
||||
import Control.Exception (bracket)
|
||||
import Control.Concurrent (newEmptyMVar, readMVar)
|
||||
import Control.Monad (void)
|
||||
|
||||
import Control.Lens
|
||||
import Data.Aeson.Lens
|
||||
import Transformer
|
||||
import Data.ByteString.Lazy (ByteString)
|
||||
import Control.Category ((>>>))
|
||||
import Control.Arrow (arr, (&&&))
|
||||
import Tags (parseTags)
|
||||
|
||||
data AMQP = AMQP
|
||||
{ host :: String
|
||||
, vhost :: Text
|
||||
, username :: Text
|
||||
, password :: Text
|
||||
}
|
||||
|
||||
getAMQP :: IO (Maybe AMQP)
|
||||
getAMQP = runMaybeT $
|
||||
AMQP <$> lookupEnvM "AMQP_HOST" <*> lookupEnvMText "AMQP_VHOST" <*> lookupEnvMText "AMQP_USER" <*> lookupEnvMText "AMQP_PASS"
|
||||
where
|
||||
lookupEnvM = MaybeT . lookupEnv
|
||||
lookupEnvMText = fmap T.pack . lookupEnvM
|
||||
|
||||
tagTransformer :: Transformer IO ByteString ()
|
||||
tagTransformer =
|
||||
arrOpt (preview (key "content" . key "title" . _String))
|
||||
>>> arr id &&& arr parseTags
|
||||
>>> liftTransformer print
|
||||
|
||||
someFunc :: IO ()
|
||||
someFunc = do
|
||||
Just AMQP{..} <- getAMQP
|
||||
let rabbitConnect = openConnection host vhost username password
|
||||
bracket rabbitConnect closeConnection $ \conn -> do
|
||||
chan <- openChannel conn
|
||||
qos chan 0 1 False
|
||||
declareQueue chan newQueue {queueName="reddit_tags"}
|
||||
bindQueue chan "reddit_tags" "reddit_posts" "key"
|
||||
consumeMsgs chan "reddit_tags" Ack $ \(msg, env) -> do
|
||||
void $ runTransformer tagTransformer (msgBody msg)
|
||||
-- let body = msgBody msg
|
||||
-- let title = body ^? key "content" . key "title"
|
||||
-- print title
|
||||
-- print $ parseTags title
|
||||
ackEnv env
|
||||
void getLine
|
@ -1,18 +0,0 @@
|
||||
{-# LANGUAGE ApplicativeDo #-}
|
||||
module Tags (parseTags) where
|
||||
|
||||
import qualified Data.Attoparsec.Text as A
|
||||
import Data.Attoparsec.Text (Parser)
|
||||
import Data.Text (Text)
|
||||
import Data.Either (fromRight)
|
||||
|
||||
tag :: Parser Text
|
||||
tag = do
|
||||
A.skipWhile (/= '[')
|
||||
A.char '[' *> A.takeWhile (/= ']') <* A.char ']'
|
||||
|
||||
tags :: Parser [Text]
|
||||
tags = A.many1 tag
|
||||
|
||||
parseTags :: Text -> [Text]
|
||||
parseTags = fromRight [] . A.parseOnly tags
|
@ -1,18 +0,0 @@
|
||||
{-# LANGUAGE DerivingVia #-}
|
||||
module Transformer where
|
||||
|
||||
import Control.Category ( Category )
|
||||
import Control.Arrow ( Arrow, ArrowChoice, Kleisli(Kleisli) )
|
||||
import Control.Monad.Trans.Maybe ( MaybeT(MaybeT) )
|
||||
|
||||
newtype Transformer m a b = Transformer (a -> m (Maybe b))
|
||||
deriving (Category, Arrow, ArrowChoice) via Kleisli (MaybeT m)
|
||||
|
||||
arrOpt :: Applicative m => (a -> Maybe b) -> Transformer m a b
|
||||
arrOpt f = Transformer (pure . f)
|
||||
|
||||
liftTransformer :: Monad m => (a -> m b) -> Transformer m a b
|
||||
liftTransformer f = Transformer (fmap Just . f)
|
||||
|
||||
runTransformer :: Monad m => Transformer m a b -> a -> m (Maybe b)
|
||||
runTransformer (Transformer tr) = tr
|
@ -1,17 +0,0 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
module Main (main) where
|
||||
|
||||
import Tags (parseTags)
|
||||
import Test.Hspec
|
||||
|
||||
main :: IO ()
|
||||
main = hspec $
|
||||
describe "Parser" $ do
|
||||
it "Returns no results if there are no tags" $
|
||||
parseTags "foo bar" `shouldBe` []
|
||||
it "Returns a single result" $
|
||||
parseTags "[foo]" `shouldBe` ["foo"]
|
||||
it "Finds multiple results" $
|
||||
parseTags "[foo][bar]" `shouldBe` ["foo", "bar"]
|
||||
it "Finds multiple results with other text interleaved" $
|
||||
parseTags "prefix [foo] infix [bar] suffix" `shouldBe` ["foo", "bar"]
|
@ -43,7 +43,7 @@ import Network.AMQP
|
||||
)
|
||||
import Network.Reddit (RedditId(RedditId), publishEntries)
|
||||
import Network.Wreq.Session (newSession)
|
||||
import Reddit.Publish (Publish(..))
|
||||
import Publish (Publish(..))
|
||||
import Text.Printf (printf)
|
||||
import Data.ByteString.Lazy (ByteString)
|
||||
|
@ -14,7 +14,7 @@ import Network.Wreq hiding (getWith)
|
||||
import Network.Wreq.Session (Session, getWith)
|
||||
import Pipes (Producer, (>->), for, runEffect)
|
||||
import qualified Pipes.Prelude as P
|
||||
import Reddit.Publish
|
||||
import Publish
|
||||
import Data.Maybe (maybeToList)
|
||||
import Control.Monad.Trans (liftIO)
|
||||
import Database.SQLite.Simple.ToField (ToField)
|
@ -1,5 +1,5 @@
|
||||
{-# LANGUAGE DerivingVia #-}
|
||||
module Reddit.Publish where
|
||||
module Publish where
|
||||
|
||||
import Data.Functor.Contravariant
|
||||
import Data.Monoid (Ap(..))
|
Loading…
Reference in New Issue
Block a user