Skip to content

Commit

Permalink
Remove Printer class pt 1
Browse files Browse the repository at this point in the history
  • Loading branch information
danieljharvey committed Dec 10, 2023
1 parent 3b13dcf commit 51a9272
Show file tree
Hide file tree
Showing 15 changed files with 99 additions and 133 deletions.
13 changes: 6 additions & 7 deletions smol-core/src/Smol/Core/Typecheck/Typeclass/Types/Constraint.hs
Original file line number Diff line number Diff line change
Expand Up @@ -14,7 +14,6 @@ where
import Data.Aeson (FromJSON, FromJSONKey, ToJSON, ToJSONKey)
import GHC.Generics (Generic)
import qualified Prettyprinter as PP
import Smol.Core.Printer
import Smol.Core.Typecheck.Typeclass.Types.TypeclassName
import Smol.Core.Types

Expand Down Expand Up @@ -88,13 +87,13 @@ deriving anyclass instance
FromJSONKey (Constraint dep ann)

instance
( Printer (dep Identifier),
Printer (dep TypeName)
( PP.Pretty (dep Identifier),
PP.Pretty (dep TypeName)
) =>
Printer (Constraint dep ann)
PP.Pretty (Constraint dep ann)
where
prettyDoc (Constraint tcn tys) =
prettyDoc tcn
pretty (Constraint tcn tys) =
PP.pretty tcn
PP.<+> PP.concatWith
(\a b -> a <> " " <> b)
(prettyDoc <$> tys)
(PP.pretty <$> tys)
12 changes: 6 additions & 6 deletions smol-core/src/Smol/Core/Typecheck/Typeclass/Types/Typeclass.hs
Original file line number Diff line number Diff line change
Expand Up @@ -73,15 +73,15 @@ deriving anyclass instance
) =>
FromJSON (Typeclass dep ann)

instance Printer (Typeclass ParseDep ann) where
prettyDoc (Typeclass {tcName, tcArgs, tcFuncName, tcFuncType}) =
instance PP.Pretty (Typeclass ParseDep ann) where
pretty (Typeclass {tcName, tcArgs, tcFuncName, tcFuncType}) =
"class"
<+> prettyDoc tcName
<+> PP.pretty tcName
<+> PP.concatWith
(\a b -> a <> ", " <> b)
(prettyDoc <$> tcArgs)
(PP.pretty <$> tcArgs)
<+> "{"
<+> prettyDoc tcFuncName
<+> PP.pretty tcFuncName
<> ":"
<+> prettyDoc tcFuncType
<+> PP.pretty tcFuncType
<+> "}"
Original file line number Diff line number Diff line change
Expand Up @@ -17,8 +17,7 @@ import Data.String
import Data.Text (Text)
import qualified Data.Text as T
import GHC.Generics
import Prettyprinter
import Smol.Core.Printer
import qualified Prettyprinter as PP

-- | A TypeclassName is like `Either` or `Maybe`.
-- It must start with a capital letter.
Expand Down Expand Up @@ -62,5 +61,5 @@ safeMkTypeclassName a =
then Just (TypeclassName a)
else Nothing

instance Printer TypeclassName where
prettyDoc = pretty . getTypeclassName
instance PP.Pretty TypeclassName where
pretty = PP.pretty . getTypeclassName
5 changes: 2 additions & 3 deletions smol-core/src/Smol/Core/Types/Constructor.hs
Original file line number Diff line number Diff line change
Expand Up @@ -16,7 +16,6 @@ import Data.String
import Data.Text (Text)
import qualified Data.Text as T
import qualified Prettyprinter as PP
import Smol.Core.Printer

newtype Constructor = Constructor Text
deriving newtype
Expand All @@ -30,8 +29,8 @@ newtype Constructor = Constructor Text
Semigroup
)

instance Printer Constructor where
prettyDoc (Constructor c) = PP.pretty c
instance PP.Pretty Constructor where
pretty (Constructor c) = PP.pretty c

