{-# LANGUAGE UndecidableInstances #-}

module Mello.Print
  ( ToSexp (..)
  , toSexpDoc
  , toSexpText
  )
where

import Bowtie.Anno (Anno (..))
import Bowtie.Fix (Fix (..))
import Bowtie.Memo (Memo, memoVal)
import Data.Scientific (Scientific)
import Data.Text (Text)
import Data.Text qualified as T
import Mello.Syntax (Atom (..), Sexp (..), Sym, pattern SexpAtom)
import Prettyprinter (Doc, defaultLayoutOptions, layoutSmart, pretty)
import Prettyprinter.Render.Text (renderStrict)

class ToSexp a where
  toSexp :: a -> Sexp

instance ToSexp Sexp where
  toSexp :: Sexp -> Sexp
toSexp = Sexp -> Sexp
forall a. a -> a
id

instance (Functor f, ToSexp (f Sexp)) => ToSexp (Fix f) where
  toSexp :: Fix f -> Sexp
toSexp = f Sexp -> Sexp
forall a. ToSexp a => a -> Sexp
toSexp (f Sexp -> Sexp) -> (Fix f -> f Sexp) -> Fix f -> Sexp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Fix f -> Sexp) -> f (Fix f) -> f Sexp
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Fix f -> Sexp
forall a. ToSexp a => a -> Sexp
toSexp (f (Fix f) -> f Sexp) -> (Fix f -> f (Fix f)) -> Fix f -> f Sexp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fix f -> f (Fix f)
forall (f :: * -> *). Fix f -> f (Fix f)
unFix

instance (ToSexp s) => ToSexp (Anno k s) where
  toSexp :: Anno k s -> Sexp
toSexp = s -> Sexp
forall a. ToSexp a => a -> Sexp
toSexp (s -> Sexp) -> (Anno k s -> s) -> Anno k s -> Sexp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Anno k s -> s
forall k v. Anno k v -> v
annoVal

instance (Functor f, ToSexp (f Sexp)) => ToSexp (Memo f k) where
  toSexp :: Memo f k -> Sexp
toSexp = f Sexp -> Sexp
forall a. ToSexp a => a -> Sexp
toSexp (f Sexp -> Sexp) -> (Memo f k -> f Sexp) -> Memo f k -> Sexp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Memo f k -> Sexp) -> f (Memo f k) -> f Sexp
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Memo f k -> Sexp
forall a. ToSexp a => a -> Sexp
toSexp (f (Memo f k) -> f Sexp)
-> (Memo f k -> f (Memo f k)) -> Memo f k -> f Sexp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Memo f k -> f (Memo f k)
forall (f :: * -> *) k. Memo f k -> f (Memo f k)
memoVal

instance ToSexp Atom where
  toSexp :: Atom -> Sexp
toSexp = Atom -> Sexp
SexpAtom

instance ToSexp Sym where
  toSexp :: Sym -> Sexp
toSexp = Atom -> Sexp
SexpAtom (Atom -> Sexp) -> (Sym -> Atom) -> Sym -> Sexp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sym -> Atom
AtomSym

instance ToSexp Integer where
  toSexp :: Integer -> Sexp
toSexp = Atom -> Sexp
SexpAtom (Atom -> Sexp) -> (Integer -> Atom) -> Integer -> Sexp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Atom
AtomInt

instance ToSexp Int where
  toSexp :: Int -> Sexp
toSexp = Integer -> Sexp
forall a. ToSexp a => a -> Sexp
toSexp (Integer -> Sexp) -> (Int -> Integer) -> Int -> Sexp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @Integer

instance ToSexp Scientific where
  toSexp :: Scientific -> Sexp
toSexp = Atom -> Sexp
SexpAtom (Atom -> Sexp) -> (Scientific -> Atom) -> Scientific -> Sexp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> Atom
AtomSci

instance ToSexp Text where
  toSexp :: Text -> Sexp
toSexp = Atom -> Sexp
SexpAtom (Atom -> Sexp) -> (Text -> Atom) -> Text -> Sexp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Atom
AtomStr

instance ToSexp String where
  toSexp :: String -> Sexp
toSexp = Text -> Sexp
forall a. ToSexp a => a -> Sexp
toSexp (Text -> Sexp) -> (String -> Text) -> String -> Sexp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

instance ToSexp Char where
  toSexp :: Char -> Sexp
toSexp = Atom -> Sexp
SexpAtom (Atom -> Sexp) -> (Char -> Atom) -> Char -> Sexp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Atom
AtomChar

toSexpDoc :: (ToSexp a) => a -> Doc ann
toSexpDoc :: forall a ann. ToSexp a => a -> Doc ann
toSexpDoc = Sexp -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Sexp -> Doc ann
pretty (Sexp -> Doc ann) -> (a -> Sexp) -> a -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Sexp
forall a. ToSexp a => a -> Sexp
toSexp

toSexpText :: (ToSexp a) => a -> Text
toSexpText :: forall a. ToSexp a => a -> Text
toSexpText = SimpleDocStream Any -> Text
forall ann. SimpleDocStream ann -> Text
renderStrict (SimpleDocStream Any -> Text)
-> (a -> SimpleDocStream Any) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutOptions -> Doc Any -> SimpleDocStream Any
forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutSmart LayoutOptions
defaultLayoutOptions (Doc Any -> SimpleDocStream Any)
-> (a -> Doc Any) -> a -> SimpleDocStream Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Doc Any
forall a ann. ToSexp a => a -> Doc ann
toSexpDoc