module Stackctl.StackDescription
  ( StackDescription (..)
  , addStackDescription
  ) where

import Stackctl.Prelude

import Control.Lens ((?~))
import Data.Aeson (FromJSON, Value (..))
import qualified Data.Aeson as JSON
import Data.Aeson.Lens
import Data.ByteString.Char8 as BS8
import qualified Data.Yaml as Yaml

newtype StackDescription = StackDescription
  { StackDescription -> Text
unStackDescription :: Text
  }
  deriving newtype (StackDescription -> StackDescription -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StackDescription -> StackDescription -> Bool
$c/= :: StackDescription -> StackDescription -> Bool
== :: StackDescription -> StackDescription -> Bool
$c== :: StackDescription -> StackDescription -> Bool
Eq, Eq StackDescription
StackDescription -> StackDescription -> Bool
StackDescription -> StackDescription -> Ordering
StackDescription -> StackDescription -> StackDescription
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
min :: StackDescription -> StackDescription -> StackDescription
$cmin :: StackDescription -> StackDescription -> StackDescription
max :: StackDescription -> StackDescription -> StackDescription
$cmax :: StackDescription -> StackDescription -> StackDescription
>= :: StackDescription -> StackDescription -> Bool
$c>= :: StackDescription -> StackDescription -> Bool
> :: StackDescription -> StackDescription -> Bool
$c> :: StackDescription -> StackDescription -> Bool
<= :: StackDescription -> StackDescription -> Bool
$c<= :: StackDescription -> StackDescription -> Bool
< :: StackDescription -> StackDescription -> Bool
$c< :: StackDescription -> StackDescription -> Bool
compare :: StackDescription -> StackDescription -> Ordering
$ccompare :: StackDescription -> StackDescription -> Ordering
Ord, Int -> StackDescription -> ShowS
[StackDescription] -> ShowS
StackDescription -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StackDescription] -> ShowS
$cshowList :: [StackDescription] -> ShowS
show :: StackDescription -> String
$cshow :: StackDescription -> String
showsPrec :: Int -> StackDescription -> ShowS
$cshowsPrec :: Int -> StackDescription -> ShowS
Show, Value -> Parser [StackDescription]
Value -> Parser StackDescription
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [StackDescription]
$cparseJSONList :: Value -> Parser [StackDescription]
parseJSON :: Value -> Parser StackDescription
$cparseJSON :: Value -> Parser StackDescription
FromJSON, [StackDescription] -> Encoding
[StackDescription] -> Value
StackDescription -> Encoding
StackDescription -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [StackDescription] -> Encoding
$ctoEncodingList :: [StackDescription] -> Encoding
toJSONList :: [StackDescription] -> Value
$ctoJSONList :: [StackDescription] -> Value
toEncoding :: StackDescription -> Encoding
$ctoEncoding :: StackDescription -> Encoding
toJSON :: StackDescription -> Value
$ctoJSON :: StackDescription -> Value
ToJSON)

data BodyContent
  = BodyContentJSON Value
  | BodyContentYaml Value

addStackDescription :: Maybe StackDescription -> Text -> Text
addStackDescription :: Maybe StackDescription -> Text -> Text
addStackDescription Maybe StackDescription
mStackDescription Text
body = forall a. a -> Maybe a -> a
fromMaybe Text
body forall a b. (a -> b) -> a -> b
$ do
  StackDescription Text
d <- Maybe StackDescription
mStackDescription
  BodyContent
bc <- ByteString -> Maybe BodyContent
getBodyContent ByteString
bs
  ByteString -> Text
decodeUtf8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case BodyContent
bc of
    BodyContentJSON Value
v -> Text -> ByteString -> ByteString
updateJSON Text
d ByteString
bs forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Value -> Bool
hasDescription Value
v)
    BodyContentYaml Value
v -> Text -> ByteString -> ByteString
updateYaml Text
d ByteString
bs forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Value -> Bool
hasDescription Value
v)
 where
  bs :: ByteString
bs = Text -> ByteString
encodeUtf8 Text
body

getBodyContent :: ByteString -> Maybe BodyContent
getBodyContent :: ByteString -> Maybe BodyContent
getBodyContent ByteString
body =
  forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ Value -> BodyContent
BodyContentJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> Value
Object forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => ByteString -> Maybe a
JSON.decodeStrict ByteString
body
    , forall a b. Either a b -> Maybe b
hush forall a b. (a -> b) -> a -> b
$ Value -> BodyContent
BodyContentYaml forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> Value
Object forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => ByteString -> Either ParseException a
Yaml.decodeEither' ByteString
body
    ]

-- Inserting a key is easy to do in Yaml without the parsing round-trip that
-- would strip formatting and comments. But updating a key is hard. To avoid
-- this, we just say that we never clobber existing keys.
hasDescription :: Value -> Bool
hasDescription :: Value -> Bool
hasDescription = forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall s a. s -> Getting (First a) s a -> Maybe a
^? forall t. AsValue t => Key -> Traversal' t Value
key Key
"Description" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t Text
_String)

-- For JSON, don't worry about preserving formatting; do a proper update.
updateJSON :: Text -> ByteString -> ByteString
updateJSON :: Text -> ByteString -> ByteString
updateJSON Text
d = forall t. AsValue t => Key -> Traversal' t (Maybe Value)
atKey Key
"Description" forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
String Text
d

-- For Yaml, insert textually to avoid a round-trip dropping comments or
-- changing whitespace. We rely on 'Show' as a naive escape.
updateYaml :: Text -> ByteString -> ByteString
updateYaml :: Text -> ByteString -> ByteString
updateYaml Text
d ByteString
bs = ByteString
"Description: " forall a. Semigroup a => a -> a -> a
<> String -> ByteString
BS8.pack (forall a. Show a => a -> String
show Text
d) forall a. Semigroup a => a -> a -> a
<> ByteString
"\n" forall a. Semigroup a => a -> a -> a
<> ByteString
bs