{-# 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,
    -- | Location of this data file
    SData -> R @SourceExt 'Yaml
_sdataRoute :: R.R 'R.Yaml
  }
  deriving stock (SData -> SData -> Bool
(SData -> SData -> Bool) -> (SData -> SData -> Bool) -> Eq SData
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
Eq SData
-> (SData -> SData -> Ordering)
-> (SData -> SData -> Bool)
-> (SData -> SData -> Bool)
-> (SData -> SData -> Bool)
-> (SData -> SData -> Bool)
-> (SData -> SData -> SData)
-> (SData -> SData -> SData)
-> Ord 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
Typeable @Type 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 (c :: Type -> Type).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SData)
-> (SData -> Constr)
-> (SData -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> SData -> SData)
-> (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 u. (forall d. Data d => d -> u) -> SData -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> SData -> u)
-> (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 (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SData -> m SData)
-> Data 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
(Int -> SData -> ShowS)
-> (SData -> FilePath) -> ([SData] -> ShowS) -> Show SData
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. SData -> Rep SData x)
-> (forall x. Rep SData x -> SData) -> Generic SData
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
(SData -> Value)
-> (SData -> Encoding)
-> ([SData] -> Value)
-> ([SData] -> Encoding)
-> ToJSON SData
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 =
    Ix (R @SourceExt 'Yaml) SData -> IxList SDataIxs SData
forall (ixs :: [Type]) a r. MkIxList ixs ixs a r => r
ixList
      (Proxy @Type (R @SourceExt 'Yaml) -> Ix (R @SourceExt 'Yaml) SData
forall (proxy :: Type -> Type) a ix.
(Ord ix, Data a, Typeable @Type ix) =>
proxy ix -> Ix ix a
ixGen (Proxy @Type (R @SourceExt 'Yaml) -> Ix (R @SourceExt 'Yaml) SData)
-> Proxy @Type (R @SourceExt 'Yaml)
-> Ix (R @SourceExt 'Yaml) SData
forall a b. (a -> b) -> a -> b
$ forall {t}. Proxy @Type t
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 <- NonEmpty (FilePath, ByteString)
-> ((FilePath, ByteString) -> Either Text Value)
-> Either Text (NonEmpty Value)
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 (((FilePath, ByteString) -> Either Text Value)
 -> Either Text (NonEmpty Value))
-> ((FilePath, ByteString) -> Either Text Value)
-> Either Text (NonEmpty Value)
forall a b. (a -> b) -> a -> b
$ \(FilePath
fp, ByteString
b) ->
    ((ParseException -> Text)
-> Either ParseException Value -> Either Text Value
forall (p :: Type -> Type -> Type) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (\ParseException
err -> FilePath -> Text
forall a. ToText a => a -> Text
toText (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ FilePath
"Failed to parse " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
fp FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
" :" FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> ParseException -> FilePath
Yaml.prettyPrintParseException ParseException
err) (Either ParseException Value -> Either Text Value)
-> (ByteString -> Either ParseException Value)
-> ByteString
-> Either Text Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either ParseException Value
forall a. FromJSON a => ByteString -> Either ParseException a
Yaml.decodeEither') ByteString
b
  let val :: Value
val = NonEmpty Value -> Value
mergeAesons NonEmpty Value
vals
  SData -> Either Text SData
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (SData -> Either Text SData) -> SData -> Either Text SData
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 =
  NonEmpty Value -> Value
forall (f :: Type -> Type) a. IsNonEmpty f a a "last" => f a -> a
last (NonEmpty Value -> Value)
-> (NonEmpty Value -> NonEmpty Value) -> NonEmpty Value -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Value -> Value) -> NonEmpty Value -> NonEmpty Value
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 =
  a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
x (Maybe a -> a) -> Maybe a -> a
forall a b. (a -> b) -> a -> b
$ do
    Aeson.Object Object
obj <- Value -> Maybe Value
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Value
meta
    Value
val <- Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup (FilePath -> Key
forall a. IsString a => FilePath -> a
fromString (FilePath -> Key) -> (Text -> FilePath) -> Text -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
forall a. ToString a => a -> FilePath
toString (Text -> Key) -> Text -> Key
forall a b. (a -> b) -> a -> b
$ Text
k) Object
obj
    case [Text] -> Maybe (NonEmpty Text)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [Text]
ks of
      Maybe (NonEmpty Text)
Nothing -> Result a -> Maybe a
forall b. Result b -> Maybe b
resultToMaybe (Result a -> Maybe a) -> Result a -> Maybe a
forall a b. (a -> b) -> a -> b
$ Value -> Result a
forall a. FromJSON a => Value -> Result a
Aeson.fromJSON Value
val
      Just NonEmpty Text
ks' -> a -> Maybe a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ a -> NonEmpty Text -> Value -> a
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
_ -> Maybe b
forall a. Maybe a
Nothing
      Aeson.Success b
b -> b -> Maybe 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 [Text] -> Maybe (NonEmpty Text)
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 [(FilePath -> Key
forall a. IsString a => FilePath -> a
fromString (FilePath -> Key) -> (Text -> FilePath) -> Text -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
forall a. ToString a => a -> FilePath
toString) Text
x Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Aeson..= [Text] -> Text -> Value
oneAesonText ([Text] -> [Text]
forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList [Text]
xs) Text
v]