{-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-} module Main where import Control.Lens import Lucid import Prelude import Test.Tasty import Test.Tasty.Hspec import Web.Page import Web.Page.Examples import qualified Data.Text.IO as Text generatePage :: FilePath -> FilePath -> PageConfig -> Page -> IO () generatePage dir stem pc = renderPageToFile dir (#filenames .~ concernNames "" stem $ pc) generatePages :: Traversable t => FilePath -> t (FilePath, PageConfig, Page) -> IO () generatePages dir xs = sequenceA_ $ (\(fp, pc, p) -> generatePage dir fp pc p) <$> xs genTest :: FilePath -> IO () genTest dir = void $ generatePages dir [("default", (defaultPageConfig "default"), page1), ("sep", cfg2, page2)] testVsFile :: FilePath -> FilePath -> PageConfig -> Page -> IO Bool testVsFile dir stem pc p = do (t,t') <- textVsFile dir stem pc p pure (t==t') textVsFile :: FilePath -> FilePath -> PageConfig -> Page -> IO (Concerns Text, Concerns Text) textVsFile dir stem pc p = do let names = concernNames "" stem let pc' = #filenames .~ names $ pc let t = renderPageAsText pc' p case pc ^. #concerns of Inline -> do t' <- Text.readFile (dir <> names ^. #htmlConcern) return (t, Concerns mempty mempty t') Separated -> do t' <- sequenceA $ Text.readFile <$> (dir <>) <$> names return (t, t') testsRender :: IO (SpecWith ()) testsRender = return $ describe "Web.Page.Render" $ do it "run genTest 'test/canned/' to refresh canned files." True it "renderPage mempty" $ renderText (renderPage mempty) `shouldBe` "" let dir = "test/canned/" it "renderPageToFile, renderPage (compared with default canned file)" $ testVsFile dir "default" (defaultPageConfig "default") page1 `shouldReturn` True it "the various PageConfig's" $ testVsFile dir "sep" cfg2 page2 `shouldReturn` True testsBootstrap :: IO (SpecWith ()) testsBootstrap = return $ describe "Web.Page.Bootstrap" $ do it "bootstrapPage versus canned" $ toText (renderPage bootstrapPage) `shouldBe` "" it "accordion versus canned" $ ( toText . runIdentity . flip evalStateT 0 . accordion "acctest" Nothing $ (\x -> (pack (show x), "filler")) <$> [1..2::Int]) `shouldBe` "

filler

" testsBridge :: IO (SpecWith ()) testsBridge = return $ describe "Web.Page.Bridge" $ it "bridgePage versus canned" $ toText (renderPage bridgePage) `shouldBe` "" testbs :: [Value] testbs = [ Object (fromList [("element","1"),("value","b1")]) , Object (fromList [("element","2"),("value","b2")]) , Object (fromList [("element","3"),("value","b3")]) ] testvs :: [Value] testvs = [ Object (fromList [("element","2"),("value","false")]) , Object (fromList [("element","2"),("value","true")]) , Object (fromList [("element","3"),("value","x")]) , Object (fromList [("element","4"),("value","")]) , Object (fromList [("element","5"),("value","2")]) , Object (fromList [("element","6"),("value","0.6")]) , Object (fromList [("element","7"),("value","false")]) , Object (fromList [("element","8"),("value","true")]) , Object (fromList [("element","9"),("value","5")]) , Object (fromList [("element","10"),("value","#00b4cc")]) ] testsRep :: IO (SpecWith ()) testsRep = return $ describe "Web.Page.Rep" $ do it "Rep mempty" $ runIdentity (runList (pure (mempty :: Text)) []) `shouldBe` [] it "mempty passes values through to hashmap" $ runIdentity (runList (pure (mempty :: Text)) testbs) `shouldBe` [ Right (fromList [("1","b1")], Right "") , Right (fromList [("1","b1"),("2","b2")], Right "") , Right (fromList [("1","b1"),("2","b2"),("3","b3")], Right "") ] it "button consumes an event and the value is transitory" $ runIdentity (runList ((,) <$> button Nothing <*> button Nothing) testbs) `shouldBe` [ Right (fromList [],Right (True,False)) , Right (fromList [],Right (False,True)) , Right (fromList [("3","b3")],Right (False,False)) ] it "repExamples versus canned" $ runIdentity (runOnce repExamples mempty) `shouldBe` (fromList [("7","3"),("1","sometext"),("4","0.5"),("2","no initial value & multi-line text\\nrenders is not ok?/"),("5","true"),("8","Square"),("3","3"),("6","false"),("9","#3880c8")],Right (RepExamples {repTextbox = "sometext", repTextarea = "no initial value & multi-line text\\nrenders is not ok?/", repSliderI = 3, repSlider = 0.5, repCheckbox = True, repToggle = False, repDropdown = 3, repShape = SquareShape, repColor = PixelRGB8 56 128 200})) it "listExample versus canned" $ runIdentity (runOnce (listExample 5) mempty) `shouldBe` (fromList [("1","0"),("4","3"),("2","1"),("5","4"),("3","2"),("6","5")],Right [0,1,2,3,4,5]) it "fiddleExample versus canned" $ runIdentity (runOnce (fiddle fiddleExample) mempty) `shouldBe` (fromList [("1",""),("2",""),("3","\n

fiddle example

\n")],Right (Concerns "" "" "\n

fiddle example

\n",False)) it "repExamples run through some canned events" $ runIdentity (runList (maybeRep Nothing True repExamples) testvs) `shouldBe` [Right (fromList [("7","true"),("4","no initial value & multi-line text\\nrenders is not ok?/"),("2","false"),("5","3"),("8","false"),("11","#3880c8"),("3","sometext"),("6","0.5"),("9","3"),("10","Square")],Right Nothing),Right (fromList [("7","true"),("4","no initial value & multi-line text\\nrenders is not ok?/"),("2","true"),("5","3"),("8","false"),("11","#3880c8"),("3","sometext"),("6","0.5"),("9","3"),("10","Square")],Right (Just (RepExamples {repTextbox = "sometext", repTextarea = "no initial value & multi-line text\\nrenders is not ok?/", repSliderI = 3, repSlider = 0.5, repCheckbox = True, repToggle = False, repDropdown = 3, repShape = SquareShape, repColor = PixelRGB8 56 128 200}))),Right (fromList [("7","true"),("4","no initial value & multi-line text\\nrenders is not ok?/"),("2","true"),("5","3"),("8","false"),("11","#3880c8"),("3","x"),("6","0.5"),("9","3"),("10","Square")],Right (Just (RepExamples {repTextbox = "x", repTextarea = "no initial value & multi-line text\\nrenders is not ok?/", repSliderI = 3, repSlider = 0.5, repCheckbox = True, repToggle = False, repDropdown = 3, repShape = SquareShape, repColor = PixelRGB8 56 128 200}))),Right (fromList [("7","true"),("4",""),("2","true"),("5","3"),("8","false"),("11","#3880c8"),("3","x"),("6","0.5"),("9","3"),("10","Square")],Right (Just (RepExamples {repTextbox = "x", repTextarea = "", repSliderI = 3, repSlider = 0.5, repCheckbox = True, repToggle = False, repDropdown = 3, repShape = SquareShape, repColor = PixelRGB8 56 128 200}))),Right (fromList [("7","true"),("4",""),("2","true"),("5","2"),("8","false"),("11","#3880c8"),("3","x"),("6","0.5"),("9","3"),("10","Square")],Right (Just (RepExamples {repTextbox = "x", repTextarea = "", repSliderI = 2, repSlider = 0.5, repCheckbox = True, repToggle = False, repDropdown = 3, repShape = SquareShape, repColor = PixelRGB8 56 128 200}))),Right (fromList [("7","true"),("4",""),("2","true"),("5","2"),("8","false"),("11","#3880c8"),("3","x"),("6","0.6"),("9","3"),("10","Square")],Right (Just (RepExamples {repTextbox = "x", repTextarea = "", repSliderI = 2, repSlider = 0.6, repCheckbox = True, repToggle = False, repDropdown = 3, repShape = SquareShape, repColor = PixelRGB8 56 128 200}))),Right (fromList [("7","false"),("4",""),("2","true"),("5","2"),("8","false"),("11","#3880c8"),("3","x"),("6","0.6"),("9","3"),("10","Square")],Right (Just (RepExamples {repTextbox = "x", repTextarea = "", repSliderI = 2, repSlider = 0.6, repCheckbox = False, repToggle = False, repDropdown = 3, repShape = SquareShape, repColor = PixelRGB8 56 128 200}))),Right (fromList [("7","false"),("4",""),("2","true"),("5","2"),("8","true"),("11","#3880c8"),("3","x"),("6","0.6"),("9","3"),("10","Square")],Right (Just (RepExamples {repTextbox = "x", repTextarea = "", repSliderI = 2, repSlider = 0.6, repCheckbox = False, repToggle = True, repDropdown = 3, repShape = SquareShape, repColor = PixelRGB8 56 128 200}))),Right (fromList [("7","false"),("4",""),("2","true"),("5","2"),("8","true"),("11","#3880c8"),("3","x"),("6","0.6"),("9","5"),("10","Square")],Right (Just (RepExamples {repTextbox = "x", repTextarea = "", repSliderI = 2, repSlider = 0.6, repCheckbox = False, repToggle = True, repDropdown = 5, repShape = SquareShape, repColor = PixelRGB8 56 128 200}))),Right (fromList [("7","false"),("4",""),("2","true"),("5","2"),("8","true"),("11","#3880c8"),("3","x"),("6","0.6"),("9","5"),("10","#00b4cc")],Right (Just (RepExamples {repTextbox = "x", repTextarea = "", repSliderI = 2, repSlider = 0.6, repCheckbox = False, repToggle = True, repDropdown = 5, repShape = CircleShape, repColor = PixelRGB8 56 128 200})))] -- The tests tests :: IO TestTree tests = testGroup "the tests" <$> sequence [ testSpec "Web.Page.Render" =<< testsRender , testSpec "Web.Page.Bootstrap" =<< testsBootstrap , testSpec "Web.Page.Bridge" =<< testsBridge , testSpec "Web.Page.Rep" =<< testsRep ] main :: IO () main = defaultMain =<< tests