-- | Command line parsers for options often used for penplotting.
module Draw.Plotting.CmdArgs (
      canvasP
    , Canvas(..)
) where



import Control.Monad
import Data.Foldable
import Draw.Plotting.PaperSize
import Geometry.Core
import Options.Applicative
import Options.Applicative.Types



data Canvas = Canvas
    { Canvas -> Double
_canvasWidth :: Double
    , Canvas -> Double
_canvasHeight :: Double
    , Canvas -> Double
_canvasMargin :: Double
    } deriving (Canvas -> Canvas -> Bool
(Canvas -> Canvas -> Bool)
-> (Canvas -> Canvas -> Bool) -> Eq Canvas
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Canvas -> Canvas -> Bool
== :: Canvas -> Canvas -> Bool
$c/= :: Canvas -> Canvas -> Bool
/= :: Canvas -> Canvas -> Bool
Eq, Eq Canvas
Eq Canvas
-> (Canvas -> Canvas -> Ordering)
-> (Canvas -> Canvas -> Bool)
-> (Canvas -> Canvas -> Bool)
-> (Canvas -> Canvas -> Bool)
-> (Canvas -> Canvas -> Bool)
-> (Canvas -> Canvas -> Canvas)
-> (Canvas -> Canvas -> Canvas)
-> Ord Canvas
Canvas -> Canvas -> Bool
Canvas -> Canvas -> Ordering
Canvas -> Canvas -> Canvas
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Canvas -> Canvas -> Ordering
compare :: Canvas -> Canvas -> Ordering
$c< :: Canvas -> Canvas -> Bool
< :: Canvas -> Canvas -> Bool
$c<= :: Canvas -> Canvas -> Bool
<= :: Canvas -> Canvas -> Bool
$c> :: Canvas -> Canvas -> Bool
> :: Canvas -> Canvas -> Bool
$c>= :: Canvas -> Canvas -> Bool
>= :: Canvas -> Canvas -> Bool
$cmax :: Canvas -> Canvas -> Canvas
max :: Canvas -> Canvas -> Canvas
$cmin :: Canvas -> Canvas -> Canvas
min :: Canvas -> Canvas -> Canvas
Ord, Int -> Canvas -> ShowS
[Canvas] -> ShowS
Canvas -> String
(Int -> Canvas -> ShowS)
-> (Canvas -> String) -> ([Canvas] -> ShowS) -> Show Canvas
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Canvas -> ShowS
showsPrec :: Int -> Canvas -> ShowS
$cshow :: Canvas -> String
show :: Canvas -> String
$cshowList :: [Canvas] -> ShowS
showList :: [Canvas] -> ShowS
Show)

instance HasBoundingBox Canvas where
    boundingBox :: Canvas -> BoundingBox
boundingBox Canvas{_canvasWidth :: Canvas -> Double
_canvasWidth=Double
w, _canvasHeight :: Canvas -> Double
_canvasHeight=Double
h} = [Vec2] -> BoundingBox
forall a. HasBoundingBox a => a -> BoundingBox
boundingBox [Vec2
forall v. VectorSpace v => v
zero, Double -> Double -> Vec2
Vec2 Double
w Double
h]

-- | Command line parser for common paper formats and orientations.
canvasP :: Parser Canvas
canvasP :: Parser Canvas
canvasP = (Double, Double) -> Orientation -> Double -> Canvas
f ((Double, Double) -> Orientation -> Double -> Canvas)
-> Parser (Double, Double)
-> Parser (Orientation -> Double -> Canvas)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Double, Double)
paperSizeP Parser (Orientation -> Double -> Canvas)
-> Parser Orientation -> Parser (Double -> Canvas)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Orientation
orientationP Parser (Double -> Canvas) -> Parser Double -> Parser Canvas
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Double
marginP
  where
    f :: (Double, Double) -> Orientation -> Double -> Canvas
f (Double
wh1,Double
wh2) Orientation
orientation Double
margin =
        let (Double
w, Double
h) = case Orientation
orientation of
                Orientation
Landscape -> (Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
wh1 Double
wh2, Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
wh1 Double
wh2)
                Orientation
Portrait -> (Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
wh1 Double
wh2, Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
wh1 Double
wh2)
        in Canvas
            { _canvasWidth :: Double
_canvasWidth = Double
w
            , _canvasHeight :: Double
_canvasHeight = Double
h
            , _canvasMargin :: Double
_canvasMargin = Double
margin
            }

paperSizeP :: Parser (Double, Double)
paperSizeP :: Parser (Double, Double)
paperSizeP = [Parser (Double, Double)] -> Parser (Double, Double)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ (Double, Double)
-> Mod FlagFields (Double, Double) -> Parser (Double, Double)
forall a. a -> Mod FlagFields a -> Parser a
flag' (Double
paper_a1_long_mm, Double
paper_a1_short_mm) (Mod FlagFields (Double, Double) -> Parser (Double, Double))
-> Mod FlagFields (Double, Double) -> Parser (Double, Double)
forall a b. (a -> b) -> a -> b
$ [Mod FlagFields (Double, Double)]
-> Mod FlagFields (Double, Double)
forall a. Monoid a => [a] -> a
mconcat
        [ String -> Mod FlagFields (Double, Double)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"a1"
        , String -> Mod FlagFields (Double, Double)
forall (f :: * -> *) a. String -> Mod f a
help String
"DIN A1 (841 mm × 594 mm)"
        ]
    , (Double, Double)
