first working commit

.gitignore

@@ -28,3 +28,5 @@ cabal.project.local~
 result
 result-*
 
+# Other Stuff
+secret/

CHANGELOG.md

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

app/Config.hs

@@ -0,0 +1,29 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Config where
+  
+import qualified Toml
+import Toml(TomlCodec, (.=))
+import qualified Data.Text as T
+
+data Config = Config {
+  mailDomain :: String
+  ,mailUsername :: String
+  ,mailPassword :: String
+  ,mailTo       :: T.Text
+  ,mailFrom     :: T.Text
+  } deriving Show
+
+configCodec :: TomlCodec Config
+configCodec = Config
+  <$> Toml.string "mailDomain"   .= mailDomain
+  <*> Toml.string "mailUser"     .= mailUsername
+  <*> Toml.string "mailPassword" .= mailPassword
+  <*> Toml.text   "mailTo"       .= mailTo
+  <*> Toml.text   "mailFrom"     .= mailFrom
+
+parseFile :: String -> IO (Either String Config)
+parseFile path = do
+  config <- Toml.decodeFileEither configCodec path
+  case config of
+    Left errors -> return $ Left $ unwords $ fmap show errors
+    Right x -> return $ Right $ x

app/Main.hs

@@ -0,0 +1,65 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Main where
+  
+import TableParser
+import Requester
+import Config
+import Data.Time.Calendar
+import Data.Time.Clock
+import qualified Data.List as L
+import System.IO
+import qualified Data.Text as T
+import qualified Data.Text.IO as T
+import qualified Data.Text.Lazy as LT
+import Data.Maybe
+import System.Environment
+import System.Exit
+import Data.Time.Format.ISO8601
+import Sender
+
+isChoirThisWeek :: Day -> Day -> Bool
+isChoirThisWeek today day = today <= day && diffDays day today <= 6
+  
+getToday :: IO Day
+getToday = utctDay <$> getCurrentTime
+
+reportError :: String -> IO ()
+reportError err = hPutStr stderr err
+
+main :: IO ()
+main = do
+  args <- getArgs
+  if length args /= 1
+  then
+    die "We need exactly one argument"
+  else do
+    configE <- parseFile (head args)
+    case configE of
+      Left text -> hPutStr stderr text
+      Right config -> do
+        bs <- request
+        let eitherTable = parseBString bs
+        case eitherTable of
+          Left x -> reportError x
+          Right table -> do
+            today <- getToday
+            maybe 
+              (T.putStr "Keine Probe :(")
+              (\record -> send (mailDomain config) (mailUsername config) (mailPassword config) (mailTo config) (mailFrom config) (mailSubject record) (mailText record))
+              (L.find ((isChoirThisWeek today) . date) table)
+
+mailText :: MailRecord -> LT.Text
+mailText record = LT.fromStrict $T.concat ["Guten Morgen,\n\n"
+                           , announcement record
+                           ,"\n\ndiesen Donnerstag\n\nDurchsingen: "
+                           ,song1 record
+                           ,", "
+                           ,song2 record
+                           ,"\nStimmproben: "
+                           ,voice1 record
+                           ,", "
+                           ,voice2 record
+                           ,"\n\nLG\nMalte\n" ]
+
+mailSubject :: MailRecord -> T.Text
+mailSubject record = T.concat ["Donnerstag ", T.pack $ iso8601Show $ date record]

app/Requester.hs

