-- SVGutils
-- Copyright (c) 2010, Neil Brown
--
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
-- modification, are permitted provided that the following conditions are met:
--
--     * Redistributions of source code must retain the above copyright
--       notice, this list of conditions and the following disclaimer.
--
--     * Redistributions in binary form must reproduce the above
--       copyright notice, this list of conditions and the following
--       disclaimer in the documentation and/or other materials provided
--       with the distribution.
--
--     * Neither the name of Neil Brown nor the names of other
--       contributors may be used to endorse or promote products derived
--       from this software without specific prior written permission.
--
-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
-- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
-- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
-- OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
-- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
-- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
-- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
-- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
-- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

-- | A module with a helper function for dealing with paper sizes.
module Data.SVG.Paper (parsePaperSize) where

import Control.Applicative (liftA2)
import Data.Char (toLower)

import Data.SVG.SVG

-- | Parses a paper size which can either be a known name or a detailed size.
--
-- Paper sizes such as \"a4\" are not part of the SVG specification; this helper is provided here
-- in case you want help getting a paper size from a command-line argument.
--
-- This recognises two styles of paper size.  One is a literal name from the list
-- below, and the other is \"width*height\" (no spaces around the asterisk) where
-- width and height are valid SVG sizes that can be parsed by 'parseCoord' (using
-- a DPI of 90).  The
-- list of literal sizes, recognised case-insensitive (most of which are from the ISO 216 standard), is:
--
-- * \"a4\", \"a4portrait\": 210mm*297mm
--
-- * \"a4landscape\": 297mm*210mm
--
-- * \"a3\", \"a3portrait\": 297mm*420mm
--
-- * \"a3landscape\": 420mm*297mm
--
-- * \"letter\": 215.9mm*279.4mm
parsePaperSize :: String -> Maybe Size
parsePaperSize name = case map toLower name of
  "a4" -> s 210 297
  "a4portrait" -> s 210 297
  "a4landscape" -> s 297 210
  "a3" -> s 297 420
  "a3portrait" -> s 297 420
  "a3landscape" -> s 420 297
  "letter" -> s 215.9 279.4
  _ -> case span (/= '*') name of
         (w, '*':h) -> liftA2 Size (parseCoord dpi w) (parseCoord dpi h)
         _ -> Nothing
  where
    s w h = Just (Size w h)
    dpi = DPI 90