{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module      : Language.Github.Actions.UnstructuredMap
-- Description : Flexible value types for GitHub Actions YAML parsing
-- Copyright   : (c) 2025 Bellroy Pty Ltd
-- License     : BSD-3-Clause
-- Maintainer  : Bellroy Tech Team <haskell@bellroy.com>
--
-- This module provides the 'UnstructuredMap' type for representing a map of
-- values that can be strings, numbers, or booleans in GitHub Actions YAML files.
--
-- GitHub Actions allows flexible typing in many contexts:
-- * @retention-days: 1@ (number)
-- * @retention-days: "1"@ (string)
-- * @should-retain: false@ (boolean)
--
-- This type preserves the original YAML type during round-trip parsing,
-- ensuring that numeric values remain numeric and strings remain strings.
module Language.Github.Actions.UnstructuredMap
  ( UnstructuredValue (..),
    UnstructuredMap (..),
    renderUnstructuredValue,
    gen,
  )
where

import Data.Aeson (FromJSON, ToJSON (..), Value (..))
import qualified Data.Aeson as Aeson
import Data.Map (Map)
import Data.Text (Text)
import qualified Data.Text as Text
import GHC.Generics (Generic)
import Hedgehog (MonadGen)
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range

-- | A map that can have values of string, number, or boolean.
--
-- This type is designed to handle the flexible typing that GitHub Actions
-- allows in YAML files.
--
-- The type preserves the original format during round-trip serialization,
-- so numeric inputs remain numeric in the output YAML.
data UnstructuredValue
  = UnstructuredValueString Text
  | UnstructuredValueNumber Double
  | UnstructuredValueBool Bool
  deriving stock (UnstructuredValue -> UnstructuredValue -> Bool
(UnstructuredValue -> UnstructuredValue -> Bool)
-> (UnstructuredValue -> UnstructuredValue -> Bool)
-> Eq UnstructuredValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UnstructuredValue -> UnstructuredValue -> Bool
== :: UnstructuredValue -> UnstructuredValue -> Bool
$c/= :: UnstructuredValue -> UnstructuredValue -> Bool
/= :: UnstructuredValue -> UnstructuredValue -> Bool
Eq, (forall x. UnstructuredValue -> Rep UnstructuredValue x)
-> (forall x. Rep UnstructuredValue x -> UnstructuredValue)
-> Generic UnstructuredValue
forall x. Rep UnstructuredValue x -> UnstructuredValue
forall x. UnstructuredValue -> Rep UnstructuredValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UnstructuredValue -> Rep UnstructuredValue x
from :: forall x. UnstructuredValue -> Rep UnstructuredValue x
$cto :: forall x. Rep UnstructuredValue x -> UnstructuredValue
to :: forall x. Rep UnstructuredValue x -> UnstructuredValue
Generic, Eq UnstructuredValue
Eq UnstructuredValue =>
(UnstructuredValue -> UnstructuredValue -> Ordering)
-> (UnstructuredValue -> UnstructuredValue -> Bool)
-> (UnstructuredValue -> UnstructuredValue -> Bool)
-> (UnstructuredValue -> UnstructuredValue -> Bool)
-> (UnstructuredValue -> UnstructuredValue -> Bool)
-> (UnstructuredValue -> UnstructuredValue -> UnstructuredValue)
-> (UnstructuredValue -> UnstructuredValue -> UnstructuredValue)
-> Ord UnstructuredValue
UnstructuredValue -> UnstructuredValue -> Bool
UnstructuredValue -> UnstructuredValue -> Ordering
UnstructuredValue -> UnstructuredValue -> UnstructuredValue
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 :: UnstructuredValue -> UnstructuredValue -> Ordering
compare :: UnstructuredValue -> UnstructuredValue -> Ordering
$c< :: UnstructuredValue -> UnstructuredValue -> Bool
< :: UnstructuredValue -> UnstructuredValue -> Bool
$c<= :: UnstructuredValue -> UnstructuredValue -> Bool
<= :: UnstructuredValue -> UnstructuredValue -> Bool
$c> :: UnstructuredValue -> UnstructuredValue -> Bool
> :: UnstructuredValue -> UnstructuredValue -> Bool
$c>= :: UnstructuredValue -> UnstructuredValue -> Bool
>= :: UnstructuredValue -> UnstructuredValue -> Bool
$cmax :: UnstructuredValue -> UnstructuredValue -> UnstructuredValue
max :: UnstructuredValue -> UnstructuredValue -> UnstructuredValue
$cmin :: UnstructuredValue -> UnstructuredValue -> UnstructuredValue
min :: UnstructuredValue -> UnstructuredValue -> UnstructuredValue
Ord, Int -> UnstructuredValue -> ShowS
[UnstructuredValue] -> ShowS
UnstructuredValue -> String
(Int -> UnstructuredValue -> ShowS)
-> (UnstructuredValue -> String)
-> ([UnstructuredValue] -> ShowS)
-> Show UnstructuredValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UnstructuredValue -> ShowS
showsPrec :: Int -> UnstructuredValue -> ShowS
$cshow :: UnstructuredValue -> String
show :: UnstructuredValue -> String
$cshowList :: [UnstructuredValue] -> ShowS
showList :: [UnstructuredValue] -> ShowS
Show)

instance FromJSON UnstructuredValue where
  parseJSON :: Value -> Parser UnstructuredValue
parseJSON (String Text
s) = UnstructuredValue -> Parser UnstructuredValue
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UnstructuredValue -> Parser UnstructuredValue)
-> UnstructuredValue -> Parser UnstructuredValue
forall a b. (a -> b) -> a -> b
$ Text -> UnstructuredValue
UnstructuredValueString Text
s
  parseJSON (Number Scientific
n) = UnstructuredValue -> Parser UnstructuredValue
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UnstructuredValue -> Parser UnstructuredValue)
-> UnstructuredValue -> Parser UnstructuredValue
forall a b. (a -> b) -> a -> b
$ Double -> UnstructuredValue
UnstructuredValueNumber (Scientific -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Scientific
n)
  parseJSON (Bool Bool
b) = UnstructuredValue -> Parser UnstructuredValue
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UnstructuredValue -> Parser UnstructuredValue)
-> UnstructuredValue -> Parser UnstructuredValue
forall a b. (a -> b) -> a -> b
$ Bool -> UnstructuredValue
UnstructuredValueBool Bool
b
  parseJSON Value
