{-# 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
  { SData -> Value
_sdataValue :: Aeson.Value
  , SData -> R @SourceExt 'Yaml
_sdataRoute :: R.R 'R.Yaml
  -- ^ Location of this data file
  }
  deriving stock (SData -> SData -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SData -> SData -> Bool
$c/= :: SData -> SData -> Bool
== :: SData -> SData -> Bool
$c== :: SData -> SData -> Bool
Eq, Eq SData
SData -> SData -> Bool
SData -> SData -> Ordering
SData -> SData -> SData
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 :: SData -> SData -> SData
$cmin :: SData -> SData -> SData
max :: SData -> SData -> SData
$cmax :: SData -> SData -> SData
>= :: SData -> SData -> Bool
$c>= :: SData -> SData -> Bool
> :: SData -> SData -> Bool
$c> :: SData -> SData -> Bool
<= :: SData -> SData -> Bool
$c<= :: SData -> SData -> Bool
< :: SData -> SData -> Bool
$c< :: SData -> SData -> Bool
compare :: SData -> SData -> Ordering
$ccompare :: SData -> SData -> Ordering
Ord, Typeable @Type SData
SData -> DataType
SData -> Constr
(forall b. Data b => b -> b) -> SData -> SData
forall a.
Typeable @Type a
-> (forall (c :: Type -> Type).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: Type -> Type).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
    Typeable @(Type -> Type) t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
    Typeable @(Type -> Type -> Type) t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: Type -> Type).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> SData -> u
forall u. (forall d. Data d => d -> u) -> SData -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SData -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SData -> r
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> SData -> m SData
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SData -> m SData
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SData
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SData -> c SData
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable @(Type -> Type) t =>
(forall d. Data d => c (t d)) -> Maybe (c SData)
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable @(Type -> Type -> Type) t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SData)
gmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SData -> m SData
$cgmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SData -> m SData
gmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SData -> m SData
$cgmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SData -> m SData
gmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> SData -> m SData
$cgmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> SData -> m SData
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SData -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SData -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> SData -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SData -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SData -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SData -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SData -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SData -> r
gmapT :: (forall b. Data b => b -> b) -> SData -> SData
$cgmapT :: (forall b. Data b => b -> b) -> SData -> SData
dataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable @(Type -> Type -> Type) t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SData)
$cdataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable @(Type -> Type -> Type) t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SData)
dataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable @(Type -> Type) t =>
(forall d. Data d => c (t d)) -> Maybe (c SData)
$cdataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable @(Type -> Type) t =>
(forall d. Data d => c (t d)) -> Maybe (c SData)
dataTypeOf :: SData -> DataType
$cdataTypeOf :: SData -> DataType
toConstr :: SData -> Constr
$ctoConstr :: SData -> Constr
gunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SData
$cgunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SData
gfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SData -> c SData
$cgfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SData -> c SData
Data, Int -> SData -> ShowS
[SData] -> ShowS
SData -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [SData] -> ShowS
$cshowList :: [SData] -> ShowS
show :: SData -> FilePath
$cshow :: SData -> FilePath
showsPrec :: Int -> SData -> ShowS
$cshowsPrec :: Int -> SData -> ShowS
Show, forall x. Rep SData x -> SData
forall x. SData -> Rep SData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SData x -> SData
$cfrom :: forall x. SData -> Rep SData x
Generic)
  deriving anyclass ([SData] -> Encoding
[SData] -> Value
SData -> Encoding
SData -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [SData] -> Encoding
$ctoEncodingList :: [SData] -> Encoding
toJSONList :: [SData] -> Value
$ctoJSONList :: [SData] -> Value
toEncoding :: SData -> Encoding
$ctoEncoding :: SData -> Encoding
toJSON :: SData -> Value
$ctoJSON :: SData -> Value
Aeson.ToJSON)

type SDataIxs = '[R.R 'R.Yaml]

type IxSData = IxSet SDataIxs SData

instance Indexable SDataIxs SData where
  indices :: IxList SDataIxs SData
indices =
    forall (ixs :: [Type]) a r. MkIxList ixs ixs a r => r
