{-# LANGUAGE OverloadedStrings #-}
module Data.Avro.Deriving.NormSchema
where
import Data.Avro.Schema
import qualified Data.Set as S
import Data.List.NonEmpty (NonEmpty( (:|) ))
import Control.Monad.State.Strict
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.List as L
import Data.Maybe (catMaybes, fromMaybe)
import Data.Semigroup ((<>))
extractDerivables :: Schema -> [Schema]
extractDerivables s = flip evalState S.empty . normSchema rawRecs <$> rawRecs
where
rawRecs = getTypes s
getTypes rec = case rec of
r@(Record _ _ _ _ _ fs) -> r : (fs >>= (getTypes . fldType))
Array t -> getTypes t
Union (t1 :| ts) _ -> getTypes t1 <> concatMap getTypes ts
Map t -> getTypes t
e@Enum{} -> [e]
_ -> []
normSchema :: [Schema]
-> Schema
-> State (S.Set TypeName) Schema
normSchema rs r = case r of
t@(NamedType tn) -> do
let sn = shortName tn
resolved <- get
if S.member sn resolved
then pure t
else do
modify' (S.insert sn)
pure $ fromMaybe (error $ "Unable to resolve schema: " <> show (typeName t)) (findSchema tn)
Array s -> Array <$> normSchema rs s
Map s -> Map <$> normSchema rs s
Record{name = tn} -> do
let sn = shortName tn
modify' (S.insert sn)
flds <- mapM (\fld -> setType fld <$> normSchema rs (fldType fld)) (fields r)
pure $ r { fields = flds }
s -> pure s
where
shortName tn = TN $ T.takeWhileEnd (/='.') (unTN tn)
setType fld t = fld { fldType = t}
fullName s = TN $ maybe (typeName s) (\n -> typeName s <> "." <> n) (namespace s)
findSchema tn = L.find (\s -> name s == tn || fullName s == tn) rs