x.hs

{-# OPTIONS_GHC -Wall #-}

{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE RankNTypes #-}

module PrettyPrint {- (
  PrettyPrint(..)
, idPrettyPrint
, showPrettyPrint
, strPrettyPrint
) -} where

import Control.Applicative(pure)
import Control.Category((.), id)
import Control.Lens(Rewrapped, Wrapped(Unwrapped, _Wrapped'), _Wrapped, iso, view)
import Data.Either(Either(Left, Right))
import Data.Eq
import Data.Functor.Contravariant(Contravariant(contramap))
import Data.Functor.Contravariant.Divisible(Divisible(divide, conquer), Decidable(lose, choose))
import Data.List
import Data.Semigroup((<>))
import Data.String(String)
import Data.Void(absurd)
import GHC.Show(Show(show))

-- contravariant functors over some value (e), e appears in negative/argument position
-- covariant functors over some value (e), e appears in positive/return position
newtype PrettyPrint e =
  PrettyPrint (e -> String)

instance PrettyPrint e ~ t =>
  Rewrapped (PrettyPrint e') t

instance Wrapped (PrettyPrint e) where
  type Unwrapped (PrettyPrint e) =
    e
    -> String
  _Wrapped' = 
    iso
      (\(PrettyPrint x) -> x)
      PrettyPrint

instance Contravariant PrettyPrint where
  contramap f (PrettyPrint x) =
    PrettyPrint (x . f)

instance Divisible PrettyPrint where
  divide k (PrettyPrint x) (PrettyPrint y) =
    PrettyPrint (\a -> let (b, c) = k a in x b <> y c)
  conquer =
    PrettyPrint (pure "")

instance Decidable PrettyPrint where
  lose k =
    PrettyPrint (\a -> absurd (k a))
  choose k (PrettyPrint x) (PrettyPrint y) = 
    PrettyPrint (\a -> 
      case k a of
        Left b ->
          x b
        Right c ->
          y c
    )

idPrettyPrint ::
  PrettyPrint String
idPrettyPrint =
  PrettyPrint id

showPrettyPrint ::
  Show a =>
  PrettyPrint a
showPrettyPrint =
  PrettyPrint show

strPrettyPrint ::
  String
  -> PrettyPrint a
strPrettyPrint =
  PrettyPrint . pure

class PrettyPrint' a where
  pprint :: a -> String

instance PrettyPrint' String where
  pprint = id

data TwoStrings = 
  TwoStrings
    String
    String

instance PrettyPrint' TwoStrings where
  pprint (TwoStrings s1 s2) =
    pprint s1 <> "abc" <> pprint s2

reverseP' :: PrettyPrint' a => a -> String
reverseP' a = reverse (pprint a)

reverseP :: PrettyPrint a -> a -> String
reverseP p a = reverse (view _Wrapped p a)

data X = X deriving (Eq, Show)
data Y = Y deriving (Eq, Show)

data XY =
  XY X Y
 deriving (Eq, Show)

xprint :: PrettyPrint X
xprint = PrettyPrint (\X -> "X")

yprint :: PrettyPrint Y
yprint = PrettyPrint (\Y -> "Y")

xyprint :: PrettyPrint XY
xyprint = divide (\(XY x y) -> (x, y)) xprint yprint

xyprint' :: PrettyPrint XY
xyprint' = divide (\(XY x y) -> (x, y)) xprint (divide (\Y -> ("hello", Y)) idPrettyPrint yprint)

class Default a where
  def :: a

newtype Default' a = Default' a

def' :: Default a => a
def' = def

f :: Default a => a -> String

f :: Default' a -> a -> String
f :: a -> a -> String