-> Mod FlagFields (Double, Double) -> Parser (Double, Double)
forall a. a -> Mod FlagFields a -> Parser a
flag' (Double
paper_a2_long_mm, Double
paper_a2_short_mm) (Mod FlagFields (Double, Double) -> Parser (Double, Double))
-> Mod FlagFields (Double, Double) -> Parser (Double, Double)
forall a b. (a -> b) -> a -> b
$ [Mod FlagFields (Double, Double)]
-> Mod FlagFields (Double, Double)
forall a. Monoid a => [a] -> a
mconcat
        [ String -> Mod FlagFields (Double, Double)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"a2"
        , String -> Mod FlagFields (Double, Double)
forall (f :: * -> *) a. String -> Mod f a
help String
"DIN A2 (594 mm × 420 mm)"
        ]
    , (Double, Double)
-> Mod FlagFields (Double, Double) -> Parser (Double, Double)
forall a. a -> Mod FlagFields a -> Parser a
flag' (Double
paper_a3_long_mm, Double
paper_a3_short_mm) (Mod FlagFields (Double, Double) -> Parser (Double, Double))
-> Mod FlagFields (Double, Double) -> Parser (Double, Double)
forall a b. (a -> b) -> a -> b
$ [Mod FlagFields (Double, Double)]
-> Mod FlagFields (Double, Double)
forall a. Monoid a => [a] -> a
mconcat
        [ String -> Mod FlagFields (Double, Double)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"a3"
        , String -> Mod FlagFields (Double, Double)
forall (f :: * -> *) a. String -> Mod f a
help String
"DIN A3 (420 mm × 271 mm)"
        ]
    , (Double, Double)
-> Mod FlagFields (Double, Double) -> Parser (Double, Double)
forall a. a -> Mod FlagFields a -> Parser a
flag' (Double
paper_a4_long_mm, Double
paper_a4_short_mm) (Mod FlagFields (Double, Double) -> Parser (Double, Double))
-> Mod FlagFields (Double, Double) -> Parser (Double, Double)
forall a b. (a -> b) -> a -> b
$ [Mod FlagFields (Double, Double)]
-> Mod FlagFields (Double, Double)
forall a. Monoid a => [a] -> a
mconcat
        [ String -> Mod FlagFields (Double, Double)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"a4"
        , String -> Mod FlagFields (Double, Double)
forall (f :: * -> *) a. String -> Mod f a
help String
"DIN A4 (271 mm × 210 mm)"
        ]
    , (Double, Double)
-> Mod FlagFields (Double, Double) -> Parser (Double, Double)
forall a. a -> Mod FlagFields a -> Parser a
flag' (Double
paper_a5_long_mm, Double
paper_a5_short_mm) (Mod FlagFields (Double, Double) -> Parser (Double, Double))
-> Mod FlagFields (Double, Double) -> Parser (Double, Double)
forall a b. (a -> b) -> a -> b
$ [Mod FlagFields (Double, Double)]
-> Mod FlagFields (Double, Double)
forall a. Monoid a => [a] -> a
mconcat
        [ String -> Mod FlagFields (Double, Double)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"a5"
        , String -> Mod FlagFields (Double, Double)
forall (f :: * -> *) a. String -> Mod f a
help String
"DIN A5 (210 mm × 148 mm)"
        ]
    , ReadM (Double, Double)
-> Mod OptionFields (Double, Double) -> Parser (Double, Double)
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM (Double, Double)
customSizeReader (Mod OptionFields (Double, Double) -> Parser (Double, Double))
-> Mod OptionFields (Double, Double) -> Parser (Double, Double)
forall a b. (a -> b) -> a -> b
$ [Mod OptionFields (Double, Double)]
-> Mod OptionFields (Double, Double)
forall a. Monoid a => [a] -> a
mconcat
        [ String -> Mod OptionFields (Double, Double)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"size"
        , Char -> Mod OptionFields (Double, Double)
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
's'
        , String -> Mod OptionFields (Double, Double)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"[mm]"
        , String -> Mod OptionFields (Double, Double)
forall (f :: * -> *) a. String -> Mod f a
help String
"Custom output size, format: <length>x<length>"
        ]
    ]