instance IsString Constructor where
fromString = Constructor . T.pack
Expand Down
5 changes: 2 additions & 3 deletions smol-core/src/Smol/Core/Types/Identifier.hs
Original file line number Diff line number Diff line change
Expand Up @@ -16,7 +16,6 @@ import Data.String
import Data.Text (Text)
import qualified Data.Text as T
import qualified Prettyprinter as PP
import Smol.Core.Printer

newtype Identifier = Identifier Text
deriving newtype
Expand All @@ -30,8 +29,8 @@ newtype Identifier = Identifier Text
Semigroup
)

instance Printer Identifier where
prettyDoc (Identifier i) = PP.pretty i
instance PP.Pretty Identifier where
pretty (Identifier i) = PP.pretty i

instance IsString Identifier where
fromString = Identifier . T.pack
Expand Down
8 changes: 4 additions & 4 deletions smol-core/src/Smol/Core/Types/Op.hs
Original file line number Diff line number Diff line change
Expand Up @@ -10,12 +10,12 @@ where

import Data.Aeson (FromJSON, ToJSON)
import GHC.Generics (Generic)
import Smol.Core.Printer
import qualified Prettyprinter as PP

data Op = OpAdd | OpEquals
deriving stock (Eq, Ord, Show, Generic)
deriving anyclass (FromJSON, ToJSON)

instance Printer Op where
prettyDoc OpAdd = "+"
prettyDoc OpEquals = "=="
instance PP.Pretty Op where
pretty OpAdd = "+"
pretty OpEquals = "=="
68 changes: 19 additions & 49 deletions smol-core/src/Smol/Core/Types/Pattern.hs
Original file line number Diff line number Diff line change
Expand Up @@ -17,7 +17,6 @@ import Data.Aeson (FromJSON, ToJSON)
import qualified Data.List.NonEmpty as NE
import GHC.Generics (Generic)
import qualified Prettyprinter as PP
import Smol.Core.Printer
import Smol.Core.Types.Constructor
import Smol.Core.Types.Identifier
import Smol.Core.Types.Prim
Expand Down Expand Up @@ -67,70 +66,41 @@ deriving anyclass instance
) =>
ToJSON (Pattern dep ann)

_inParens :: (Printer a) => a -> PP.Doc style
_inParens = PP.parens . prettyDoc
_inParens :: (PP.Pretty a) => a -> PP.Doc style
_inParens = PP.parens . PP.pretty

