module Data.Schema.Pretty (ppSchema) where

import           Data.Fix      (foldFix)
import           Data.Schema   (Schema, SchemaF (..))
import           Prettyprinter

ppSchema :: Schema -> Doc ()
ppSchema :: Schema -> Doc ()
ppSchema = (Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Doc ()
forall ann. Doc ann
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 ()
forall a ann. Pretty a => a -> Doc ann
pretty (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 ()
forall a ann. Pretty a => a -> Doc ann
pretty String
name Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ()
forall a ann. Pretty a => a -> Doc ann
pretty String
"::" Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ()
ty
go (List Doc ()
ty)                 = String -> Doc ()
forall a ann. Pretty a => a -> Doc ann
pretty String
"repeated" Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ()
ty
go (Con String
name Doc ()
ty)             = String -> Doc ()
forall a ann. Pretty a => a -> Doc ann
pretty String
name Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ()
forall ann. Doc ann
equals Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ()
ty
go (Prod [Doc ()]
fields)             = Doc () -> Doc ()
forall ann. Doc ann -> Doc ann
braces (Doc ()
forall ann. Doc ann
line Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Int -> Doc () -> Doc ()
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 ([Doc ()] -> Doc ()
forall ann. [Doc ann] -> Doc ann
vcat [Doc ()]
fields) Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Doc ()
forall ann. Doc ann
line)
go (Sum Maybe DatatypeName
Nothing [Doc ()]
cons)        = [Doc ()] -> Doc ()
forall ann. [Doc ann] -> Doc ann
vcat [Doc ()]
cons
go (Sum (Just (String
m, String
ty)) [Doc ()]
cons) =
    String -> Doc ()
forall a ann. Pretty a => a -> Doc ann
pretty (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 ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann
braces (
        Doc ()
forall ann. Doc ann
line Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Int -> Doc () -> Doc ()
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 ([Doc ()] -> Doc ()
forall ann. [Doc ann] -> Doc ann
vcat [Doc ()]
cons)
        Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Doc ()
forall ann. Doc ann
line)
go (Module String
name [Doc ()]
ss)          = [Doc ()] -> Doc ()
forall ann. [Doc ann] -> Doc ann
vsep [String -> Doc ()
forall a ann. Pretty a => a -> Doc ann
pretty String
"module" Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ()
forall a ann. Pretty a => a -> Doc ann
pretty String
name, [Doc ()] -> Doc ()
forall ann. [Doc ann] -> Doc ann
vcat [Doc ()]
ss]
go (Schema [Doc ()]
mods)             = [Doc ()] -> Doc ()
forall ann. [Doc ann] -> Doc ann
vsep [String -> Doc ()
forall a ann. Pretty a => a -> Doc ann
pretty String
"schema 1.0;", Doc ()
forall ann. Doc ann
line Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> [Doc ()] -> Doc ()
forall ann. [Doc ann] -> Doc ann
vcat (Doc () -> [Doc ()] -> [Doc ()]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ()
forall ann. Doc ann
line [Doc ()]
mods)]
go SchemaF (Doc ())
Empty                     = String -> Doc ()
forall a ann. Pretty a => a -> Doc ann
pretty String
"<empty>"