@@ -0,0 +1,19 @@
+{-# LANGUAGE OverloadedStrings, DataKinds#-}
+module Requester(request) where
+  
+import Network.HTTP.Req
+-- import qualified Data.Text as T
+import Control.Monad.IO.Class(MonadIO)
+import qualified Data.ByteString as B
+import Text.URI
+
+url :: Url 'Https
+url = https "md.darmstadt.ccc.de" /: "mathechor-probenplanung" /: "download"
+
+
+
+requestRunner :: (MonadIO m)=> m BsResponse
+requestRunner = runReq defaultHttpConfig $ req GET url NoReqBody bsResponse mempty
+
+request :: (MonadIO m) => m B.ByteString
+request = fmap responseBody requestRunner

app/Sender.hs

@@ -0,0 +1,18 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Sender where
+  
+import Network.Mail.Mime
+import Network.Mail.SMTP
+import qualified Data.Text as ST
+import qualified Data.Text.Lazy as LT
+
+
+generateMail :: ST.Text -> ST.Text -> ST.Text -> LT.Text -> Mail
+generateMail to from subj = simpleMail' (Address Nothing to) (Address Nothing from) subj
+
+--     domain -> Username -> password -> To  -> From   -> Subject -> Body
+send :: String -> String -> String -> ST.Text -> ST.Text -> ST.Text -> LT.Text -> IO ()
+send domain user pass to from subj body = sendMailWithLoginTLS domain user pass mail
+  where
+    mail = generateMail to from subj body
+

app/TableParser.hs

@@ -0,0 +1,88 @@
+module TableParser(MailRecord(..), parseBString, parseTable) where
+
+import qualified Text.Parsec as P
+-- import qualified Text.Parsec.Char as P
+import qualified Text.Parsec.Text as P
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as T
+import qualified Data.Time.Calendar as D
+import qualified Data.ByteString as B
+import Control.Monad
+
+
+data MailRecord = MailRecord {
+  date :: D.Day,
+  voice1 :: T.Text,
+  voice2 :: T.Text,
+  song1 :: T.Text,
+  song2 :: T.Text,
+  announcement :: T.Text
+  } deriving (Show)
+
+seperator :: Char
+seperator = '\t'
+
+sepParser :: P.Parser ()
+sepParser = void $ P.char seperator
+
+textCellParser :: P.Parser T.Text
+textCellParser = fmap T.pack $ P.many $ P.noneOf [seperator,'\n','\r']
+
+dateCellParser :: P.Parser D.Day
+dateCellParser = do
+  year <- parseYear
+  _ <- P.char '-'
+  month <- parseMonth
+  _ <- P.char '-'
+  day <- parseDay
+  return $ D.fromGregorian year month day
+
+parseYear :: P.Parser Integer
+parseYear = read <$> P.count 4 P.digit
+
+parseMonth :: P.Parser Int
+parseMonth = read <$> P.count 2 P.digit
+
+parseDay :: P.Parser Int
+parseDay = read <$> P.count 2 P.digit
+
+parseRow :: P.Parser MailRecord
+parseRow = do
+  date <- dateCellParser
+  sepParser
+  voice1 <- textCellParser
+  sepParser
+  voice2 <- textCellParser
+  sepParser
+  song1 <- textCellParser
+  sepParser
+  song2 <- textCellParser
+  sepParser
+  announcments <- textCellParser
+  return $ MailRecord date voice1 voice2 song1 song2 announcments
+
+parseFirstRow :: P.Parser ()
+parseFirstRow = void (P.string "Datum\tStimmprobe 1\tStimmprobe 2\tLied 1\tLied 2\tWeitere Ansagen" >> P.endOfLine)
+
+parseTable :: P.Parser [MailRecord]
+parseTable = do
+  parseFirstRow
+  x <- parseRow `P.sepEndBy` P.endOfLine
+  P.eof
+  return x
+
+textToMailRecord :: T.Text -> Either String [MailRecord]
+textToMailRecord t = case P.parse parseTable "" t of
+  Left x -> Left $ show x
+  Right x -> Right x
+
+
+parseBString :: B.ByteString -> Either String [MailRecord]
+parseBString t = do
+  text <- toText t
+  textToMailRecord text
+
+toText :: B.ByteString -> Either String T.Text
+toText t = case T.decodeUtf8' t of
+  Left x -> Left $ show x
+  Right x -> Right x

choirMail.cabal

@@ -0,0 +1,95 @@
+cabal-version:      3.0
+-- The cabal-version field refers to the version of the .cabal specification,
+-- and can be different from the cabal-install (the tool) version and the
+-- Cabal (the library) version you are using. As such, the Cabal (the library)
+-- version used must be equal or greater than the version stated in this field.
+-- Starting from the specification version 2.2, the cabal-version field must be
+-- the first thing in the cabal file.
+
+-- Initial package description 'choirMail' generated by
+-- 'cabal init'. For further documentation, see:
+--   http://haskell.org/cabal/users-guide/
+--
+-- The name of the package.
+name:               choirMail
+
+-- The package version.
+-- See the Haskell package versioning policy (PVP) for standards
+-- guiding when and how versions should be incremented.
+-- https://pvp.haskell.org
+-- PVP summary:     +-+------- breaking API changes
+--                  | | +----- non-breaking API additions
+--                  | | | +--- code changes with no API change
+version:            0.1.0.0
+
+-- A short (one-line) description of the package.
+-- synopsis:
+
+-- A longer description of the package.
+-- description:
+
+-- URL for the project homepage or repository.
+homepage:           "https://git.nerfingen.de/nerf/choirMail"
+
+-- The license under which the package is released.
+license:            GPL-3.0-or-later
+
+-- The file containing the license text.
+license-file:       LICENSE
+
+-- The package author(s).
+author:             Dennis Frieberg
+
+-- An email address to which users can send suggestions, bug reports, and patches.
+maintainer:         nerfingen@yahoo.de
+
+-- A copyright notice.
+-- copyright:
+category:           Web
+build-type:         Simple
+
+-- Extra doc files to be distributed with the package, such as a CHANGELOG or a README.
+extra-doc-files:    CHANGELOG.md
+
+-- Extra source files to be distributed with the package, such as examples, or a tutorial module.
+-- extra-source-files:
+
+common warnings
+    ghc-options: -Wall
+
+executable choirMail
+    -- Import common warning flags.
+    import:           warnings
+
+    -- .hs or .lhs file containing the Main module.
+    main-is:          Main.hs
+
+    -- Modules included in this executable, other than Main.
+    other-modules:    Config
+                      , TableParser
+                      , Requester
+                      , Sender
+
+    -- LANGUAGE extensions used by modules in this package.
+    -- other-extensions:
+
+    -- Other library packages from which modules are imported.
+    -- ^>=4.15.1.0
+    build-depends:    base ^>=4.15.1.0
+                      ,tomland >= 1.3.3.0
+                      ,smtp-mail
+                      ,optparse-applicative
+                      ,req
+                      ,parsec
+                      ,text
+                      ,time
+                      ,bytestring
+                      ,mime-mail
+                      ,modern-uri
+
+
+    -- Directories containing source files.
+    hs-source-dirs:   app
+
+    -- Base language which the package is written in.
+    default-language: Haskell2010

choirMail.nix

@@ -0,0 +1,17 @@
+{ mkDerivation, base, bytestring, lib, mime-mail, modern-uri
+, optparse-applicative, parsec, req, smtp-mail, text, time, tomland
+}:
+mkDerivation {
+  pname = "choirMail";
+  version = "0.1.0.0";
+  src = ./.;
+  isLibrary = false;
+  isExecutable = true;
+  executableHaskellDepends = [
+    base bytestring mime-mail modern-uri optparse-applicative parsec
+    req smtp-mail text time tomland
+  ];
+  homepage = ""https://git.nerfingen.de/nerf/choirMail"";
+  license = lib.licenses.gpl3Plus;
+  mainProgram = "choirMail";
+}

default.nix

@@ -0,0 +1,2 @@
+{ pkgs , compiler ? "ghc902"}:
+  pkgs.haskell.packages.${compiler}.callPackage ./choirMail.nix { }

flake.lock

@@ -0,0 +1,43 @@
+{
+  "nodes": {
+    "flake-utils": {
+      "locked": {
+        "lastModified": 1667395993,
+        "narHash": "sha256-nuEHfE/LcWyuSWnS8t12N1wc105Qtau+/OdUAjtQ0rA=",
+        "owner": "numtide",
+        "repo": "flake-utils",
+        "rev": "5aed5285a952e0b949eb3ba02c12fa4fcfef535f",
+        "type": "github"
+      },
+      "original": {
+        "owner": "numtide",
+        "repo": "flake-utils",
+        "type": "github"
+      }
+    },
+    "nixpkgs": {
+      "locked": {
+        "lastModified": 1667639549,
+        "narHash": "sha256-frqZKSG/933Ctwl9voSZnXDwo8CqddXcjQhnCzwNqaM=",
+        "owner": "NixOS",
+        "repo": "nixpkgs",
+        "rev": "cae3751e9f74eea29c573d6c2f14523f41c2821a",
+        "type": "github"
+      },
+      "original": {
+        "owner": "NixOS",
+        "ref": "nixpkgs-unstable",
+        "repo": "nixpkgs",
+        "type": "github"
+      }
+    },
+    "root": {
+      "inputs": {
+        "flake-utils": "flake-utils",
+        "nixpkgs": "nixpkgs"
+      }
+    }
+  },
+  "root": "root",
+  "version": 7
+}

flake.nix

@@ -0,0 +1,82 @@
+{
+  description = "choir Mail automatisation";
+
+  inputs = {
+    nixpkgs.url = github:NixOS/nixpkgs/nixpkgs-unstable;
+    flake-utils.url = github:numtide/flake-utils;
+  };
+
+  outputs = {self, nixpkgs, flake-utils} :
+  let
+    # name to be used as identifier for editor environments and such
+    name = "Application";
+    compiler = "ghc902";
+
+  in
+  flake-utils.lib.eachDefaultSystem ( system:
+    let
+      pkgs = import nixpkgs {inherit system;};
+      hpkgs = pkgs.haskell.packages.${compiler};
+    in {
+      packages = { default = (import ./default.nix) {inherit pkgs compiler;};};
+
+    
+      devShells =
+        rec {
+          # This sets the default devShell
+          default = kakoune;
+          kakoune =
+            let
+              haskell-language-server = hpkgs.haskell-language-server;
+              myKakoune =
+                 let
+                   # this could also be done by generating toml with the
+                   # nixpkgs lib, but I'm lazy
+                   kak-lsp-config = pkgs.writeTextFile {
+                     name = "kak-lsp-config.toml";
+                     text = ''
+                       [language.haskell]
+                       filetypes = ["haskell"]
+                       roots = ["Setup.hs", "stack.yaml", "*.cabal"]
+                       command = "haskell-language-server-wrapper"
+                       args = ["--lsp"]
+                     '';
+                   };
+                   config = pkgs.writeTextFile (rec {
+                     name = "kakrc.kak";
+                     destination = "/share/kak/autoload/${name}";
+                     text = ''
+                       colorscheme solarized-dark
+                       set global tabstop 2
+                       set global indentwidth 2
+                       # eval %sh{kak-lsp  --kakoune --session $kak_session -c ${kak-lsp-config}}
+                       eval %sh{kak-lsp --kakoune --session $kak_session -c ${kak-lsp-config} --log /tmp/kak-lpsLog -vvvv}
+                       hook global WinSetOption filetype=(haskell|nix) %{
+                         lsp-auto-hover-enable
+                         lsp-enable-window
+                       }
+                       add-highlighter global/ number-lines
+                       map global normal <c-p> ': fzf-mode<ret>'
+                     '';
+                   });
+                 in
+                   pkgs.kakoune.override {
+                     plugins = with pkgs.kakounePlugins; [fzf-kak kak-lsp config];
+                   };
+            in
+              pkgs.mkShell {
+                inputsFrom = [self.outputs.packages.${system}.default];
+                packages = [myKakoune haskell-language-server pkgs.git pkgs.fzf hpkgs.cabal2nix pkgs.cabal-install pkgs.zlib.dev];
+                # TODO only try to start the kakoune session if no session with that
+                # name exists
+                shellHook = ''
+                  alias ..="cd .."
+                  export KAKOUNE_CONFIG_DIR="/dev/null/"
+                  kak -d -s ${name} &
+                  alias vim="kak -c ${name}"
+                '';
+              };
+        };
+    }
+  );
+}