{-# 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
data SData = SData
{ SData -> Value
_sdataValue :: Aeson.Value,
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
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
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]