{-

valplot
Copyright (C) Jonathan Lamothe <jonathan@jlamothe.net>

This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Affero General Public License as
published by the Free Software Foundation, either version 3 of the
License, or (at your option) any later version.

This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
Affero General Public License for more details.

You should have received a copy of the GNU Affero General Public
License along with this program.  If not, see
<https://www.gnu.org/licenses/>.

-}

module PlotSpec (spec) where

import Test.Hspec (Spec, context, describe, it, shouldBe)

import Plot

spec :: Spec
spec = describe "Plot" plotSpec

plotSpec :: Spec
plotSpec = describe "Plot" $ do
  plotWidthSpec
  plotHeightSpec
  valAtXYSpec
  transformPlotSpec
  plotFillSpec
  plotValSpec
  clearValSpec
  valAtXY'Spec

plotWidthSpec :: Spec
plotWidthSpec = describe "plotWidth" $ mapM_
  ( \n -> context ("width: " ++ show n) $ let
    p = newPlot n 0
    in it ("should be " ++ show n) $
      plotWidth p `shouldBe` n
  ) [1..5]

plotHeightSpec :: Spec
plotHeightSpec = describe "plotHeight" $ mapM_
  ( \n -> context ("height: " ++ show n) $ let
    p = newPlot 0 n
    in it ("should be " ++ show n) $
      plotHeight p `shouldBe` n
  ) [1..5]

valAtXYSpec :: Spec
valAtXYSpec = describe "valAtXY" $ mapM_
  ( \(coords, expected) -> context (show coords) $
    it ("should be " ++ show expected) $ let
      plot = rawPlot (\(x, y) -> Just $ x + 2 * y)
      in valAtXY coords plot `shouldBe` Just expected
  )

  --  coords, expected
  [ ( (1, 1), 3        )
  , ( (1, 2), 5        )
  , ( (2, 1), 4        )
  , ( (2, 2), 6        )
  ]

transformPlotSpec :: Spec
transformPlotSpec = describe "transformPlot" $ mapM_
  ( \(coords, expected) -> context (show coords) $
    it ("should be " ++ show expected) $ let
      plot = rawPlot (\(x, y) -> Just $ x + 2 * y)

      plot' = transformPlot
        ( \(x, y) p -> do
          val1 <- valAtXY (x, y) p
          let val2 = 2 * x + 3 * y
          Just $ val1 + val2
        ) plot

      actual = valAtXY coords plot'
      in actual `shouldBe` Just expected
  )

  --  coords, expected
  [ ( (1, 1), 8        )
  , ( (1, 2), 13       )
  , ( (2, 1), 11       )
  , ( (2, 2), 16       )
  ]

plotFillSpec  :: Spec
plotFillSpec = describe "plotFill" $ mapM_
  ( \coords -> context (show coords) $
    it "should be set" $ let
      plot = plotFill () (newPlot 5 5)
      in valAtXY coords plot `shouldBe` Just ()
  )
  [ (0, 0)
  , (0, 4)
  , (4, 0)
  , (4, 4)
  , (-1, 0)
  , (5, 0)
  , (0, -1)
  , (0, 5)
  ]

plotValSpec :: Spec
plotValSpec = describe "plotVal" $ mapM_
  ( \(coords, expected) -> context (show coords) $
    it ("should be " ++ show expected) $ let
      plot = plotVal (2, 3) () (newPlot 5 5)
      in valAtXY coords plot `shouldBe` expected
  )

  --  coords, expected
  [ ( (0, 0), Nothing  )
  , ( (2, 3), Just ()  )
  , ( (3, 2), Nothing  )
  ]

clearValSpec :: Spec
clearValSpec = describe "clearVal" $ mapM_
  ( \(coords, expected) -> context (show coords) $
    it ("should be " ++ show expected) $ let
      plot  = plotFill () (newPlot 5 5)
      plot' = clearVal (2, 3) plot
      in valAtXY coords plot' `shouldBe` expected
  )

  --  coords, expected
  [ ( (0, 0), Just ()  )
  , ( (2, 3), Nothing  )
  , ( (3, 2), Just ()  )
  ]

valAtXY'Spec :: Spec
valAtXY'Spec = describe "valAtXY'" $ mapM_
  ( \(coords, expected) -> context (show coords) $
    it ("should be " ++ show expected) $ let
      plot = transformPlot
        (\_ _ -> Just ())
        (newPlot 5 5)
      actual = valAtXY' coords plot
      in actual `shouldBe` expected
  )

  --  coords,  expected
  [ ( (0, 0),  Just ()  )
  , ( (4, 0),  Just ()  )
  , ( (0, 4),  Just ()  )
  , ( (4, 4),  Just ()  )
  , ( (-1, 0), Nothing  )
  , ( (5, 0),  Nothing  )
  , ( (0, -1), Nothing  )
  , ( (0, 5),  Nothing  )
  ]

rawPlot :: ((Int, Int) -> Maybe a) -> Plot a
rawPlot f = transformPlot
  (\coords _ -> f coords)
  (newPlot 0 0)

--jl