Compare commits
2 commits
cabfbf46ac
...
0d7c9651b0
Author | SHA1 | Date | |
---|---|---|---|
0d7c9651b0 | |||
55805ef15a |
8 changed files with 58 additions and 8 deletions
3
.gitmodules
vendored
Normal file
3
.gitmodules
vendored
Normal file
|
@ -0,0 +1,3 @@
|
||||||
|
[submodule "3rdparty/pretty-parse"]
|
||||||
|
path = 3rdparty/pretty-parse
|
||||||
|
url = https://git.jossco.de/vegowotenks/pretty-parse
|
1
3rdparty/pretty-parse
vendored
Submodule
1
3rdparty/pretty-parse
vendored
Submodule
|
@ -0,0 +1 @@
|
||||||
|
Subproject commit 5e91f4b67e2588b6f0b9a94c7d03608aad0eb41a
|
40
app/Main.hs
40
app/Main.hs
|
@ -1,9 +1,41 @@
|
||||||
|
{-# LANGUAGE DeriveGeneric #-}
|
||||||
|
{-# LANGUAGE DerivingVia #-}
|
||||||
module Main (main) where
|
module Main (main) where
|
||||||
|
|
||||||
import qualified Data.Text as Text
|
-- meta
|
||||||
import qualified Data.Text.IO as TextIO
|
import GHC.Generics (Generic, Generically(..))
|
||||||
import qualified Language.Json as Json
|
|
||||||
|
-- containers
|
||||||
|
import Data.Text (Text)
|
||||||
|
|
||||||
|
-- classes
|
||||||
|
import Control.Monad ((<$!>))
|
||||||
|
import Pretty.Serialize (serialize, PrettySerialize)
|
||||||
|
|
||||||
|
-- json
|
||||||
import Language.Json.Parser (runParser)
|
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 :: 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}
|
||||||
|
|
||||||
|
|
|
@ -31,6 +31,7 @@ library
|
||||||
array
|
array
|
||||||
, base >=4.7 && <5
|
, base >=4.7 && <5
|
||||||
, containers
|
, containers
|
||||||
|
, pretty-parse
|
||||||
, text
|
, text
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
||||||
|
@ -46,6 +47,7 @@ executable hon-exe
|
||||||
, base >=4.7 && <5
|
, base >=4.7 && <5
|
||||||
, containers
|
, containers
|
||||||
, hon
|
, hon
|
||||||
|
, pretty-parse
|
||||||
, text
|
, text
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
||||||
|
@ -62,5 +64,6 @@ test-suite hon-test
|
||||||
, base >=4.7 && <5
|
, base >=4.7 && <5
|
||||||
, containers
|
, containers
|
||||||
, hon
|
, hon
|
||||||
|
, pretty-parse
|
||||||
, text
|
, text
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
|
@ -23,6 +23,7 @@ dependencies:
|
||||||
- base >= 4.7 && < 5
|
- base >= 4.7 && < 5
|
||||||
- containers
|
- containers
|
||||||
- text
|
- text
|
||||||
|
- pretty-parse
|
||||||
|
|
||||||
ghc-options:
|
ghc-options:
|
||||||
- -Wall
|
- -Wall
|
||||||
|
|
|
@ -1,6 +1,8 @@
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE LambdaCase #-}
|
{-# LANGUAGE LambdaCase #-}
|
||||||
{-# LANGUAGE TypeApplications #-}
|
{-# LANGUAGE TypeApplications #-}
|
||||||
|
{-# LANGUAGE DerivingVia #-}
|
||||||
|
{-# LANGUAGE DeriveGeneric #-}
|
||||||
module Language.Json (Value(..), null, true, false, boolean, buildInteger, number, document) where
|
module Language.Json (Value(..), null, true, false, boolean, buildInteger, number, document) where
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import Data.Array.IArray (Array)
|
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 Debug.Trace as Debug
|
||||||
import qualified Data.Array.IArray as Array
|
import qualified Data.Array.IArray as Array
|
||||||
import qualified Data.Map.Strict as Map
|
import qualified Data.Map.Strict as Map
|
||||||
|
import GHC.Generics ( Generic, Generically(..) )
|
||||||
|
import Pretty.Serialize (PrettySerialize)
|
||||||
|
|
||||||
|
|
||||||
data Value
|
data Value
|
||||||
|
@ -30,7 +34,8 @@ data Value
|
||||||
| Number Rational
|
| Number Rational
|
||||||
| Array (Array Natural Value)
|
| Array (Array Natural Value)
|
||||||
| Object (Map Text Value)
|
| Object (Map Text Value)
|
||||||
deriving Show
|
deriving (Show, Generic)
|
||||||
|
deriving PrettySerialize via Generically Value
|
||||||
|
|
||||||
null :: Parser Value
|
null :: Parser Value
|
||||||
null = do
|
null = do
|
||||||
|
|
|
@ -1,7 +1,8 @@
|
||||||
{-# LANGUAGE DerivingStrategies #-}
|
|
||||||
{-# LANGUAGE InstanceSigs #-}
|
{-# LANGUAGE InstanceSigs #-}
|
||||||
{-# LANGUAGE LambdaCase #-}
|
{-# LANGUAGE LambdaCase #-}
|
||||||
module Language.Json.Type (infer) where
|
{-# LANGUAGE DerivingVia #-}
|
||||||
|
{-# LANGUAGE DeriveGeneric #-}
|
||||||
|
module Language.Json.Type (infer, Type(..)) where
|
||||||
import Data.Map.Strict (Map)
|
import Data.Map.Strict (Map)
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import Data.Set (Set)
|
import Data.Set (Set)
|
||||||
|
@ -10,6 +11,8 @@ import qualified Data.Map.Merge.Strict as Map
|
||||||
import qualified Language.Json as Json
|
import qualified Language.Json as Json
|
||||||
import qualified Language.Json as Value
|
import qualified Language.Json as Value
|
||||||
import qualified Data.Foldable as Foldable
|
import qualified Data.Foldable as Foldable
|
||||||
|
import GHC.Generics (Generic, Generically(..))
|
||||||
|
import Pretty.Serialize (PrettySerialize)
|
||||||
|
|
||||||
data Type
|
data Type
|
||||||
= Null
|
= Null
|
||||||
|
@ -20,7 +23,8 @@ data Type
|
||||||
| Array Type
|
| Array Type
|
||||||
| Union (Set Type) -- multiple types are allowed here
|
| Union (Set Type) -- multiple types are allowed here
|
||||||
| Object (Map Text Type)
|
| Object (Map Text Type)
|
||||||
deriving stock (Show, Ord, Eq)
|
deriving stock (Show, Ord, Eq, Generic)
|
||||||
|
deriving PrettySerialize via Generically Type
|
||||||
|
|
||||||
instance Semigroup Type where
|
instance Semigroup Type where
|
||||||
(<>) :: Type -> Type -> Type
|
(<>) :: Type -> Type -> Type
|
||||||
|
|
|
@ -32,6 +32,7 @@ compiler: ghc-9.12.1
|
||||||
# - wai
|
# - wai
|
||||||
packages:
|
packages:
|
||||||
- .
|
- .
|
||||||
|
- 3rdparty/pretty-parse
|
||||||
# Dependency packages to be pulled from upstream that are not in the snapshot.
|
# Dependency packages to be pulled from upstream that are not in the snapshot.
|
||||||
# These entries can reference officially published versions as well as
|
# These entries can reference officially published versions as well as
|
||||||
# forks / in-progress versions pinned to a git hash. For example:
|
# forks / in-progress versions pinned to a git hash. For example:
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue