InterpreterTests.hs

{-# LANGUAGE OverloadedStrings #-}

module Boilerplate.InterpreterTests where

import Boilerplate.Interpreter
import Boilerplate.RuleParserTests (ffunctorRule, fromJSONRule, toJSONRule)
import Boilerplate.Types
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Data.Text (Text)
import Test.Tasty.Hspec

-- data Coord = Coordy Double Double
egProduct :: Type
egProduct = ProductType "Coord" [] "Coordy" ["Double", "Double"]

-- data Coord = Coordy { a :: Double, b :: Double}
egRecord :: Type
egRecord = RecordType "Coord" [] "Coordy" [("a", "Double"), ("b", "Double")]

-- data Union = Wales String | England Int Int | Scotland
egSum :: Type
egSum = SumType "Union" [] [ ("Wales", ["String"]), ("England", ["Int", "Int"]), ("Scotland", [])]

-- data Things a b = T a b Double
egPolyProduct :: Type
egPolyProduct = ProductType "Things" ["a", "b"] "T" ["a", "b", "Double"]

-- data Logger m = Logger { log :: Text -> m () }
egPolyRecord :: Type
egPolyRecord = RecordType "Logger" ["m"] "Logger" [("log", "Text -> m ()")]

-- data Action a = Admin [a] Text | User a Text
egPolySum :: Type
egPolySum = SumType "Action" ["a"] [("Admin", ["[a]", "Text"]), ("User", ["a", "Text"])]

custom :: Text -> Custom -> Map Text Custom
custom key value = M.fromList [(key, value)]

spec_interpreter :: Spec
spec_interpreter = do
  it "should interpret ToJSON for products" $ do
    let options = custom "field" $ Indexed ["x", "y"]
    interpretRule toJSONRule egProduct options `shouldBe`
      Right "instance ToJSON Coord where\n\
            \  toJSON (Coordy p_1_1 p_1_2) = object [\"x\" .= p_1_1, \"y\" .= p_1_2]\n\
            \  toEncoding (Coordy p_1_1 p_1_2) = pairs (\"x\" .= p_1_1 <> \"y\" .= p_1_2)"

  it "should interpret FromJSON for products" $ do
    let options = custom "field" $ Indexed ["x", "y"]
    interpretRule fromJSONRule egProduct options `shouldBe`
      Right "instance FromJSON Coord where\n\
            \  parseJSON = withObject \"Coord\" $ \\v ->\n\
            \    Coordy <$> v .: \"x\" <*> v .: \"y\""

  it "should interpret FromJSON for records" $ do
    interpretRule fromJSONRule egRecord M.empty `shouldBe`
      Right "instance FromJSON Coord where\n\
            \  parseJSON = withObject \"Coord\" $ \\v ->\n\
            \    Coordy <$> v .: \"a\" <*> v .: \"b\""

  it "should interpret ToJSON for polymorphic products" $ do
    let options = custom "field" $ Indexed ["x", "y", "z"]
    interpretRule toJSONRule egPolyProduct options `shouldBe`
      Right "instance (ToJSON a, ToJSON b) => ToJSON (Things a b) where\n\
            \  toJSON (T p_1_1 p_1_2 p_1_3) = object [\"x\" .= p_1_1, \"y\" .= p_1_2, \"z\" .= p_1_3]\n\
            \  toEncoding (T p_1_1 p_1_2 p_1_3) = pairs (\"x\" .= p_1_1 <> \"y\" .= p_1_2 <> \"z\" .= p_1_3)"

  it "should interpret FFunctor for polymorphic records" $ do
    interpretRule ffunctorRule egPolyRecord M.empty `shouldBe`
      Right "instance FFunctor Logger where\n\
            \  ffmap nt (Logger p_1_1) = Logger (nt ... p_1_1)"

  it "should interpret ToJSON for polymorphic sum" $ do
    let options = custom "field" $ Indexed ["x", "y", "z"]
    interpretRule toJSONRule egPolySum options `shouldBe`
      Right "instance (ToJSON a) => ToJSON (Action a) where\n\
            \  toJSON (Admin p_1_1 p_1_2) = object [\"Admin\" .= object [\"x\" .= p_1_1, \"y\" .= p_1_2]]\n\
            \  toJSON (User p_1_1 p_1_2) = object [\"User\" .= object [\"x\" .= p_1_1, \"y\" .= p_1_2]]"

  it "should interpret ToJSON for records without custom" $ do
    interpretRule toJSONRule egRecord M.empty `shouldBe`
      Right "instance ToJSON Coord where\n\
            \  toJSON (Coordy p_1_1 p_1_2) = object [\"a\" .= p_1_1, \"b\" .= p_1_2]\n\
            \  toEncoding (Coordy p_1_1 p_1_2) = pairs (\"a\" .= p_1_1 <> \"b\" .= p_1_2)"

  it "should interpret ToJSON for records with custom" $ do
    let options = custom "field" . Named $ M.fromList [("a", "aa"), ("b", "bb")]
    interpretRule toJSONRule egRecord options `shouldBe`
      Right "instance ToJSON Coord where\n\
            \  toJSON (Coordy p_1_1 p_1_2) = object [\"aa\" .= p_1_1, \"bb\" .= p_1_2]\n\
            \  toEncoding (Coordy p_1_1 p_1_2) = pairs (\"aa\" .= p_1_1 <> \"bb\" .= p_1_2)"

  it "should interpret ToJSON for sum types" $ do
    let options = custom "field" . NamedIndexed $ M.fromList [("Wales", ["foo"]), ("England", ["a", "b"]), ("Scotland", [])]
    interpretRule toJSONRule egSum options `shouldBe`
      Right "instance ToJSON Union where\n\
            \  toJSON (Wales p_1_1) = object [\"Wales\" .= object [\"foo\" .= p_1_1]]\n\
            \  toJSON (England p_1_1 p_1_2) = object [\"England\" .= object [\"a\" .= p_1_1, \"b\" .= p_1_2]]\n\
            \  toJSON Scotland = object [\"Scotland\" .= object []]"

  it "should interpret FromJSON for sum types" $ do
    let options = custom "field" . NamedIndexed $ M.fromList [("Wales", ["foo"]), ("England", ["a", "b"]), ("Scotland", [])]
    interpretRule fromJSONRule egSum options `shouldBe`
      Right "instance FromJSON Union where\n\
            \  parseJSON = withObject \"Union\" $ \\v ->\n\
            \    let withField key parse = (maybe (fail \"\") pure $ H.lookup key v) >>= (withObject (T.unpack key) parse)\n\
            \     in (withField \"Wales\" $ \\v' -> Wales <$> v' .: \"foo\")\n\
            \    <|> (withField \"England\" $ \\v' -> England <$> v' .: \"a\" <*> v' .: \"b\")\n\
            \    <|> (withField \"Scotland\" $ \\_ -> pure Scotland)\n\
            \    <|> (fail \"no valid type constructor tags\")"

  it "should interpret ToJSON for sum types, extra options" $ do
    let options = M.fromList [("field", NamedIndexed $ M.fromList [("Wales", ["foo"]), ("England", ["a", "b"]), ("Scotland", [])]),
                              ("tag", Named $ M.fromList [("Wales", "dragon"), ("England", "lion"), ("Scotland", "unicorn")])]
    interpretRule toJSONRule egSum options `shouldBe`
      Right "instance ToJSON Union where\n\
            \  toJSON (Wales p_1_1) = object [\"dragon\" .= object [\"foo\" .= p_1_1]]\n\
            \  toJSON (England p_1_1 p_1_2) = object [\"lion\" .= object [\"a\" .= p_1_1, \"b\" .= p_1_2]]\n\
            \  toJSON Scotland = object [\"unicorn\" .= object []]"