From 55805ef15a8a72c0b388183276e22376618791d1 Mon Sep 17 00:00:00 2001 From: VegOwOtenks Date: Thu, 21 Aug 2025 20:08:51 +0200 Subject: [PATCH 1/2] feat: PrettySerialize instances --- .gitmodules | 3 +++ 3rdparty/pretty-parse | 1 + hon.cabal | 3 +++ package.yaml | 1 + src/Language/Json.hs | 7 ++++++- src/Language/Json/Type.hs | 8 ++++++-- stack.yaml | 1 + 7 files changed, 21 insertions(+), 3 deletions(-) create mode 100644 .gitmodules create mode 160000 3rdparty/pretty-parse diff --git a/.gitmodules b/.gitmodules new file mode 100644 index 0000000..fcebd5e --- /dev/null +++ b/.gitmodules @@ -0,0 +1,3 @@ +[submodule "3rdparty/pretty-parse"] + path = 3rdparty/pretty-parse + url = https://git.jossco.de/vegowotenks/pretty-parse diff --git a/3rdparty/pretty-parse b/3rdparty/pretty-parse new file mode 160000 index 0000000..5e91f4b --- /dev/null +++ b/3rdparty/pretty-parse @@ -0,0 +1 @@ +Subproject commit 5e91f4b67e2588b6f0b9a94c7d03608aad0eb41a diff --git a/hon.cabal b/hon.cabal index 6ca91ef..777edac 100644 --- a/hon.cabal +++ b/hon.cabal @@ -31,6 +31,7 @@ library array , base >=4.7 && <5 , containers + , pretty-parse , text default-language: Haskell2010 @@ -46,6 +47,7 @@ executable hon-exe , base >=4.7 && <5 , containers , hon + , pretty-parse , text default-language: Haskell2010 @@ -62,5 +64,6 @@ test-suite hon-test , base >=4.7 && <5 , containers , hon + , pretty-parse , text default-language: Haskell2010 diff --git a/package.yaml b/package.yaml index a0462d5..f3804df 100644 --- a/package.yaml +++ b/package.yaml @@ -23,6 +23,7 @@ dependencies: - base >= 4.7 && < 5 - containers - text +- pretty-parse ghc-options: - -Wall diff --git a/src/Language/Json.hs b/src/Language/Json.hs index a32901f..a2d8d03 100644 --- a/src/Language/Json.hs +++ b/src/Language/Json.hs @@ -1,6 +1,8 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE TypeApplications #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE DeriveGeneric #-} module Language.Json (Value(..), null, true, false, boolean, buildInteger, number, document) where import Data.Text (Text) import Data.Array.IArray (Array) @@ -21,6 +23,8 @@ import qualified Data.Text.Internal.Read as Text import qualified Debug.Trace as Debug import qualified Data.Array.IArray as Array import qualified Data.Map.Strict as Map +import GHC.Generics ( Generic, Generically(..) ) +import Pretty.Serialize (PrettySerialize) data Value @@ -30,7 +34,8 @@ data Value | Number Rational | Array (Array Natural Value) | Object (Map Text Value) - deriving Show + deriving (Show, Generic) + deriving PrettySerialize via Generically Value null :: Parser Value null = do diff --git a/src/Language/Json/Type.hs b/src/Language/Json/Type.hs index db6b2c5..e32a19a 100644 --- a/src/Language/Json/Type.hs +++ b/src/Language/Json/Type.hs @@ -1,6 +1,7 @@ -{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE DeriveGeneric #-} module Language.Json.Type (infer) where import Data.Map.Strict (Map) import Data.Text (Text) @@ -10,6 +11,8 @@ import qualified Data.Map.Merge.Strict as Map import qualified Language.Json as Json import qualified Language.Json as Value import qualified Data.Foldable as Foldable +import GHC.Generics (Generic, Generically(..)) +import Pretty.Serialize (PrettySerialize) data Type = Null @@ -20,7 +23,8 @@ data Type | Array Type | Union (Set Type) -- multiple types are allowed here | Object (Map Text Type) - deriving stock (Show, Ord, Eq) + deriving stock (Show, Ord, Eq, Generic) + deriving PrettySerialize via Generically Type instance Semigroup Type where (<>) :: Type -> Type -> Type diff --git a/stack.yaml b/stack.yaml index 7f64f92..e9a7727 100644 --- a/stack.yaml +++ b/stack.yaml @@ -32,6 +32,7 @@ compiler: ghc-9.12.1 # - wai packages: - . +- 3rdparty/pretty-parse # Dependency packages to be pulled from upstream that are not in the snapshot. # These entries can reference officially published versions as well as # forks / in-progress versions pinned to a git hash. For example: From 0d7c9651b0ebba980787d020dc8a9fa357172f9b Mon Sep 17 00:00:00 2001 From: VegOwOtenks Date: Thu, 21 Aug 2025 20:19:15 +0200 Subject: [PATCH 2/2] feat: Dump somewhat readable --- app/Main.hs | 40 +++++++++++++++++++++++++++++++++++---- src/Language/Json/Type.hs | 2 +- 2 files changed, 37 insertions(+), 5 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index f380007..b2f7bce 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,9 +1,41 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingVia #-} module Main (main) where -import qualified Data.Text as Text -import qualified Data.Text.IO as TextIO -import qualified Language.Json as Json +-- meta +import GHC.Generics (Generic, Generically(..)) + +-- containers +import Data.Text (Text) + +-- classes +import Control.Monad ((<$!>)) +import Pretty.Serialize (serialize, PrettySerialize) + +-- json import Language.Json.Parser (runParser) +import qualified Language.Json as Json +import qualified Language.Json.Type as Json + +-- io +import qualified Data.Text.IO as TextIO +import qualified Data.Text.Lazy.IO as LazyTextIO + +data JsonInfo = JsonInfo + { json :: Json.Value + , inferredType :: Json.Type + } + deriving stock (Generic) + deriving PrettySerialize via Generically JsonInfo + main :: IO () -main = TextIO.interact (Text.pack . show . runParser Json.document) +main = do + info <- mkJsonInfo <$!> TextIO.getContents + LazyTextIO.putStrLn . serialize $ info + +mkJsonInfo :: Text -> Maybe JsonInfo +mkJsonInfo input = do + (_, value) <- runParser Json.document input + pure $ JsonInfo {json=value, inferredType=Json.infer value} + diff --git a/src/Language/Json/Type.hs b/src/Language/Json/Type.hs index e32a19a..672d4bf 100644 --- a/src/Language/Json/Type.hs +++ b/src/Language/Json/Type.hs @@ -2,7 +2,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE DerivingVia #-} {-# LANGUAGE DeriveGeneric #-} -module Language.Json.Type (infer) where +module Language.Json.Type (infer, Type(..)) where import Data.Map.Strict (Map) import Data.Text (Text) import Data.Set (Set)