v = String -> Parser UnstructuredValue
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser UnstructuredValue)
-> String -> Parser UnstructuredValue
forall a b. (a -> b) -> a -> b
$ String
"Expected String, Number, or Bool for UnstructuredValue, got: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Value -> String
forall a. Show a => a -> String
show Value
v

instance ToJSON UnstructuredValue where
  toJSON :: UnstructuredValue -> Value
toJSON (UnstructuredValueString Text
s) = Text -> Value
String Text
s
  toJSON (UnstructuredValueNumber Double
n) = Scientific -> Value
Number (Rational -> Scientific
forall a. Fractional a => Rational -> a
fromRational (Double -> Rational
forall a. Real a => a -> Rational
toRational Double
n))
  toJSON (UnstructuredValueBool Bool
b) = Bool -> Value
Bool Bool
b

renderUnstructuredValue :: UnstructuredValue -> Text
renderUnstructuredValue :: UnstructuredValue -> Text
renderUnstructuredValue (UnstructuredValueString Text
s) = Text
s
renderUnstructuredValue (UnstructuredValueNumber Double
n) =
  -- Format numbers nicely, avoiding unnecessary decimal places for integers
  if Double
n Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Integer -> Double
forall a. Num a => Integer -> a
fromInteger (Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
n)
    then String -> Text
Text.pack (Integer -> String
forall a. Show a => a -> String
show (Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
n :: Integer))
    else String -> Text
Text.pack (Double -> String
forall a. Show a => a -> String
show Double
n)
renderUnstructuredValue (UnstructuredValueBool Bool
b) = if Bool
b then Text
"true" else Text
"false"

