Merge pull request #29 from BrechtSerckx/small-improvements

Small bugfixes and enhancements

recycle-client/app/Main.hs

@@ -5,14 +5,12 @@ module Main
   )
 where
 
-import Colog.Core (LogAction (..))
-import Colog.Message
+import qualified Colog
 import Control.Monad.IO.Class (liftIO)
 import qualified Data.Aeson as Aeson
 import qualified Data.ByteString.Lazy.Char8 as BSL8
 import Data.Foldable (for_)
 import Data.IORef (newIORef)
-import qualified Data.Text as T
 import Data.Time hiding (getZonedTime)
 import Network.HTTP.Client.TLS
   ( newTlsManagerWith,
@@ -34,7 +32,10 @@ main = do
   httpManager <- newTlsManagerWith tlsManagerSettings
   let clientEnv =
         mkClientEnv httpManager $ BaseUrl Https "api.fostplus.be" 443 ""
-      logAction = LogAction $ liftIO . putStrLn . T.unpack . fmtMessage
+      logAction =
+        Colog.cfilter
+          ((>= verbosity) . Colog.msgSeverity)
+          Colog.simpleMessageAction
 
   authResult <- newIORef Nothing
   let env = Env {..}

recycle-client/app/Opts.hs

@@ -3,10 +3,11 @@ module Opts
     parseOpts,
     ApiClientOpts (..),
     ApiClientCmd (..),
-    module Recycle.Types.Optparse
+    module Recycle.Types.Optparse,
   )
 where
 
+import Colog (Severity (..))
 import Data.Text (Text)
 import Numeric.Natural (Natural)
 import Options.Applicative
@@ -15,7 +16,8 @@ import Recycle.Types.Optparse
 
 data Opts = Opts
   { cmd :: ApiClientCmd,
-    apiClientOpts :: ApiClientOpts
+    apiClientOpts :: ApiClientOpts,
+    verbosity :: Severity
   }
 
 parseOpts :: IO Opts
@@ -27,6 +29,15 @@ pOpts :: Parser Opts
 pOpts = do
   cmd <- pApiClientCmd
   apiClientOpts <- pApiClientOpts
+  verbosity <-
+    option
+      auto
+      ( short 'v'
+          <> long "verbosity"
+          <> help "Log error messages of this severity and higher."
+          <> metavar "SEVERITY"
+          <> value Warning
+      )
   pure Opts {..}
 
 data ApiClientCmd

recycle-ics-ui/src/env.ts

@@ -1,3 +1,4 @@
 export const serverUrl = new URL(
   process.env.REACT_APP_RECYCLE_ICS_SERVER_URL || window.location.origin
 );
+export const nodeEnv = process.env.NODE_ENV;

recycle-ics-ui/src/section/address.tsx

