hetzner-0.4.0.0: apps/Docs.hs

module Main (main) where

-- base
import Data.Foldable (forM_)
import Data.List (sortOn)
-- hetzner
import Hetzner.Cloud qualified as Hetzner
-- bytestring
import qualified Data.ByteString.Lazy as ByteString
-- directory
import System.Directory (createDirectoryIfMissing)
-- blaze-html
import Text.Blaze.Html (toHtml, preEscapedToHtml, (!))
import Text.Blaze.Html.Renderer.Utf8 (renderHtml)
import Text.Blaze.Html5 qualified as H
import Text.Blaze.Html5.Attributes qualified as A
-- time
import Data.Time.Clock.POSIX (getPOSIXTime)

main :: IO ()
main = do
  mtoken <- Hetzner.getTokenFromEnv
  token <- maybe (fail "HETZNER_API_TOKEN is not set") pure mtoken
  now <- round <$> getPOSIXTime :: IO Int
  -- Server types
  let dir = "public/server-types"
  createDirectoryIfMissing True dir
  serverTypes0 <- Hetzner.streamToList $ Hetzner.streamPages $ Hetzner.getServerTypes token
  let maxPrice = maximum . (:) 0
               . fmap (Hetzner.grossPrice . Hetzner.monthlyPrice)
               . Hetzner.serverPricing
  let serverTypes = sortOn maxPrice $ filter (not . Hetzner.serverDeprecated) serverTypes0
  ByteString.writeFile (dir ++ "/index.html") $ renderHtml $ H.docTypeHtml $ do
    H.head $ do
      H.title "Hetzner Server Type List"
      H.link ! A.rel "stylesheet" ! A.href "https://use.typekit.net/yxf7kgr.css"
      H.link ! A.rel "stylesheet" ! A.href "../common.css"
    H.body $ do
      H.h1 "Hetzner Server Type List"
      H.hr
      H.table $ do
        H.tr ! A.class_ "hrow" $ do
          H.th "Server ID"
          H.th "Name"
          H.th "Architecture"
          H.th "Cores"
          H.th "Memory"
          H.th "Disk"
          H.th "CPU Type"
          H.th "Max Monthly Price"
        forM_ serverTypes $ \serverType -> H.tr $ do
          H.td $ (\(Hetzner.ServerTypeID i) -> toHtml i) $ Hetzner.serverTypeID serverType
          H.td $ toHtml $ Hetzner.serverTypeName serverType
          H.td $ toHtml $ show $ Hetzner.serverArchitecture serverType
          H.td $ toHtml $ Hetzner.serverCores serverType
          H.td $ toHtml $ show (Hetzner.serverMemory serverType) ++ " GB"
          H.td $ toHtml $ show (Hetzner.serverDisk serverType) ++ " GB"
          H.td $ toHtml $ case Hetzner.serverCPUType serverType of
            Hetzner.SharedCPU -> "Shared" :: String
            Hetzner.DedicatedCPU -> "Dedicated"
          H.td $ toHtml $ show (maxPrice serverType) ++ " €"
    H.p $ H.em $ do
      "Updated "
      H.script $ preEscapedToHtml $
        "const date = new Date(" ++ show (now * 1000) ++ "); "
        ++ "document.write(date.toLocaleString());"
      "."