{-# 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
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
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
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]