-- print simple things with no brackets, and complex things inside brackets
printSubPattern ::
( Printer (dep Constructor),
Printer (dep Identifier)
( PP.Pretty (dep Constructor),
PP.Pretty (dep Identifier)
) =>
Pattern dep ann ->
PP.Doc style
printSubPattern pat = case pat of
all'@PConstructor {} -> prettyDoc all' -- inParens all'
a -> prettyDoc a
all'@PConstructor {} -> PP.pretty all' -- inParens all'
a -> PP.pretty a

instance
( Printer (dep Constructor),
Printer (dep Identifier)
( PP.Pretty (dep Constructor),
PP.Pretty (dep Identifier)
) =>
Printer (Pattern dep ann)
PP.Pretty (Pattern dep ann)
where
prettyDoc (PWildcard _) = "_"
prettyDoc (PVar _ a) = prettyDoc a
prettyDoc (PLiteral _ lit) = prettyDoc lit
prettyDoc (PConstructor _ tyCon args) =
pretty (PWildcard _) = "_"
pretty (PVar _ a) = PP.pretty a
pretty (PLiteral _ lit) = PP.pretty lit
pretty (PConstructor _ tyCon args) =
let prettyArgs = case args of
[] -> mempty
_ -> foldr ((\a b -> " " <> a <> b) . printSubPattern) mempty args
in prettyDoc tyCon <> prettyArgs
prettyDoc (PTuple _ a as) =
"(" <> PP.hsep (PP.punctuate "," (prettyDoc <$> ([a] <> NE.toList as))) <> ")"
prettyDoc (PArray _ as spread) =
in PP.pretty tyCon <> prettyArgs
pretty (PTuple _ a as) =
"(" <> PP.hsep (PP.punctuate "," (PP.pretty <$> ([a] <> NE.toList as))) <> ")"
pretty (PArray _ as spread) =
"["
<> PP.concatWith
(\a b -> a <> ", " <> b)
(prettyDoc <$> as)
<> prettyDoc spread
(PP.pretty <$> as)
<> PP.pretty spread
<> "]"

{-
prettyDoc (PRecord _ map') =
let items = M.toList map'
printRow i (name, val) =
let item = case val of
(PVar _ vName) | vName == name -> prettyDoc name
_ ->
prettyDoc name
<> ":"
<+> printSubPattern val
in item <> if i < length items then "," else ""
in case items of
[] -> "{}"
rows ->
let prettyRows = mapWithIndex printRow rows
in group
( "{"
<+> align
( vsep
prettyRows
)
<+> "}"
)
-}
{-
prettyDoc (PString _ a as) =
prettyDoc a <> " ++ " <> prettyDoc as
-}
9 changes: 4 additions & 5 deletions smol-core/src/Smol/Core/Types/PatternMatchError.hs
Original file line number Diff line number Diff line change
Expand Up @@ -13,8 +13,7 @@ where

import Data.Set (Set)
import qualified Data.Text as T
import Prettyprinter
import Smol.Core.Printer
import qualified Prettyprinter as PP
import Smol.Core.Types
import Text.Megaparsec

Expand All @@ -38,11 +37,11 @@ data PatternMatchError ann
instance Semigroup (PatternMatchError ann) where
a <> _ = a

instance Printer (PatternMatchError ann) where
prettyDoc = vsep . renderPatternMatchError
instance PP.Pretty (PatternMatchError ann) where
pretty = vsep . renderPatternMatchError

instance ShowErrorComponent (PatternMatchError Annotation) where
showErrorComponent = T.unpack . renderWithWidth 40 . prettyDoc
showErrorComponent = T.unpack . renderWithWidth 40 . PP.pretty
errorComponentLen pmErr = let (_, len) = getErrorPos pmErr in len

type Start = Int
Expand Down
5 changes: 2 additions & 3 deletions smol-core/src/Smol/Core/Types/Prim.hs
Original file line number Diff line number Diff line change
Expand Up @@ -13,7 +13,6 @@ import Data.Aeson (FromJSON, ToJSON)
import Data.Text (Text)
import GHC.Generics (Generic)
import qualified Prettyprinter as PP
import Smol.Core.Printer

data Prim
= PUnit
Expand All @@ -23,8 +22,8 @@ data Prim
deriving stock (Eq, Ord, Show, Generic)
deriving anyclass (FromJSON, ToJSON)

instance Printer Prim where
prettyDoc = renderPrim
instance PP.Pretty Prim where
pretty = renderPrim

renderPrim :: Prim -> PP.Doc doc
renderPrim (PInt i) = PP.pretty i
Expand Down
10 changes: 5 additions & 5 deletions smol-core/src/Smol/Core/Types/Spread.hs
Original file line number Diff line number Diff line change
Expand Up @@ -12,8 +12,8 @@ where

import qualified Data.Aeson as JSON
import GHC.Generics
import Smol.Core.Printer
import Smol.Core.Types.Identifier
import qualified Prettyprinter as PP

data Spread dep ann
= NoSpread
Expand Down Expand Up @@ -51,7 +51,7 @@ deriving anyclass instance
(JSON.ToJSON ann, JSON.ToJSON (dep Identifier)) =>
JSON.ToJSON (Spread dep ann)

instance (Printer (dep Identifier)) => Printer (Spread dep ann) where
prettyDoc NoSpread = ""
prettyDoc (SpreadWildcard _) = ", ..."
prettyDoc (SpreadValue _ a) = ", ..." <> prettyDoc a
instance (PP.Pretty (dep Identifier)) => PP.Pretty (Spread dep ann) where
pretty NoSpread = ""
pretty (SpreadWildcard _) = ", ..."
pretty (SpreadValue _ a) = ", ..." <> PP.pretty a
Loading

0 comments on commit 51a9272

Please sign in to comment.