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 { mkDerivation, aeson, amqp, base, bytestring, containers, dhall
, hedgehog, hspec, hspec-hedgehog, lens, lens-aeson, lib, mtl , hedgehog, hspec, hspec-hedgehog, lens, lens-aeson, lib, mtl
, pipes, reddit-lib, sqlite-simple, text, wreq , pipes, sqlite-simple, text, wreq
}: }:
mkDerivation { mkDerivation {
pname = "reddit-pub"; pname = "reddit-pub";
@ -8,10 +8,9 @@ mkDerivation {
src = ./.; src = ./.;
isLibrary = true; isLibrary = true;
isExecutable = true; isExecutable = true;
enableSeparateDataOutput = true;
libraryHaskellDepends = [ libraryHaskellDepends = [
aeson amqp base bytestring containers dhall lens lens-aeson mtl aeson amqp base bytestring containers dhall lens lens-aeson mtl
pipes reddit-lib sqlite-simple text wreq pipes sqlite-simple text wreq
]; ];
executableHaskellDepends = [ base ]; executableHaskellDepends = [ base ];
testHaskellDepends = [ testHaskellDepends = [

View File

@ -12,10 +12,8 @@
{ {
overlay = final: prev: { overlay = final: prev: {
haskellPackages = prev.haskellPackages.override ( old: { haskellPackages = prev.haskellPackages.override ( old: {
overrides = final.lib.composeExtensions ( old.overrides or (_: _: {})) (f: p: rec { overrides = final.lib.composeExtensions ( old.overrides or (_: _: {})) (f: p: {
reddit-pub = f.callPackage ./reddit_pub {}; reddit-pub = f.callPackage ./. {};
reddit-lib = f.callPackage ./reddit_lib {};
reddit-tags = f.callPackage ./reddit_tags {};
}); });
} ); } );
}; };
@ -30,13 +28,12 @@
packages.reddit-pub = pkgs.haskell.lib.justStaticExecutables hp.reddit-pub; packages.reddit-pub = pkgs.haskell.lib.justStaticExecutables hp.reddit-pub;
packages.reddit-pub-dhall = pkgs.dhallPackages.callPackage ./dhall.nix {}; packages.reddit-pub-dhall = pkgs.dhallPackages.callPackage ./dhall.nix {};
packages.reddit-tags = pkgs.haskell.lib.justStaticExecutables hp.reddit-tags;
defaultPackage = packages.reddit-pub; defaultPackage = packages.reddit-pub;
devShell = devShell =
hp.shellFor { hp.shellFor {
packages = h: [h.reddit-pub h.reddit-tags]; packages = h: [h.reddit-pub];
withHoogle = true; withHoogle = true;
buildInputs = with pkgs; [ buildInputs = with pkgs; [
dhall-lsp-server dhall-lsp-server

View File

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

View File

@ -1,27 +1,11 @@
{ lib, config, pkgs, ... }: { 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 = { services.rabbitmq = {
enable = true; enable = true;
listenAddress = "0.0.0.0"; listenAddress = "0.0.0.0";
managementPlugin.enable = true; managementPlugin.enable = true;
cookie = "dontusethisinprod";
}; };
networking.firewall.allowedTCPPorts = [ 5672 15672 ]; networking.firewall.allowedTCPPorts = [ 5672 15672 ];
environment.systemPackages = [ setup ];
} }

View File

@ -32,6 +32,7 @@ library
Data.Deriving.Aeson Data.Deriving.Aeson
Network.Reddit Network.Reddit
Data.SubReddit Data.SubReddit
Publish
Membership Membership
-- Modules included in this library but not exported. -- Modules included in this library but not exported.
@ -52,7 +53,6 @@ library
, pipes , pipes
, containers , containers
, sqlite-simple , sqlite-simple
, reddit-lib
hs-source-dirs: src hs-source-dirs: src
default-language: Haskell2010 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.Reddit (RedditId(RedditId), publishEntries)
import Network.Wreq.Session (newSession) import Network.Wreq.Session (newSession)
import Reddit.Publish (Publish(..)) import Publish (Publish(..))
import Text.Printf (printf) import Text.Printf (printf)
import Data.ByteString.Lazy (ByteString) import Data.ByteString.Lazy (ByteString)

View File

@ -14,7 +14,7 @@ import Network.Wreq hiding (getWith)
import Network.Wreq.Session (Session, getWith) import Network.Wreq.Session (Session, getWith)
import Pipes (Producer, (>->), for, runEffect) import Pipes (Producer, (>->), for, runEffect)
import qualified Pipes.Prelude as P import qualified Pipes.Prelude as P
import Reddit.Publish import Publish
import Data.Maybe (maybeToList) import Data.Maybe (maybeToList)
import Control.Monad.Trans (liftIO) import Control.Monad.Trans (liftIO)
import Database.SQLite.Simple.ToField (ToField) import Database.SQLite.Simple.ToField (ToField)

View File

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