toml-parser-1.1.1.0: test/DecodeSpec.hs

{-# Language DuplicateRecordFields #-}
module DecodeSpec (spec) where

import Data.Map qualified as Map
import Data.Maybe (fromMaybe)
import GHC.Generics (Generic)
import QuoteStr (quoteStr)
import Test.Hspec (it, shouldBe, Spec)
import Toml (decode, Result(Success), encode)
import Toml.FromValue (FromTable(..), FromValue(..), defaultTableFromValue, runParseTable, reqKey, optKey)
import Toml.FromValue.Generic (genericFromTable)
import Toml.ToValue (ToTable(..), ToValue(toValue), (.=), defaultTableToValue)
import Toml.ToValue.Generic (genericToTable)
import Toml (Result(..))

newtype Fruits = Fruits { fruits :: [Fruit] }
    deriving (Eq, Show, Generic)

data Fruit = Fruit {
    name :: String,
    physical :: Maybe Physical,
    varieties :: [Variety]
    } deriving (Eq, Show, Generic)

data Physical = Physical {
    color :: String,
    shape :: String
    } deriving (Eq, Show, Generic)

newtype Variety = Variety {
    name :: String
    } deriving (Eq, Show, Generic)

instance FromTable Fruits   where fromTable = genericFromTable
instance FromTable Physical where fromTable = genericFromTable
instance FromTable Variety  where fromTable = genericFromTable

instance FromValue Fruits   where fromValue = defaultTableFromValue
instance FromValue Fruit    where fromValue = defaultTableFromValue
instance FromValue Physical where fromValue = defaultTableFromValue
instance FromValue Variety  where fromValue = defaultTableFromValue

instance ToTable Fruits   where toTable = genericToTable
instance ToTable Physical where toTable = genericToTable
instance ToTable Variety  where toTable = genericToTable

instance ToValue Fruits   where toValue = defaultTableToValue
instance ToValue Fruit    where toValue = defaultTableToValue
instance ToValue Physical where toValue = defaultTableToValue
instance ToValue Variety  where toValue = defaultTableToValue

instance FromTable Fruit where
    fromTable = runParseTable (Fruit
        <$> reqKey "name"
        <*> optKey "physical"
        <*> (fromMaybe [] <$> optKey "varieties"))

instance ToTable Fruit where
    toTable (Fruit n mbp vs) = Map.fromList $
        ["varieties" .= vs | not (null vs)] ++
        ["physical"  .= p | Just p <- [mbp]] ++
        ["name"      .= n]

spec :: Spec
spec =
 do let expect = Fruits [
            Fruit "apple" (Just (Physical "red" "round")) [Variety "red delicious", Variety "granny smith"],
            Fruit "banana" Nothing [Variety "plantain"]]

    it "handles fruit example" $
        decode [quoteStr|
            [[fruits]]
            name = "apple"

            [fruits.physical]  # subtable
            color = "red"
            shape = "round"

            [[fruits.varieties]]  # nested array of tables
            name = "red delicious"

            [[fruits.varieties]]
            name = "granny smith"

            [[fruits]]
            name = "banana"

            [[fruits.varieties]]
            name = "plantain"|]
        `shouldBe`
        Success mempty expect

    it "encodes correctly" $
        show (encode expect)
        `shouldBe`
        [quoteStr|
            [[fruits]]
            name = "apple"

            [fruits.physical]
            color = "red"
            shape = "round"

            [[fruits.varieties]]
            name = "red delicious"

            [[fruits.varieties]]
            name = "granny smith"

            [[fruits]]
            name = "banana"

            [[fruits.varieties]]
            name = "plantain"|]

    it "generates warnings for unused keys" $
        decode [quoteStr|
            [[fruits]]
            name = "peach"
            taste = "sweet"
            count = 5
            [[fruits]]
            name = "pineapple"
            color = "yellow"|]
        `shouldBe`
        Success [
            "Unexpected keys: count, taste in top.fruits[0]",
            "Unexpected key: color in top.fruits[1]"]
            (Fruits [Fruit "peach" Nothing [], Fruit "pineapple" Nothing []])
    
    it "handles missing key errors" $
        (decode "[[fruits]]" :: Result Fruits)
        `shouldBe`
        Failure ["Missing key: name in top.fruits[0]"]

    it "handles parse errors while decoding" $
        (decode "x =" :: Result Fruits)
        `shouldBe`
        Failure ["1:4: parse error: unexpected end-of-input"]