fix flake, add translation, add args

app/Main.hs

@@ -7,17 +7,38 @@ import Data.Text qualified as T
 import Data.Text.Encoding qualified as TE
 import Data.Text.Lazy qualified as TL
 import Data.Time (MonthOfYear, Year, addDays, addUTCTime, fromGregorian, getCurrentTime, secondsToNominalDiffTime, toGregorian)
+import Data.String (fromString)
 import Data.Time.LocalTime
 import Ical
 import Interested qualified
 import Lucid (renderText)
 import Network.HTTP.Simple
 import Network.HTTP.Types (status400)
-import Network.Wai.Middleware.Static
+import Network.Wai.Middleware.Static (staticPolicy, addBase, noDots, (>->))
+import Network.Wai.Handler.Warp (setPort, setHost)
+import Options.Applicative
+  ( Parser,
+    auto,
+    execParser,
+    fullDesc,
+    help,
+    helper,
+    info,
+    long,
+    metavar,
+    option,
+    progDesc,
+    short,
+    showDefault,
+    strOption,
+    value,
+    (<**>),
+  )
 import Render
 import Text.Printf (printf)
+import Translation (Lang (EN, ES))
 import Web.Scotty
-import Web.Scotty.Cookie (defaultSetCookie, setCookieExpires, setCookieName, setCookieValue)
+import Web.Scotty.Cookie (defaultSetCookie, getCookie, setCookie, setCookieExpires, setCookieName, setCookieValue)
 
 getFromUrl :: String -> IO T.Text
 getFromUrl url = do
@@ -27,14 +48,59 @@ getFromUrl url = do
   let rText = TE.decodeUtf8 (BL.toStrict rBody)
   pure $ T.replace "\n " " " $ T.replace "\r\n" "\n" rText
 
+getLanguageHeader :: Maybe TL.Text -> Lang
+getLanguageHeader (Just h)
+  | pre "es" h = ES
+  | pre "en" h = EN
+  | otherwise = ES
+  where
+    pre = TL.isPrefixOf
+getLanguageHeader Nothing = ES
+
+data Config = Config
+  { configHost :: String,
+    configPort :: Int
+  }
+
+-- Build the parser
+configParser :: Parser Config
+configParser =
+  Config
+    <$> strOption
+      ( long "bind"
+          <> short 'b'
+          <> metavar "HOST"
+          <> help "Interface to bind to"
+          <> value "127.0.0.1"
+          <> showDefault
+      )
+    <*> option
+      auto
+      ( long "port"
+          <> short 'p'
+          <> metavar "PORT"
+          <> help "Port to listen on"
+          <> value 3000
+          <> showDefault
+      )
+
 main :: IO ()
-main =
-  scotty
-    3456
-    ( do
+main = do
+  cfg <- execParser $ info (configParser <**> helper)
+        ( fullDesc <> progDesc "A Scotty web server with custom bind/port" )
+
+  let opts = defaultOptions 
+                   { settings = setPort (configPort cfg) 
+                              $ setHost (fromString (configHost cfg)) 
+                              $ settings defaultOptions 
+          }
+  scottyOpts opts $ do
         middleware $ staticPolicy (noDots >-> addBase "static")
 
         get "/" $ do
+          langHeader <- header "Accept-Language"
+          let lang = getLanguageHeader langHeader
+
           linesArray <- liftIO $ getFromUrl "https://cdav.chipburners.club/public/main/"
           timeNow <- liftIO $ getCurrentTime
           tmz <- liftIO $ getCurrentTimeZone
@@ -48,7 +114,7 @@ main =
           when (not $ null errors) $ do
             liftIO $ print errors
 
-          html $ renderText $ renderFrontpage validEvents
+          html $ renderText $ renderFrontpage lang validEvents
         get "/monthView/" $ do
           timeNow <- liftIO $ getCurrentTime
           tmz <- liftIO $ getCurrentTimeZone
@@ -59,6 +125,8 @@ main =
           redirect $ TL.pack $ printf "/monthView/%s/%s" (show y) (show m)
 
         get "/monthView/:year/:month" $ do
+          langHeader <- header "Accept-Language"
+          let lang = getLanguageHeader langHeader
           year :: Year <- pathParam "year"
           month :: MonthOfYear <- pathParam "month"
 
@@ -83,7 +151,7 @@ main =
               when (not $ null errors) $ do
                 liftIO $ print errors
 
-              html $ renderText $ renderMonthview (year, month) dayToday groupedEvents
+              html $ renderText $ renderMonthview lang (year, month) dayToday groupedEvents
         get "/api/interested/register/:event" $ do
           event <- pathParam "event"
           let cookieName = "interested-" <> event
@@ -100,4 +168,3 @@ main =
                 }
             )
           redirect returnUri
-    )