{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE TemplateHaskell #-} module Emanote.Model.SData where import Data.Aeson qualified as Aeson import Data.Aeson.Extra.Merge qualified as AesonMerge import Data.Aeson.KeyMap qualified as KM import Data.Data (Data) import Data.IxSet.Typed (Indexable (..), IxSet, ixGen, ixList) import Data.List.NonEmpty qualified as NE import Data.Yaml qualified as Yaml import Emanote.Route qualified as R import Optics.TH (makeLenses) import Relude {- | `S` for "structured". Refers to a per-route data file represented by Aeson value. Example: /foo/bar.yaml file -} data SData = SData { _sdataValue :: Aeson.Value , _sdataRoute :: R.R 'R.Yaml -- ^ Location of this data file } deriving stock (Eq, Ord, Data, Show, Generic) deriving anyclass (Aeson.ToJSON) type SDataIxs = '[R.R 'R.Yaml] type IxSData = IxSet SDataIxs SData instance Indexable SDataIxs SData where indices = ixList (ixGen $ Proxy @(R.R 'R.Yaml)) makeLenses ''SData parseSDataCascading :: R.R 'R.Yaml -> NonEmpty (FilePath, ByteString) -> Either Text SData parseSDataCascading r bs = do vals <- forM bs $ \(fp, b) -> (first (\err -> toText $ "Failed to parse " <> fp <> " :" <> Yaml.prettyPrintParseException err) . Yaml.decodeEither') b let val = mergeAesons vals pure $ SData val r -- | Later values override former. mergeAesons :: NonEmpty Aeson.Value -> Aeson.Value mergeAesons = last . NE.scanl1 mergeAeson mergeAeson :: Aeson.Value -> Aeson.Value -> Aeson.Value mergeAeson = AesonMerge.lodashMerge -- TODO: Use https://hackage.haskell.org/package/lens-aeson lookupAeson :: forall a. (Aeson.FromJSON a) => a -> NonEmpty Text -> Aeson.Value -> a lookupAeson x (k :| ks) meta = fromMaybe x $ do Aeson.Object obj <- pure meta val <- KM.lookup (fromString . toString $ k) obj case nonEmpty ks of Nothing -> resultToMaybe $ Aeson.fromJSON val Just ks' -> pure $ lookupAeson x ks' val where resultToMaybe :: Aeson.Result b -> Maybe b resultToMaybe = \case Aeson.Error _ -> Nothing Aeson.Success b -> pure b oneAesonText :: [Text] -> Text -> Aeson.Value oneAesonText k v = case nonEmpty k of Nothing -> Aeson.String v Just (x :| xs) -> Aeson.object [(fromString . toString) x Aeson..= oneAesonText (toList xs) v]