@@ -48,11 +48,17 @@ const ZipcodeAutocompleter = (props: Partial<UseFormRegisterReturn>) => {
     <fieldset>
       <legend>Zip code</legend>
       {values.map((v) => (
-        <div>
-          <label key={v.id}>
-            <input type="radio" value={v.id} {...register("zipcodeId")} />
+        <div key={v.id}>
+          <label>
+            <input
+              type="radio"
+              value={v.id}
+              disabled={!v.available}
+              {...register("zipcodeId")}
+            />
             <span>
-              {v.city.names[lc]} ({v.code})
+              {v.code} {(v.names[0] || v.city.names)[lc]}, {v.city.names[lc]}
+              {v.available || " (Unavailable)"}
             </span>
           </label>
         </div>
@@ -100,8 +106,8 @@ const StreetAutocompleter = ({
     <fieldset>
       <legend>Street</legend>
       {values.map((v) => (
-        <div>
-          <label key={v.id}>
+        <div key={v.id}>
+          <label>
             <input type="radio" value={v.id} {...register("streetId")} />
             {v.names[lc]}
           </label>

recycle-ics-ui/src/section/description.tsx

@@ -173,16 +173,16 @@ export default function DescriptionSection() {
           support all features.
         </p>
         <h2>How-to</h2>
-        {howTos.map(({ title, summary, howTo }) => (
-          <>
+        {howTos.map(({ title, summary, howTo }, i) => (
+          <div key={i}>
             <h3>{title}</h3>
             <details>
               <>
                 <summary>{summary}</summary>
                 {howTo}
               </>
             </details>
-          </>
+          </div>
         ))}
       </section>
     </>

recycle-ics-ui/src/section/download.tsx

@@ -1,14 +1,18 @@
 import * as React from "react";
 import { useWatch } from "react-hook-form";
 import { FormInputs, inputsToForm, Form, formToParams } from "../types";
-import { serverUrl } from "../env";
+import { serverUrl, nodeEnv } from "../env";
 
 export default function DownloadSection() {
   const formInputs = useWatch() as FormInputs,
     mForm = inputsToForm(formInputs);
   const mkHttpLink = (form: Form): URL => {
       var url = new URL("/api/generate", serverUrl);
-      url.search = new URLSearchParams(formToParams(form)).toString();
+      try {
+        url.search = new URLSearchParams(formToParams(form)).toString();
+      } catch (error) {
+        console.error(error);
+      }
       return url;
     },
     mkWebcalLink = (form: Form): URL => {
@@ -40,6 +44,14 @@ export default function DownloadSection() {
             </a>
           </p>
         )}
+        {nodeEnv === "development" && (
+          <>
+            <h3>Raw form:</h3>
+            <pre>{JSON.stringify(formInputs, null, 2)}</pre>
+            <h3>Structured form:</h3>
+            <pre>{JSON.stringify(mForm, null, 2)}</pre>
+          </>
+        )}
       </section>
     </>
   );

recycle-ics-ui/src/section/encoding.tsx

@@ -187,7 +187,7 @@ const TodoFullDayInputs = ({
         <TodoDaysBeforeInput
           label="Days before"
           disabled={!(isParentChecked && isChecked)}
-          {...register("feTodoDueDaysBefore", {
+          {...register("feTodoDueDateDaysBefore", {
             required: isParentChecked && isChecked,
           })}
         />
@@ -215,14 +215,14 @@ const TodoSpecificTimeInputs = ({
         <TodoDaysBeforeInput
           label="Days before"
           disabled={!(isParentChecked && isChecked)}
-          {...register("feTodoDueDaysBefore", {
+          {...register("feTodoDueDatetimeDaysBefore", {
             required: isParentChecked && isChecked,
           })}
         />
         <TodoTimeInput
           label="Time"
           disabled={!(isParentChecked && isChecked)}
-          {...register("feTodoDueTimeOfDay", {
+          {...register("feTodoDueDatetimeTimeOfDay", {
             required: isParentChecked && isChecked,
           })}
         />

recycle-ics-ui/src/types.ts

@@ -20,8 +20,9 @@ export type FormInputs = {
   feEventEnd: string;
   reminders: { rdb: number; rhb: number; rmb: number }[];
   feTodoDueType: "date" | "datetime";
-  feTodoDueDaysBefore: number;
-  feTodoDueTimeOfDay: string;
+  feTodoDueDateDaysBefore: number;
+  feTodoDueDatetimeDaysBefore: number;
+  feTodoDueDatetimeTimeOfDay: string;
 };
 
 export type Form = {
@@ -67,8 +68,9 @@ export const inputsToForm = ({
   feEventEnd,
   reminders,
   feTodoDueType,
-  feTodoDueDaysBefore,
-  feTodoDueTimeOfDay,
+  feTodoDueDateDaysBefore,
+  feTodoDueDatetimeDaysBefore,
+  feTodoDueDatetimeTimeOfDay,
 }: FormInputs): Form | null => {
   if (!langCode || !zipcodeId || !streetId || !houseNumber) {
     return null;
@@ -108,14 +110,14 @@ export const inputsToForm = ({
         case "date":
           todoDue = {
             type: feTodoDueType as "date",
-            date: feTodoDueDaysBefore,
+            date: feTodoDueDateDaysBefore,
           };
           break;
         case "datetime":
           todoDue = {
             type: feTodoDueType as "datetime",
-            date: feTodoDueDaysBefore,
-            time: feTodoDueTimeOfDay,
+            date: feTodoDueDatetimeDaysBefore,
+            time: feTodoDueDatetimeTimeOfDay,
           };
           break;
         default:
@@ -147,8 +149,9 @@ export const defaultFormInputs: Partial<FormInputs> = {
   feEventEnd: "10:00",
   reminders: [],
   feTodoDueType: "datetime",
-  feTodoDueDaysBefore: 1,
-  feTodoDueTimeOfDay: "20:00",
+  feTodoDueDateDaysBefore: 1,
+  feTodoDueDatetimeDaysBefore: 1,
+  feTodoDueDatetimeTimeOfDay: "20:00",
   filterAllEvents: true,
   filterAllFractions: true,
 };

recycle-ics/app/Main.hs

@@ -3,14 +3,14 @@ module Main
   )
 where
 
-import Colog.Core (LogAction (..))
-import Colog.Message
-import Control.Monad.IO.Class (liftIO)
+import qualified Colog
 import qualified Data.ByteString.Lazy.Char8 as BSL
 import Data.IORef (newIORef)
+import Data.Maybe (fromMaybe)
 import Data.String (IsString (fromString))
 import Data.Text (Text)
 import qualified Data.Text as T
+import Data.Traversable (for)
 import qualified Language.Haskell.TH.Env as TH.Env
 import Network.HTTP.Client.TLS
   ( newTlsManagerWith,
@@ -37,12 +37,15 @@ main = do
   httpManager <- newTlsManagerWith tlsManagerSettings
   let clientEnv =
         mkClientEnv httpManager $ BaseUrl Https "api.fostplus.be" 443 ""
-      logAction = LogAction $ liftIO . putStrLn . T.unpack . fmtMessage
 
   authResult <- newIORef Nothing
   case cmd of
     GenerateIcs GenerateIcsOpts {apiClientOpts = ApiClientOpts {..}, ..} -> do
-      let env = Env {..}
+      let logAction =
+            Colog.cfilter
+              ((>= verbosity) . Colog.msgSeverity)
+              Colog.simpleMessageAction
+          env = Env {..}
       vCalendar <- flip runRecycle env $ runCollectionQuery collectionQuery
       let bs = printVCalendar vCalendar
       case outputFile of
@@ -61,7 +64,13 @@ main = do
         lookupEnvString
           "RECYCLE_ICS_SECRET"
           "X-Authorization header, get it by inspecting requests to recycleapp.be"
-      let env = Env {..}
+      verbosity <-
+        fromMaybe Colog.Warning <$> lookupEnvMRead "RECYCLE_ICS_VERBOSITY"
+      let logAction =
+            Colog.cfilter
+              ((>= verbosity) . Colog.msgSeverity)
+              Colog.simpleMessageAction
+          env = Env {..}
       putStrLn "Starting server"
       run port
         . logStdoutDev
@@ -76,12 +85,23 @@ lookupEnvRead var descr = do
   case mStr of
     Nothing -> error . T.unpack $ "Environment variable " <> var <> " expected: " <> descr
     Just str -> case readMaybe str of
-      Nothing -> error . T.unpack $ "Could not read environment variable " <> var <> ": " <> descr
+      Nothing -> error . T.unpack $ "Could not read environment variable " <> var
       Just a -> pure a
 
+lookupEnvMRead :: (Read a) => Text -> IO (Maybe a)
+lookupEnvMRead var = do
+  mStr <- Env.lookupEnv (T.unpack var)
+  for mStr $ \str -> case readMaybe str of
+    Nothing -> error . T.unpack $ "Could not read environment variable " <> var
+    Just a -> pure a
+
 lookupEnvString :: (IsString a) => Text -> Text -> IO a
 lookupEnvString var descr = do
   mStr <- Env.lookupEnv (T.unpack var)
   case mStr of
     Nothing -> error . T.unpack $ "Environment variable " <> var <> " expected: " <> descr
     Just str -> pure $ fromString str
+
+lookupEnvMString :: (IsString a) => Text -> IO (Maybe a)
+lookupEnvMString var = do
+  fmap fromString <$> Env.lookupEnv (T.unpack var)

recycle-ics/app/Opts.hs

@@ -8,6 +8,7 @@ module Opts
   )
 where
 
+import Colog (Severity (..))
 import qualified Data.Char as Char
 import Options.Applicative
 import Recycle.Ics.ICalendar
@@ -53,7 +54,8 @@ pCmd =
 data GenerateIcsOpts = GenerateIcsOpts
   { outputFile :: Maybe FilePath,
     collectionQuery :: CollectionQuery,
-    apiClientOpts :: ApiClientOpts
+    apiClientOpts :: ApiClientOpts,
+    verbosity :: Severity
   }
 
 pGenerateIcsOpts :: Parser GenerateIcsOpts
@@ -65,6 +67,15 @@ pGenerateIcsOpts = do
           "output file"
   collectionQuery <- pCollectionQuery
   apiClientOpts <- pApiClientOpts
+  verbosity <-
+    option
+      auto
+      ( short 'v'
+          <> long "verbosity"
+          <> help "Log error messages of this severity and higher."
+          <> metavar "SEVERITY"
+          <> value Warning
+      )
   pure GenerateIcsOpts {..}
 
 pCollectionQuery :: Parser CollectionQuery