newtype UnstructuredMap = UnstructuredMap (Map Text UnstructuredValue)
  deriving stock (UnstructuredMap -> UnstructuredMap -> Bool
(UnstructuredMap -> UnstructuredMap -> Bool)
-> (UnstructuredMap -> UnstructuredMap -> Bool)
-> Eq UnstructuredMap
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UnstructuredMap -> UnstructuredMap -> Bool
== :: UnstructuredMap -> UnstructuredMap -> Bool
$c/= :: UnstructuredMap -> UnstructuredMap -> Bool
/= :: UnstructuredMap -> UnstructuredMap -> Bool
Eq, (forall x. UnstructuredMap -> Rep UnstructuredMap x)
-> (forall x. Rep UnstructuredMap x -> UnstructuredMap)
-> Generic UnstructuredMap
forall x. Rep UnstructuredMap x -> UnstructuredMap
forall x. UnstructuredMap -> Rep UnstructuredMap x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UnstructuredMap -> Rep UnstructuredMap x
from :: forall x. UnstructuredMap -> Rep UnstructuredMap x
$cto :: forall x. Rep UnstructuredMap x -> UnstructuredMap
to :: forall x. Rep UnstructuredMap x -> UnstructuredMap
Generic, Eq UnstructuredMap
Eq UnstructuredMap =>
(UnstructuredMap -> UnstructuredMap -> Ordering)
-> (UnstructuredMap -> UnstructuredMap -> Bool)
-> (UnstructuredMap -> UnstructuredMap -> Bool)
-> (UnstructuredMap -> UnstructuredMap -> Bool)
-> (UnstructuredMap -> UnstructuredMap -> Bool)
-> (UnstructuredMap -> UnstructuredMap -> UnstructuredMap)
-> (UnstructuredMap -> UnstructuredMap -> UnstructuredMap)
-> Ord UnstructuredMap
UnstructuredMap -> UnstructuredMap -> Bool
UnstructuredMap -> UnstructuredMap -> Ordering
UnstructuredMap -> UnstructuredMap -> UnstructuredMap
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 :: UnstructuredMap -> UnstructuredMap -> Ordering
compare :: UnstructuredMap -> UnstructuredMap -> Ordering
$c< :: UnstructuredMap -> UnstructuredMap -> Bool
< :: UnstructuredMap -> UnstructuredMap -> Bool
$c<= :: UnstructuredMap -> UnstructuredMap -> Bool
<= :: UnstructuredMap -> UnstructuredMap -> Bool
$c> :: UnstructuredMap -> UnstructuredMap -> Bool
> :: UnstructuredMap -> UnstructuredMap -> Bool
$c>= :: UnstructuredMap -> UnstructuredMap -> Bool
>= :: UnstructuredMap -> UnstructuredMap -> Bool
$cmax :: UnstructuredMap -> UnstructuredMap -> UnstructuredMap
max :: UnstructuredMap -> UnstructuredMap -> UnstructuredMap
$cmin :: UnstructuredMap -> UnstructuredMap -> UnstructuredMap
min :: UnstructuredMap -> UnstructuredMap -> UnstructuredMap
Ord, Int -> UnstructuredMap -> ShowS
[UnstructuredMap] -> ShowS
UnstructuredMap -> String
(Int -> UnstructuredMap -> ShowS)
-> (UnstructuredMap -> String)
-> ([UnstructuredMap] -> ShowS)
-> Show UnstructuredMap
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UnstructuredMap -> ShowS
showsPrec :: Int -> UnstructuredMap -> ShowS
$cshow :: UnstructuredMap -> String
show :: UnstructuredMap -> String
$cshowList :: [UnstructuredMap] -> ShowS
showList :: [UnstructuredMap] -> ShowS
Show)
  deriving newtype (Maybe UnstructuredMap
Value -> Parser [UnstructuredMap]
Value -> Parser UnstructuredMap
(Value -> Parser UnstructuredMap)
-> (Value -> Parser [UnstructuredMap])
-> Maybe UnstructuredMap
-> FromJSON UnstructuredMap
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser UnstructuredMap
parseJSON :: Value -> Parser UnstructuredMap
$cparseJSONList :: Value -> Parser [UnstructuredMap]
parseJSONList :: Value -> Parser [UnstructuredMap]
$comittedField :: Maybe UnstructuredMap
omittedField :: Maybe UnstructuredMap
FromJSON, [UnstructuredMap] -> Value
[UnstructuredMap] -> Encoding
UnstructuredMap -> Bool
UnstructuredMap -> Value
UnstructuredMap -> Encoding
(UnstructuredMap -> Value)
-> (UnstructuredMap -> Encoding)
-> ([UnstructuredMap] -> Value)
-> ([UnstructuredMap] -> Encoding)
-> (UnstructuredMap -> Bool)
-> ToJSON UnstructuredMap
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: UnstructuredMap -> Value
toJSON :: UnstructuredMap -> Value
$ctoEncoding :: UnstructuredMap -> Encoding
toEncoding :: UnstructuredMap -> Encoding
$ctoJSONList :: [UnstructuredMap] -> Value
toJSONList :: [UnstructuredMap] -> Value
$ctoEncodingList :: [UnstructuredMap] -> Encoding
toEncodingList :: [UnstructuredMap] -> Encoding
$comitField :: UnstructuredMap -> Bool
omitField :: UnstructuredMap -> Bool
ToJSON)

