onomastigs-ng: respect scaleToMaximum parameter

onomastics-ng/cli/Main.hs

@@ -16,6 +16,7 @@ data Options = Options
     , surnames :: [Text]
     , colorPalette :: [Text]
     , areaMode :: AreaKind
+    , scaleTo :: ScaleToMaximum
     }
 
 parseOptions :: Parser Options
@@ -25,6 +26,7 @@ parseOptions =
         <*> some (strArgument (metavar "SURNAME" <> help "Surname"))
         <*> many (strOption (long "color" <> metavar "COLOR" <> help "Color palette for the SVG"))
         <*> flag District State (long "states" <> help "Analyze by state (instead of district)")
+        <*> flag Global Local (long "scale-to" <> help "Scale the colors down according to the local/global maximum")
 
 opts :: ParserInfo Options
 opts = info (parseOptions <**> helper) (fullDesc <> progDesc "Map your German surname")
@@ -38,7 +40,7 @@ main = do
                 Relative -> relativeCount
                 Absolute -> absoluteCount
         colors = colorPalette options ++ defaultColorPalette
-        svgSettings = SvgSettings{scaleToMaximum = Global}
+        svgSettings = SvgSettings{scaleToMaximum = scaleTo options}
     res <- runStoepel manager' $ do
         let theNames = map Just (surnames options)
         ds <- case areaMode options of

onomastics-ng/lib/Onomap/Types.hs

@@ -28,6 +28,12 @@ defaultSvgSettings = SvgSettings { scaleToMaximum = Global }
 
 data ScaleToMaximum = Global | Local
 
+instance FromHttpApiData ScaleToMaximum where
+  parseUrlPiece = \case
+    "global" -> Right Global
+    "local" -> Right Local
+    x -> Left x
+
 data Mode = Relative | Absolute
 
 instance FromHttpApiData Mode where

onomastics-ng/web/Main.hs

@@ -27,14 +27,14 @@ import Servant
 import Servant.HTML.Blaze (HTML)
 import Text.Blaze (ToMarkup (..))
 
-data Response = Response {color :: [Text], areas :: [Area], statistics :: [(Text, ByArea Double)]}
+data Response = Response {color :: [Text], areas :: [Area], statistics :: [(Text, ByArea Double)], svgSettings :: SvgSettings}
     deriving (Generic)
 
 instance ToMarkup Response where
     toMarkup response =
         preEscapedToMarkup $
             renderMap
-                (SvgSettings{scaleToMaximum = Global})
+                (svgSettings response)
                 (color response)
                 (areas response)
                 (statistics response)
@@ -64,13 +64,14 @@ type OnomapApi =
         :> QueryParams "name" Text
         :> QueryParam "by" AreaKind
         :> QueryParams "color" Text
+        :> QueryParam "scale" ScaleToMaximum
         :> Get '[HTML] Response
 
 app :: Manager -> ([Area], [Area]) -> Application
 app manager' (theDistricts, theStates) = serve onomapApi server
   where
     server :: Server OnomapApi
-    server = \mode (surnames :: [Text]) maybeAreaKind colors ->
+    server = \mode (surnames :: [Text]) maybeAreaKind colors scaleTo ->
         liftIO $
             runStoepel manager' $ do
                 let areaMode = fromMaybe District maybeAreaKind
@@ -90,6 +91,7 @@ app manager' (theDistricts, theStates) = serve onomapApi server
                     Response
                         { color = colors ++ defaultColorPalette
                         , areas = theAreas
+                        , svgSettings = SvgSettings{scaleToMaximum = fromMaybe Global scaleTo}
                         , statistics = zip surnames stats
                         }
     onomapApi :: Proxy OnomapApi