data Orientation = Landscape | Portrait deriving (Orientation -> Orientation -> Bool
(Orientation -> Orientation -> Bool)
-> (Orientation -> Orientation -> Bool) -> Eq Orientation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Orientation -> Orientation -> Bool
== :: Orientation -> Orientation -> Bool
$c/= :: Orientation -> Orientation -> Bool
/= :: Orientation -> Orientation -> Bool
Eq, Eq Orientation
Eq Orientation
-> (Orientation -> Orientation -> Ordering)
-> (Orientation -> Orientation -> Bool)
-> (Orientation -> Orientation -> Bool)
-> (Orientation -> Orientation -> Bool)
-> (Orientation -> Orientation -> Bool)
-> (Orientation -> Orientation -> Orientation)
-> (Orientation -> Orientation -> Orientation)
-> Ord Orientation
Orientation -> Orientation -> Bool
Orientation -> Orientation -> Ordering
Orientation -> Orientation -> Orientation
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Orientation -> Orientation -> Ordering
compare :: Orientation -> Orientation -> Ordering
$c< :: Orientation -> Orientation -> Bool
< :: Orientation -> Orientation -> Bool
$c<= :: Orientation -> Orientation -> Bool
<= :: Orientation -> Orientation -> Bool
$c> :: Orientation -> Orientation -> Bool
> :: Orientation -> Orientation -> Bool
$c>= :: Orientation -> Orientation -> Bool
>= :: Orientation -> Orientation -> Bool
$cmax :: Orientation -> Orientation -> Orientation
max :: Orientation -> Orientation -> Orientation
$cmin :: Orientation -> Orientation -> Orientation
min :: Orientation -> Orientation -> Orientation
Ord, Int -> Orientation -> ShowS
[Orientation] -> ShowS
Orientation -> String
(Int -> Orientation -> ShowS)
-> (Orientation -> String)
-> ([Orientation] -> ShowS)
-> Show Orientation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Orientation -> ShowS
showsPrec :: Int -> Orientation -> ShowS
$cshow :: Orientation -> String
show :: Orientation -> String
$cshowList :: [Orientation] -> ShowS
showList :: [Orientation] -> ShowS
Show)

orientationP :: Parser Orientation
orientationP :: Parser Orientation
orientationP = [Parser Orientation] -> Parser Orientation
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ Orientation -> Mod FlagFields Orientation -> Parser Orientation
forall a. a -> Mod FlagFields a -> Parser a
flag' Orientation
Landscape (Mod FlagFields Orientation -> Parser Orientation)
-> Mod FlagFields Orientation -> Parser Orientation
forall a b. (a -> b) -> a -> b
$ [Mod FlagFields Orientation] -> Mod FlagFields Orientation
forall a. Monoid a => [a] -> a
mconcat
        [ String -> Mod FlagFields Orientation
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"landscape" ]
    , Orientation -> Mod FlagFields Orientation -> Parser Orientation
forall a. a -> Mod FlagFields a -> Parser a
flag' Orientation
Portrait (Mod FlagFields Orientation -> Parser Orientation)
-> Mod FlagFields Orientation -> Parser Orientation
forall a b. (a -> b) -> a -> b
$ [Mod FlagFields Orientation] -> Mod FlagFields Orientation
forall a. Monoid a => [a] -> a
mconcat
        [ String -> Mod FlagFields Orientation
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"portrait" ]
    ]

marginP :: Parser Double
marginP :: Parser Double
marginP = ReadM Double -> Mod OptionFields Double -> Parser Double
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Double
forall a. Read a => ReadM a
auto ([Mod OptionFields Double] -> Mod OptionFields Double
forall a. Monoid a => [a] -> a
mconcat
    [ String -> Mod OptionFields Double
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"margin"
    , String -> Mod OptionFields Double
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"[mm]"
    , Double -> Mod OptionFields Double
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Double
10
    , (Double -> String) -> Mod OptionFields Double
forall a (f :: * -> *). (a -> String) -> Mod f a
showDefaultWith (\Double
x -> Double -> String
forall a. Show a => a -> String
show Double
x String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" mm")
    , String -> Mod OptionFields Double
forall (f :: * -> *) a. String -> Mod f a
help String
"Ensure this much blank space to the edge"
    ])

customSizeReader :: ReadM (Double, Double)
customSizeReader :: ReadM (Double, Double)
customSizeReader = do
    String
argStr <- ReadM String
readerAsk
    let wh :: [(Double, Double)]
wh = do
            (Double
w, Char
c:String
rest) <- ReadS Double
forall a. Read a => ReadS a
reads String
argStr
            Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'x' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'×')
            (Double
h, String
rest') <- ReadS Double
forall a. Read a => ReadS a
reads String
rest
            Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rest')
            (Double, Double) -> [(Double, Double)]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double
w,Double
h)
    case [(Double, Double)]
wh of
        [(Double
w,Double
h)] -> (Double, Double) -> ReadM (Double, Double)
forall a. a -> ReadM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double
w,Double
h)
        [(Double, Double)]
_other -> String -> ReadM (Double, Double)
forall a. String -> ReadM a
readerError (String -> ReadM (Double, Double))
-> String -> ReadM (Double, Double)
forall a b. (a -> b) -> a -> b
$ String
"Argument is not of the form <length>x<length>: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
argStr