diff --git a/golden/print/flat b/golden/print/flat new file mode 100644 index 0000000..c955446 --- /dev/null +++ b/golden/print/flat @@ -0,0 +1 @@ +(가 나 다 라) \ No newline at end of file diff --git a/golden/print/long b/golden/print/long new file mode 100644 index 0000000..b9fa7cd --- /dev/null +++ b/golden/print/long @@ -0,0 +1,4 @@ +(가 + 나 + 다 + 라) \ No newline at end of file diff --git a/golden/print/null b/golden/print/null new file mode 100644 index 0000000..8af028e --- /dev/null +++ b/golden/print/null @@ -0,0 +1 @@ +() \ No newline at end of file diff --git a/golden/read/bool/read b/golden/read/bool/read new file mode 100644 index 0000000..c37392f --- /dev/null +++ b/golden/read/bool/read @@ -0,0 +1,5 @@ +[ SynNone :< SimpleF ( SimpleBoolean True ) +, SynNone :< SimpleF ( SimpleBoolean True ) +, SynNone :< SimpleF ( SimpleBoolean False ) +, SynNone :< SimpleF ( SimpleBoolean False ) +] \ No newline at end of file diff --git a/golden/reader/bool/source.scm b/golden/read/bool/source.scm similarity index 100% rename from golden/reader/bool/source.scm rename to golden/read/bool/source.scm diff --git a/golden/read/decimal/read b/golden/read/decimal/read new file mode 100644 index 0000000..36dd7be --- /dev/null +++ b/golden/read/decimal/read @@ -0,0 +1,9 @@ +[ SynNone :< SimpleF + ( SimpleNumber 45.0 ) +, SynNone :< SimpleF + ( SimpleNumber 5667.0 ) +, SynNone :< SimpleF + ( SimpleNumber + ( -123.0 ) + ) +] \ No newline at end of file diff --git a/golden/reader/decimal/source.scm b/golden/read/decimal/source.scm similarity index 100% rename from golden/reader/decimal/source.scm rename to golden/read/decimal/source.scm diff --git a/golden/reader/delimited-identifier/read b/golden/read/delimited-identifier/read similarity index 100% rename from golden/reader/delimited-identifier/read rename to golden/read/delimited-identifier/read diff --git a/golden/reader/delimited-identifier/source.scm b/golden/read/delimited-identifier/source.scm similarity index 100% rename from golden/reader/delimited-identifier/source.scm rename to golden/read/delimited-identifier/source.scm diff --git a/golden/reader/empty/read b/golden/read/empty/read similarity index 100% rename from golden/reader/empty/read rename to golden/read/empty/read diff --git a/golden/reader/empty/source.scm b/golden/read/empty/source.scm similarity index 100% rename from golden/reader/empty/source.scm rename to golden/read/empty/source.scm diff --git a/golden/read/list-dot-flat/read b/golden/read/list-dot-flat/read new file mode 100644 index 0000000..df2e6c9 --- /dev/null +++ b/golden/read/list-dot-flat/read @@ -0,0 +1,17 @@ +[ SynNone :< CompoundF + ( DotListF + ( + ( SynNone :< SimpleF + ( SimpleSymbol "가" ) + ) :| + [ SynNone :< SimpleF + ( SimpleSymbol "나" ) + , SynNone :< SimpleF + ( SimpleSymbol "다" ) + ] + ) + ( SynNone :< SimpleF + ( SimpleSymbol "라" ) + ) + ) +] \ No newline at end of file diff --git a/golden/reader/list-dot-flat/source.scm b/golden/read/list-dot-flat/source.scm similarity index 100% rename from golden/reader/list-dot-flat/source.scm rename to golden/read/list-dot-flat/source.scm diff --git a/golden/read/list-flat/read b/golden/read/list-flat/read new file mode 100644 index 0000000..e933982 --- /dev/null +++ b/golden/read/list-flat/read @@ -0,0 +1,19 @@ +[ SynNone :< CompoundF + ( ListF Ordinary + [ SynNone :< SimpleF + ( SimpleSymbol "가" ) + , SynNone :< SimpleF + ( SimpleSymbol "나" ) + , SynNone :< SimpleF + ( SimpleSymbol "다" ) + , SynNone :< SimpleF + ( SimpleSymbol "라" ) + , SynNone :< SimpleF + ( SimpleNumber 1.0 ) + , SynNone :< SimpleF + ( SimpleNumber 2.0 ) + , SynNone :< SimpleF + ( SimpleNumber 3.0 ) + ] + ) +] \ No newline at end of file diff --git a/golden/reader/list-flat/source.scm b/golden/read/list-flat/source.scm similarity index 100% rename from golden/reader/list-flat/source.scm rename to golden/read/list-flat/source.scm diff --git a/golden/read/list/read b/golden/read/list/read new file mode 100644 index 0000000..2043de1 --- /dev/null +++ b/golden/read/list/read @@ -0,0 +1,40 @@ +[ SynNone :< CompoundF + ( DotListF + ( + ( SynNone :< SimpleF + ( SimpleSymbol "a" ) + ) :| + [ SynNone :< SimpleF + ( SimpleSymbol "b" ) + , SynNone :< CompoundF + ( ListF Ordinary + [ SynNone :< SimpleF + ( SimpleSymbol "c" ) + , SynNone :< SimpleF + ( SimpleSymbol "d" ) + ] + ) + ] + ) + ( SynNone :< CompoundF + ( ListF Ordinary + [ SynNone :< SimpleF + ( SimpleSymbol "가" ) + , SynNone :< CompoundF + ( DotListF + ( + ( SynNone :< SimpleF + ( SimpleSymbol "나" ) + ) :| [] + ) + ( SynNone :< SimpleF + ( SimpleSymbol "다" ) + ) + ) + , SynNone :< SimpleF + ( SimpleSymbol "라" ) + ] + ) + ) + ) +] \ No newline at end of file diff --git a/golden/reader/list/source.scm b/golden/read/list/source.scm similarity index 100% rename from golden/reader/list/source.scm rename to golden/read/list/source.scm diff --git a/golden/read/peculiar-identifier/read b/golden/read/peculiar-identifier/read new file mode 100644 index 0000000..9f2cdd5 --- /dev/null +++ b/golden/read/peculiar-identifier/read @@ -0,0 +1,5 @@ +[ SynNone :< SimpleF + ( SimpleSymbol "+" ) +, SynNone :< SimpleF + ( SimpleSymbol "-" ) +] \ No newline at end of file diff --git a/golden/reader/peculiar-identifier/source.scm b/golden/read/peculiar-identifier/source.scm similarity index 100% rename from golden/reader/peculiar-identifier/source.scm rename to golden/read/peculiar-identifier/source.scm diff --git a/golden/reader/string-line-continuation/read b/golden/read/string-line-continuation/read similarity index 100% rename from golden/reader/string-line-continuation/read rename to golden/read/string-line-continuation/read diff --git a/golden/reader/string-line-continuation/source.scm b/golden/read/string-line-continuation/source.scm similarity index 100% rename from golden/reader/string-line-continuation/source.scm rename to golden/read/string-line-continuation/source.scm diff --git a/golden/read/string/read b/golden/read/string/read new file mode 100644 index 0000000..c1f307e --- /dev/null +++ b/golden/read/string/read @@ -0,0 +1,3 @@ +[ SynNone :< SimpleF + ( SimpleString "가나다라" ) +] \ No newline at end of file diff --git a/golden/reader/string/source.scm b/golden/read/string/source.scm similarity index 100% rename from golden/reader/string/source.scm rename to golden/read/string/source.scm diff --git a/golden/read/typical-identifier/read b/golden/read/typical-identifier/read new file mode 100644 index 0000000..676bce0 --- /dev/null +++ b/golden/read/typical-identifier/read @@ -0,0 +1,19 @@ +[ SynNone :< SimpleF + ( SimpleSymbol "abc" ) +, SynNone :< SimpleF + ( SimpleSymbol "bala-hwa$" ) +, SynNone :< SimpleF + ( SimpleSymbol "x!!!" ) +, SynNone :< SimpleF + ( SimpleSymbol "z" ) +, SynNone :< SimpleF + ( SimpleSymbol "z123" ) +, SynNone :< SimpleF + ( SimpleSymbol "나는너무졸리다" ) +, SynNone :< SimpleF + ( SimpleSymbol "學" ) +, SynNone :< SimpleF + ( SimpleSymbol "車室." ) +, SynNone :< SimpleF + ( SimpleSymbol "三個女人一臺戲。" ) +] \ No newline at end of file diff --git a/golden/reader/typical-identifier/source.scm b/golden/read/typical-identifier/source.scm similarity index 100% rename from golden/reader/typical-identifier/source.scm rename to golden/read/typical-identifier/source.scm diff --git a/golden/reader/bool/read b/golden/reader/bool/read deleted file mode 100644 index 310c858..0000000 --- a/golden/reader/bool/read +++ /dev/null @@ -1,9 +0,0 @@ -[ Fix - ( SimpleF ( Boolean True ) ) -, Fix - ( SimpleF ( Boolean True ) ) -, Fix - ( SimpleF ( Boolean False ) ) -, Fix - ( SimpleF ( Boolean False ) ) -] \ No newline at end of file diff --git a/golden/reader/decimal/read b/golden/reader/decimal/read deleted file mode 100644 index 1b3cade..0000000 --- a/golden/reader/decimal/read +++ /dev/null @@ -1,15 +0,0 @@ -[ Fix - ( SimpleF - ( Number 45.0 ) - ) -, Fix - ( SimpleF - ( Number 5667.0 ) - ) -, Fix - ( SimpleF - ( Number - ( -123.0 ) - ) - ) -] \ No newline at end of file diff --git a/golden/reader/list-dot-flat/read b/golden/reader/list-dot-flat/read deleted file mode 100644 index 1276fe6..0000000 --- a/golden/reader/list-dot-flat/read +++ /dev/null @@ -1,25 +0,0 @@ -[ Fix - ( CompoundF - ( DotListF - ( Fix - ( SimpleF - ( Symbol "가" ) - ) :| - [ Fix - ( SimpleF - ( Symbol "나" ) - ) - , Fix - ( SimpleF - ( Symbol "다" ) - ) - ] - ) - ( Fix - ( SimpleF - ( Symbol "라" ) - ) - ) - ) - ) -] \ No newline at end of file diff --git a/golden/reader/list-flat/read b/golden/reader/list-flat/read deleted file mode 100644 index 3bd5792..0000000 --- a/golden/reader/list-flat/read +++ /dev/null @@ -1,35 +0,0 @@ -[ Fix - ( CompoundF - ( ListF - [ Fix - ( SimpleF - ( Symbol "가" ) - ) - , Fix - ( SimpleF - ( Symbol "나" ) - ) - , Fix - ( SimpleF - ( Symbol "다" ) - ) - , Fix - ( SimpleF - ( Symbol "라" ) - ) - , Fix - ( SimpleF - ( Number 1.0 ) - ) - , Fix - ( SimpleF - ( Number 2.0 ) - ) - , Fix - ( SimpleF - ( Number 3.0 ) - ) - ] - ) - ) -] \ No newline at end of file diff --git a/golden/reader/list/read b/golden/reader/list/read deleted file mode 100644 index 4db4f9a..0000000 --- a/golden/reader/list/read +++ /dev/null @@ -1,60 +0,0 @@ -[ Fix - ( CompoundF - ( DotListF - ( Fix - ( SimpleF - ( Symbol "a" ) - ) :| - [ Fix - ( SimpleF - ( Symbol "b" ) - ) - , Fix - ( CompoundF - ( ListF - [ Fix - ( SimpleF - ( Symbol "c" ) - ) - , Fix - ( SimpleF - ( Symbol "d" ) - ) - ] - ) - ) - ] - ) - ( Fix - ( CompoundF - ( ListF - [ Fix - ( SimpleF - ( Symbol "가" ) - ) - , Fix - ( CompoundF - ( DotListF - ( Fix - ( SimpleF - ( Symbol "나" ) - ) :| [] - ) - ( Fix - ( SimpleF - ( Symbol "다" ) - ) - ) - ) - ) - , Fix - ( SimpleF - ( Symbol "라" ) - ) - ] - ) - ) - ) - ) - ) -] \ No newline at end of file diff --git a/golden/reader/peculiar-identifier/read b/golden/reader/peculiar-identifier/read deleted file mode 100644 index ef7025d..0000000 --- a/golden/reader/peculiar-identifier/read +++ /dev/null @@ -1,9 +0,0 @@ -[ Fix - ( SimpleF - ( Symbol "+" ) - ) -, Fix - ( SimpleF - ( Symbol "-" ) - ) -] \ No newline at end of file diff --git a/golden/reader/string/read b/golden/reader/string/read deleted file mode 100644 index 71ddf65..0000000 --- a/golden/reader/string/read +++ /dev/null @@ -1,5 +0,0 @@ -[ Fix - ( SimpleF - ( String "가나다라" ) - ) -] \ No newline at end of file diff --git a/golden/reader/typical-identifier/read b/golden/reader/typical-identifier/read deleted file mode 100644 index 1a8cb2e..0000000 --- a/golden/reader/typical-identifier/read +++ /dev/null @@ -1,37 +0,0 @@ -[ Fix - ( SimpleF - ( Symbol "abc" ) - ) -, Fix - ( SimpleF - ( Symbol "bala-hwa$" ) - ) -, Fix - ( SimpleF - ( Symbol "x!!!" ) - ) -, Fix - ( SimpleF - ( Symbol "z" ) - ) -, Fix - ( SimpleF - ( Symbol "z123" ) - ) -, Fix - ( SimpleF - ( Symbol "나는너무졸리다" ) - ) -, Fix - ( SimpleF - ( Symbol "學" ) - ) -, Fix - ( SimpleF - ( Symbol "車室." ) - ) -, Fix - ( SimpleF - ( Symbol "三個女人一臺戲。" ) - ) -] \ No newline at end of file diff --git a/gyehoek.cabal b/gyehoek.cabal index 04b9560..1edac77 100644 --- a/gyehoek.cabal +++ b/gyehoek.cabal @@ -74,7 +74,7 @@ library Gyehoek.Wasm build-depends: - , base ^>=4.21.2.0 + , base ^>=4.21.2.0 , binary , bytestring , comonad @@ -97,6 +97,7 @@ library , ordered-containers , pretty-simple , prettyprinter + , prettyprinter-ansi-terminal , process , recursion-schemes , scientific @@ -127,6 +128,7 @@ test-suite test Gyehoek.Test.Golden Gyehoek.Test.Scheme.Syntax Gyehoek.Test.Sexp + Gyehoek.Test.Sexp.Print Gyehoek.Test.Stack.VM Root diff --git a/src/Gyehoek/Prelude.hs b/src/Gyehoek/Prelude.hs index d9a6022..ff3314a 100644 --- a/src/Gyehoek/Prelude.hs +++ b/src/Gyehoek/Prelude.hs @@ -16,6 +16,7 @@ module Gyehoek.Prelude , Hashable , NonEmpty((:|)) , Natural + , (>>>) ) where import Control.Lens @@ -35,4 +36,5 @@ import GHC.Stack (HasCallStack) import Data.Hashable (Hashable) import Data.List.NonEmpty (NonEmpty((:|))) import Numeric.Natural (Natural) +import Control.Category ((>>>)) diff --git a/src/Gyehoek/Sexp/Print.hs b/src/Gyehoek/Sexp/Print.hs index 66064c7..9d721fa 100644 --- a/src/Gyehoek/Sexp/Print.hs +++ b/src/Gyehoek/Sexp/Print.hs @@ -1,4 +1,75 @@ module Gyehoek.Sexp.Print - ( + ( printDatum + , printDatumW ) where +import Gyehoek.Sexp.Syntax +import Data.Text.Prettyprint.Doc +import Data.Functor.Foldable +import qualified Control.Comonad.Trans.Cofree as F +import Prettyprinter.Util +import Gyehoek.Prelude hiding (Simple, (:<)) +import Gyehoek.Sexp.Read (rd) +import Data.Foldable (traverse_) +import qualified Prettyprinter.Render.Terminal as ANSI +import System.IO (stdout) +import Prettyprinter.Render.Terminal (Color(..), color, italicized, AnsiStyle) + + +printDatum :: Datum -> Text +printDatum = printDatumW 80 + +printDatumW :: Int -> Datum -> Text +printDatumW w = + prettyDatum 0 + >>> layoutSmart opts + >>> reAnnotateS highlight + >>> ANSI.renderStrict + where + opts = LayoutOptions + { layoutPageWidth = AvailablePerLine w 1.0 + } + +prettyDatum :: Int -> Datum -> Doc Syn +prettyDatum depth = \case + syn :< SimpleF s -> annotate syn $ prettySimple depth s + syn :< CompoundF compound -> case compound of + ListF indent xs -> + case indent of + NSpecial 1 | special:body <- xs + -> pparen depth $ + nest 2 $ prettyDatum (depth+1) special + <+> vsep (prettyDatum (depth+1) <$> body) + Ordinary; NSpecial _ -> pparen depth $ + group . align . vsep $ + prettyDatum (depth+1) <$> xs + +pparen depth = enclose (delim depth "(") (delim depth ")") +delim depth = annotate (SynParen depth) + +delimited :: Int -> Doc Syn -> Doc Syn -> List (Doc Syn) -> Doc Syn +delimited depth open close = + encloseSep (delim depth open) (delim depth close) softline + +prettySimple :: Int -> Simple -> Doc Syn +prettySimple depth = \case + SimpleBoolean b -> annotate SynConstant $ if b then "#t" else "#f" + SimpleNumber n -> annotate SynConstant $ viaShow n + SimpleString s -> annotate SynString $ viaShow s + SimpleSymbol s -> pretty s + +rdpr n s = rd s >>= traverse_ \x -> do + putDocW n . prettyDatum 0 $ x + putStr "\n" + +putDoc :: Doc Syn -> IO () +putDoc = ANSI.renderIO stdout + . reAnnotateS highlight . layoutSmart defaultLayoutOptions . (<>"\n") + +highlight :: Syn -> AnsiStyle +highlight = \case + SynBuiltin -> color Magenta <> italicized + SynParen n -> color $ rainbow ^?! ix n + _ -> mempty + where + rainbow = cycle [Red,Yellow,Green,Blue,Magenta,Cyan] diff --git a/src/Gyehoek/Sexp/Read.hs b/src/Gyehoek/Sexp/Read.hs index 711c22a..ebccb9c 100644 --- a/src/Gyehoek/Sexp/Read.hs +++ b/src/Gyehoek/Sexp/Read.hs @@ -1,5 +1,7 @@ module Gyehoek.Sexp.Read ( readFile + , readString + , rd ) where import Text.Megaparsec @@ -25,13 +27,22 @@ newtype ReaderError = MkReaderError String instance Exception ReaderError where displayException (MkReaderError x) = x + -- temp +rd = runEff . readString + readFile :: IOE :> es => FilePath -> Eff es (List Datum) readFile f = do s <- liftIO . T.readFile $ f case runParser file f s of Right x -> pure x Left e -> do - -- liftIO . hPutStrLn stderr . errorBundlePretty $ e + liftIO . throw . MkReaderError . errorBundlePretty $ e + +readString :: IOE :> es => Text -> Eff es (List Datum) +readString s = + case runParser file "" s of + Right x -> pure x + Left e -> do liftIO . throw . MkReaderError . errorBundlePretty $ e type P = Parsec Void Text @@ -131,20 +142,20 @@ file = many datum <* eof datum :: P Datum datum = choice - [ Fix . CompoundF <$> compoundDatum - , Fix . SimpleF <$> simpleDatum + [ (SynNone :<) . CompoundF <$> compoundDatum + , (SynNone :<) . SimpleF <$> simpleDatum -- , labeled -- , labelRef ] simpleDatum :: P Simple simpleDatum = choice - [ Boolean <$> boolean - , Number <$> try number - -- , Character <$> character - , String <$> string - , Symbol <$> symbol - -- , Bytevector <$> bytevector + [ SimpleBoolean <$> boolean + , SimpleNumber <$> try number + -- , SimpleCharacter <$> character + , SimpleString <$> string + , SimpleSymbol <$> symbol + -- , SimpleBytevector <$> bytevector ] compoundDatum :: P Compound @@ -155,9 +166,9 @@ compoundDatum = choice list :: P Compound list = label "list" . between lparen rparen $ do optional datum >>= \case - Nothing -> pure $ ListF [] + Nothing -> pure $ ListF Ordinary [] Just x -> do xs <- many datum optional (dot *> datum) >>= \case - Nothing -> pure $ ListF (x:xs) + Nothing -> pure $ ListF Ordinary (x:xs) Just y -> pure $ DotListF (x:|xs) y diff --git a/src/Gyehoek/Sexp/Syntax.hs b/src/Gyehoek/Sexp/Syntax.hs index ae10e19..45be9ab 100644 --- a/src/Gyehoek/Sexp/Syntax.hs +++ b/src/Gyehoek/Sexp/Syntax.hs @@ -12,6 +12,23 @@ module Gyehoek.Sexp.Syntax , Cofree((:<)) , Fix(..) , Compound + , Indentation(..) + , Syn(..) + , pattern Simple + , pattern Compound + , pattern Labeled + , pattern LabelRef + , pattern Abbrev + , pattern Vector + , pattern DotList + , pattern Gyehoek.Sexp.Syntax.List + , adorn + , pattern Bytevector + , pattern Symbol + , pattern String + , pattern Character + , pattern Number + , pattern Boolean ) where import Language.Haskell.TH.Syntax (Lift) @@ -35,17 +52,17 @@ data DatumF a deriving anyclass (NFData) data Simple - = Boolean Bool - | Number Scientific - | Character Char - | String Text - | Symbol Text - | Bytevector ByteString + = SimpleBoolean Bool + | SimpleNumber Scientific + | SimpleCharacter Char + | SimpleString Text + | SimpleSymbol Text + | SimpleBytevector ByteString deriving stock (Show, Eq, Data, Generic, Lift) deriving anyclass (NFData) data CompoundF a - = ListF (List a) + = ListF Indentation (List a) | DotListF (NonEmpty a) a | VectorF (List a) | AbbrevF Prefix a @@ -69,10 +86,70 @@ newtype Label = MkLabel Natural deriving newtype (Eq, Ord, Show) deriving anyclass (NFData) -deriveShow1 ''CompoundF -deriveShow1 ''DatumF + + +type Datum = Cofree DatumF Syn +type Compound = CompoundF Datum + +data Indentation + = NSpecial Int + | Ordinary + deriving stock (Data, Eq, Generic, Show, Lift, Read) + deriving anyclass (NFData) + +data Syn + = SynMacro + | SynBuiltin + | SynProcedure + | SynParen Int + | SynString + | SynConstant + | SynNone + deriving (Show, Read) -type Datum = Fix DatumF -type Compound = CompoundF Datum +deriveShow1 ''CompoundF +deriveShow1 ''DatumF + +adorn :: Syn -> Datum -> Datum +adorn syn (_ :< d) = syn :< d + +pattern Simple :: Simple -> Datum +pattern Simple a <- _ :< SimpleF a + where Simple a = SynNone :< SimpleF a + +pattern Compound :: CompoundF Datum -> Datum +pattern Compound a <- _ :< CompoundF a + where Compound a = SynNone :< CompoundF a + +pattern Labeled :: Label -> Datum -> Datum +pattern Labeled l a <- _ :< LabeledF l a + where Labeled l a = SynNone :< LabeledF l a + +pattern LabelRef :: Label -> Datum +pattern LabelRef l <- _ :< LabelRefF l + where LabelRef l = SynNone :< LabelRefF l + +pattern List :: List Datum -> Datum +pattern List a <- _ :< CompoundF (ListF _ a) + where List a = SynNone :< CompoundF (ListF Ordinary a) + +pattern DotList :: NonEmpty Datum -> Datum -> Datum +pattern DotList xs x <- _ :< CompoundF (DotListF xs x) + where DotList xs x = SynNone :< CompoundF (DotListF xs x) + +pattern Vector :: [Datum] -> Datum +pattern Vector xs <- _ :< CompoundF (VectorF xs) + where Vector xs = SynNone :< CompoundF (VectorF xs) + +pattern Abbrev :: Prefix -> Datum -> Datum +pattern Abbrev p a <- _ :< CompoundF (AbbrevF p a) + where Abbrev p a = SynNone :< CompoundF (AbbrevF p a) + +pattern Boolean a = Simple (SimpleBoolean a) +pattern Number a = Simple (SimpleNumber a) +pattern Character a = Simple (SimpleCharacter a) +pattern String a = Simple (SimpleString a) +pattern Symbol a = Simple (SimpleSymbol a) +pattern Bytevector a = Simple (SimpleBytevector a) diff --git a/test/Gyehoek/Test/Golden.hs b/test/Gyehoek/Test/Golden.hs index 5085890..bedca27 100644 --- a/test/Gyehoek/Test/Golden.hs +++ b/test/Gyehoek/Test/Golden.hs @@ -93,9 +93,9 @@ stackifyTests files = do test_reader :: IO TestTree test_reader = do - all_cases <- listDirectory "golden/reader" + all_cases <- listDirectory "golden/read" let tests = all_cases - & fmap ("golden/reader") + & fmap ("golden/read") pure . testGroup "reader" $ tests <&> \test -> let testname = takeFileName test scmfile = test "source.scm" diff --git a/test/Gyehoek/Test/Sexp/Print.hs b/test/Gyehoek/Test/Sexp/Print.hs new file mode 100644 index 0000000..4933e75 --- /dev/null +++ b/test/Gyehoek/Test/Sexp/Print.hs @@ -0,0 +1,29 @@ +module Gyehoek.Test.Sexp.Print where + +import Test.Tasty (TestTree, testGroup, TestName) +import Test.Tasty.HUnit +import Gyehoek.Prelude +import Gyehoek.Sexp.Syntax qualified as S +import Gyehoek.Sexp.Print qualified as Sut +import System.FilePath (()) +import Test.Tasty.Silver + + +tcase = tcaseW 80 + +tcaseW :: Int -> TestName -> S.Datum -> TestTree +tcaseW width name ast = + goldenVsAction + name + ("golden/print" name) + (pure $ Sut.printDatumW width ast) + id + +test_print = testGroup "sexp pretty printer" $ + [ tcase "null" $ S.List [] + , let x = S.List [ S.Symbol s | s <- ["가","나","다","라"] ] + in testGroup "simple list" + [ tcase "flat" x + , tcaseW 4 "long" x + ] + ]