module Data.Schema.Pretty (ppSchema) where import Data.Fix (foldFix) import Data.Schema (Schema, SchemaF (..)) import Prelude hiding ((<$>)) import Text.PrettyPrint.ANSI.Leijen ppSchema :: Schema -> Doc ppSchema :: Schema -> Doc ppSchema = (Doc -> Doc -> Doc forall a. Semigroup a => a -> a -> a <> Doc line) (Doc -> Doc) -> (Schema -> Doc) -> Schema -> Doc forall b c a. (b -> c) -> (a -> b) -> a -> c . (SchemaF Doc -> Doc) -> Schema -> Doc forall (f :: * -> *) a. Functor f => (f a -> a) -> Fix f -> a foldFix SchemaF Doc -> Doc go go :: SchemaF Doc -> Doc go :: SchemaF Doc -> Doc go (Atom Type ty) = String -> Doc text (String -> Doc) -> String -> Doc forall a b. (a -> b) -> a -> b $ Type -> String forall a. Show a => a -> String show Type ty go (Field String name Doc ty) = String -> Doc text String name Doc -> Doc -> Doc <+> String -> Doc text String "::" Doc -> Doc -> Doc <+> Doc ty go (List Doc ty) = String -> Doc text String "repeated" Doc -> Doc -> Doc <+> Doc ty go (Con String name Doc ty) = String -> Doc text String name Doc -> Doc -> Doc <+> Doc equals Doc -> Doc -> Doc <+> Doc ty go (Prod [Doc] fields) = Doc -> Doc braces (Doc line Doc -> Doc -> Doc forall a. Semigroup a => a -> a -> a <> Int -> Doc -> Doc indent Int 2 ([Doc] -> Doc vcat [Doc] fields) Doc -> Doc -> Doc forall a. Semigroup a => a -> a -> a <> Doc line) go (Sum Maybe DatatypeName Nothing [Doc] cons) = [Doc] -> Doc vcat [Doc] cons go (Sum (Just (String m, String ty)) [Doc] cons) = String -> Doc text (String "type " String -> String -> String forall a. Semigroup a => a -> a -> a <> String m String -> String -> String forall a. Semigroup a => a -> a -> a <> String "." String -> String -> String forall a. Semigroup a => a -> a -> a <> String ty) Doc -> Doc -> Doc <+> Doc -> Doc braces ( Doc line Doc -> Doc -> Doc forall a. Semigroup a => a -> a -> a <> Int -> Doc -> Doc indent Int 2 ([Doc] -> Doc vcat [Doc] cons) Doc -> Doc -> Doc forall a. Semigroup a => a -> a -> a <> Doc line) go (Module String name [Doc] ss) = String -> Doc text String "module" Doc -> Doc -> Doc <+> String -> Doc text String name Doc -> Doc -> Doc <$> [Doc] -> Doc vcat [Doc] ss go (Schema [Doc] mods) = String -> Doc text String "schema 1.0;" Doc -> Doc -> Doc <$> Doc line Doc -> Doc -> Doc forall a. Semigroup a => a -> a -> a <> [Doc] -> Doc vcat (Doc -> [Doc] -> [Doc] punctuate Doc line [Doc] mods) go SchemaF Doc Empty = String -> Doc text String "<empty>"