genUnstructuredValue :: (MonadGen m) => m UnstructuredValue
genUnstructuredValue :: forall (m :: * -> *). MonadGen m => m UnstructuredValue
genUnstructuredValue =
  [m UnstructuredValue] -> m UnstructuredValue
forall (m :: * -> *) a. MonadGen m => [m a] -> m a
Gen.choice
    [ Text -> UnstructuredValue
UnstructuredValueString (Text -> UnstructuredValue) -> m Text -> m UnstructuredValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Int -> m Char -> m Text
forall (m :: * -> *). MonadGen m => Range Int -> m Char -> m Text
Gen.text (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
1 Int
20) m Char
forall (m :: * -> *). MonadGen m => m Char
Gen.alphaNum,
      Double -> UnstructuredValue
UnstructuredValueNumber (Double -> UnstructuredValue) -> m Double -> m UnstructuredValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Double -> m Double
forall (m :: * -> *) a. (MonadGen m, RealFloat a) => Range a -> m a
Gen.realFloat (Double -> Double -> Range Double
forall a. (Fractional a, Ord a) => a -> a -> Range a
Range.linearFrac Double
0 Double
1000),
      Bool -> UnstructuredValue
UnstructuredValueBool (Bool -> UnstructuredValue) -> m Bool -> m UnstructuredValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Bool
forall (m :: * -> *). MonadGen m => m Bool
Gen.bool
    ]

gen :: (MonadGen m) => m UnstructuredMap
gen :: forall (m :: * -> *). MonadGen m => m UnstructuredMap
gen = Map Text UnstructuredValue -> UnstructuredMap
UnstructuredMap (Map Text UnstructuredValue -> UnstructuredMap)
-> m (Map Text UnstructuredValue) -> m UnstructuredMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Int
-> m (Text, UnstructuredValue) -> m (Map Text UnstructuredValue)
forall (m :: * -> *) k v.
(MonadGen m, Ord k) =>
Range Int -> m (k, v) -> m (Map k v)
Gen.map (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
0 Int
10) m (Text, UnstructuredValue)
genKeyValue
  where
    genKeyValue :: m (Text, UnstructuredValue)
genKeyValue = do
      Text
key <- Range Int -> m Char -> m Text
forall (m :: * -> *). MonadGen m => Range Int -> m Char -> m Text
Gen.text (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
1 Int
20) m Char
forall (m :: * -> *). MonadGen m => m Char
Gen.alphaNum
      UnstructuredValue
value <- m UnstructuredValue
forall (m :: * -> *). MonadGen m => m UnstructuredValue
genUnstructuredValue
      (Text, UnstructuredValue) -> m (Text, UnstructuredValue)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
key, UnstructuredValue
value)