Compare commits

..

No commits in common. "d253cbaa8253e8ad6c994740568d041fa022a375" and "c9a7d79bcfa1dfe1128737366e0b170aa74b56a7" have entirely different histories.

44 changed files with 9 additions and 297 deletions

View File

@ -1 +0,0 @@
packages: */*

View File

@ -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 = [

View File

@ -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

View File

@ -1,2 +0,0 @@
cradle:
cabal:

View File

@ -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 ];
}

View File

@ -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

View File

@ -1,5 +0,0 @@
# Revision history for reddit-lib
## 0.1.0.0 -- YYYY-mm-dd
* First version. Released on an unsuspecting world.

View File

@ -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;
}

View File

@ -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

View File

@ -1,4 +0,0 @@
module Main (main) where
main :: IO ()
main = putStrLn "Test suite not yet implemented."

View File

@ -1,5 +0,0 @@
# Revision history for reddit-tags
## 0.1.0.0 -- YYYY-mm-dd
* First version. Released on an unsuspecting world.

View File

@ -1,8 +0,0 @@
module Main where
import qualified MyLib (someFunc)
main :: IO ()
main = do
putStrLn "Hello, Haskell!"
MyLib.someFunc

View File

@ -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;
}

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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"]

View File

@ -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)

View File

@ -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)

View File

@ -1,5 +1,5 @@
{-# LANGUAGE DerivingVia #-}
module Reddit.Publish where
module Publish where
import Data.Functor.Contravariant
import Data.Monoid (Ap(..))