ixList
      (forall (proxy :: Type -> Type) a ix.
(Ord ix, Data a, Typeable @Type ix) =>
proxy ix -> Ix ix a
ixGen forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy @k t
Proxy @(R.R 'R.Yaml))

makeLenses ''SData

parseSDataCascading :: R.R 'R.Yaml -> NonEmpty (FilePath, ByteString) -> Either Text SData
parseSDataCascading :: R @SourceExt 'Yaml
-> NonEmpty (FilePath, ByteString) -> Either Text SData
parseSDataCascading R @SourceExt 'Yaml
r NonEmpty (FilePath, ByteString)
bs = do
  NonEmpty Value
vals <- forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM NonEmpty (FilePath, ByteString)
bs forall a b. (a -> b) -> a -> b
$ \(FilePath
fp, ByteString
b) ->
    (forall (p :: Type -> Type -> Type) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (\ParseException
err -> forall a. ToText a => a -> Text
toText forall a b. (a -> b) -> a -> b
$ FilePath
"Failed to parse " forall a. Semigroup a => a -> a -> a
<> FilePath
fp forall a. Semigroup a => a -> a -> a
<> FilePath
" :" forall a. Semigroup a => a -> a -> a
<> ParseException -> FilePath
Yaml.prettyPrintParseException ParseException
err) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => ByteString -> Either ParseException a
Yaml.decodeEither') ByteString
b
  let val :: Value
val = NonEmpty Value -> Value
mergeAesons NonEmpty Value
vals
  forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Value -> R @SourceExt 'Yaml -> SData
SData Value
val R @SourceExt 'Yaml
r

-- | Later values override former.
mergeAesons :: NonEmpty Aeson.Value -> Aeson.Value
mergeAesons :: NonEmpty Value -> Value
mergeAesons =
  forall (f :: Type -> Type) a. IsNonEmpty f a a "last" => f a -> a
last forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> a) -> NonEmpty a -> NonEmpty a
NE.scanl1 Value -> Value -> Value
mergeAeson

mergeAeson :: Aeson.Value -> Aeson.Value -> Aeson.Value
mergeAeson :: Value -> Value -> Value
mergeAeson = Value -> Value -> Value
AesonMerge.lodashMerge

-- TODO: Use https://hackage.haskell.org/package/lens-aeson
lookupAeson :: forall a. Aeson.FromJSON a => a -> NonEmpty Text -> Aeson.Value -> a
lookupAeson :: forall a. FromJSON a => a -> NonEmpty Text -> Value -> a
lookupAeson a
x (Text
k :| [Text]
ks) Value
meta =
  forall a. a -> Maybe a -> a
fromMaybe a
x forall a b. (a -> b) -> a -> b
$ do
    Aeson.Object Object
obj <- forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Value
meta
    Value
val <- forall v. Key -> KeyMap v -> Maybe v
KM.lookup (forall a. IsString a => FilePath -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToString a => a -> FilePath
toString forall a b. (a -> b) -> a -> b
$ Text
k) Object
obj
    case forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [Text]
ks of
      Maybe (NonEmpty Text)
Nothing -> forall b. Result b -> Maybe b
resultToMaybe forall a b. (a -> b) -> a -> b
$ forall a. FromJSON a => Value -> Result a
Aeson.fromJSON Value
val
      Just NonEmpty Text
ks' -> forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. FromJSON a => a -> NonEmpty Text -> Value -> a
lookupAeson a
x NonEmpty Text
ks' Value
val
  where
    resultToMaybe :: Aeson.Result b -> Maybe b
    resultToMaybe :: forall b. Result b -> Maybe b
resultToMaybe = \case
      Aeson.Error FilePath
_ -> forall a. Maybe a
Nothing
      Aeson.Success b
b -> forall (f :: Type -> Type) a. Applicative f => a -> f a
pure b
b

oneAesonText :: [Text] -> Text -> Aeson.Value
oneAesonText :: [Text] -> Text -> Value
oneAesonText [Text]
k Text
v =
  case forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [Text]
k of
    Maybe (NonEmpty Text)
Nothing ->
      Text -> Value
Aeson.String Text
v
    Just (Text
x :| [Text]
xs) ->
      [Pair] -> Value
Aeson.object [(forall a. IsString a => FilePath -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToString a => a -> FilePath
toString) Text
x forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Aeson..= [Text] -> Text -> Value
oneAesonText (forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList [Text]
xs) Text
v]