在 Haskell 中递归 JSON 解析
Recursive JSON parsing in Haskell
我有以下 haskell 代码。虽然太长了，复制粘贴一下就可以了：
module DebugVersionJSON where
import Data.Attoparsec.Char8
import qualified Data.Aeson as JSON
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as BS
import Control.Applicative
import Control.Monad
import qualified Data.HashMap.Strict as HashMap
data VersionCompound = NumberPlaceholder -- X
| Number Int -- 1, 2, 3, ..., 45, ...
deriving (Show)
instance Eq VersionCompound where
NumberPlaceholder == NumberPlaceholder = True
(Number v1) == (Number v2) = (v1 == v2)
_ == _ = False
type NumberOfDimensions = VersionCompound
versionCompoundToString :: VersionCompound -> String
versionCompoundToString (Number n) = (show n)
versionCompoundToString NumberPlaceholder = "x"
parseVersionCompound :: Parser VersionCompound
parseVersionCompound =
( string (BS.pack "x") >> return NumberPlaceholder)
<|> ( string (BS.pack "X") >> return NumberPlaceholder)
<|> ( decimal >>= \num -> return (Number num) )
data VersionNumber = VersionCompound VersionCompound
| VersionNumber VersionCompound VersionNumber
deriving (Show)
instance Eq VersionNumber where
( VersionCompound vc1 ) == ( VersionCompound vc2 ) = (vc1 == vc2)
( VersionNumber vc1 vn1 ) == ( VersionNumber vc2 vn2 ) = (vc1 == vc2 && vn1 == vn2)
( VersionNumber vc1 vn1 ) == ( VersionCompound vc2 ) = (vc1 == vc2 && vn1 == (VersionCompound NumberPlaceholder) )
( VersionCompound vc1 ) == ( VersionNumber vc2 vn2) = (vc1 == vc2 && vn2 == (VersionCompound NumberPlaceholder) )
versionNumberToString :: VersionNumber -> String
versionNumberToString (VersionNumber vc vn) = (versionCompoundToString vc) ++ "." ++ (versionNumberToString vn)
versionNumberToString (VersionCompound vc) = (versionCompoundToString vc)
parseVersionNumber :: Parser VersionNumber
parseVersionNumber = do
ds <- sepBy1 parseVersionCompound (char '.')
let vs = map VersionCompound ds
return (foldr1 (\(VersionCompound vc) -> VersionNumber vc) vs )
data MaturityLevel = Dev
| Test
| User
| ReleaseCandidate
| Prod
deriving (Show, Enum, Ord, Eq)
parseMaturity :: Parser MaturityLevel
parseMaturity =
( string (BS.pack "Dev") >> return Dev)
<|> ( string (BS.pack "Test") >> return Test)
<|> ( string (BS.pack "User") >> return User)
<|> ( string (BS.pack "ReleaseCandidate") >> return ReleaseCandidate)
<|> ( string (BS.pack "Prod") >> return Prod)
data Version = MaturityVersion MaturityLevel VersionNumber -- Dev/1.x.0, Test/1.x.3, User/1.x.4, User/2.5.1, ...
| Version VersionNumber
instance Show Version where
show version = versionToString version
instance Eq Version where
(Version vn1) == (Version vn2) = (vn1 == vn2)
(Version vn1) == (MaturityVersion ml vn2) = (ml == Dev) && vn1 == vn2
(MaturityVersion ml vn1) == (Version vn2) = (ml == Dev) && vn1 == vn2
(MaturityVersion ml1 vn1) == (MaturityVersion ml2 vn2) = ( ml1 == ml2 ) && (vn1 == vn2)
versionToString :: Version -> String
versionToString (MaturityVersion maturityLevel versionNumber) = (show maturityLevel) ++ "/" ++ (versionNumberToString versionNumber)
versionToString (Version versionNumber) = (versionNumberToString versionNumber)
instance JSON.ToJSON Version where
toJSON version =
JSON.object [ T.pack "version" JSON..= (T.pack $ show version)]
instance JSON.FromJSON Version where
parseJSON (JSON.Object v) = liftM stringToVersion ( v JSON..: T.pack "version" )
parseJSON _ = mzero
parseVersion :: Parser Version
parseVersion = do {
maturity <- parseMaturity
; char '/'
; version <- parseVersionNumber
; return $ MaturityVersion maturity version
}
<|> do {
version <- parseVersionNumber
; return $ Version version
}
class VersionOperations a where
decrement :: a -> a
decrementDimension :: NumberOfDimensions -> a -> a
increment :: a -> a
incrementDimension :: NumberOfDimensions -> a -> a
instance VersionOperations VersionCompound where
decrement NumberPlaceholder = NumberPlaceholder
decrement (Number 0) = Number 0
decrement (Number num) = Number (num - 1)
decrementDimension _ a = decrement a
increment NumberPlaceholder = NumberPlaceholder
increment (Number num) = Number (num + 1)
incrementDimension _ a = increment a
createVersionNumberByNumberOfDimensions :: NumberOfDimensions -> VersionNumber
createVersionNumberByNumberOfDimensions ( NumberPlaceholder ) = VersionCompound NumberPlaceholder
createVersionNumberByNumberOfDimensions ( Number 0 ) = VersionCompound NumberPlaceholder
createVersionNumberByNumberOfDimensions ( Number 1 ) = VersionCompound NumberPlaceholder
createVersionNumberByNumberOfDimensions num = VersionNumber NumberPlaceholder ( createVersionNumberByNumberOfDimensions ( decrement num ) )
stringToVersion :: String -> Version
stringToVersion str = case (parseOnly parseVersion $ BS.pack str) of
Right a -> a
Left _ -> Version ( createVersionNumberByNumberOfDimensions (Number 0) )
vc1 :: VersionCompound
vc1 = NumberPlaceholder
vc2 :: VersionCompound
vc2 = (Number 1)
vc3 :: VersionCompound
vc3 = (Number 2)
v4 :: Version
v4 = MaturityVersion Dev ( VersionCompound ( Number 3 ) )
v5 :: Version
v5 = MaturityVersion ReleaseCandidate ( VersionCompound ( Number 50 ) )
type DocumentName = String
type DirectoryName = String
type DocumentContent = String
data Document = Document DocumentName DocumentContent deriving (Show, Eq)
data Directory = Directory DirectoryName [DocumentOrDirectory] deriving (Show, Eq)
newtype DocumentOrDirectory = DocumentOrDirectory (Either Document Directory) deriving (Show, Eq)
emptyDocument = ( Document "" "" )
-- instance Show DocumentOrDirectory where
-- show (Document name content ) = "Document: " ++ name ++ ", Content: " ++ content ++ ""
-- show (Directory dirName content ) = "Directory: " ++ dirName ++ ", Content: " ++ (show content) ++ ""
liftDocument :: Document -> DocumentOrDirectory
liftDocument = DocumentOrDirectory . Left
liftDirectory :: Directory -> DocumentOrDirectory
liftDirectory = DocumentOrDirectory . Right
-- ToJSON
instance JSON.ToJSON Document where
toJSON (Document name content) = JSON.object [ T.pack "document" JSON..= JSON.object [
T.pack "name" JSON..= name,
T.pack "content" JSON..= content ]]
instance JSON.ToJSON Directory where
toJSON (Directory name content) = JSON.object [ T.pack "directory" JSON..= JSON.object [
T.pack "name" JSON..= name,
T.pack "content" JSON..= content ]]
instance JSON.ToJSON DocumentOrDirectory where
toJSON (DocumentOrDirectory (Left d)) = JSON.toJSON d
toJSON (DocumentOrDirectory (Right d)) = JSON.toJSON d
-- FromJSON
instance JSON.FromJSON Document where
parseJSON (JSON.Object v) = maybe mzero parser $ HashMap.lookup (T.pack "document") v
where parser (JSON.Object v') = Document <$> v' JSON..: T.pack "name"
<*> v' JSON..: T.pack "content"
parser _ = mzero
parseJSON _ = mzero
instance JSON.FromJSON Directory where
parseJSON (JSON.Object v) = maybe mzero parser $ HashMap.lookup (T.pack "directory") v
where parser (JSON.Object v') = Directory <$> v' JSON..: T.pack "name"
<*> v' JSON..: T.pack "content"
parser _ = mzero
parseJSON _ = mzero
instance JSON.FromJSON DocumentOrDirectory where
parseJSON json = (liftDocument <$> JSON.parseJSON json) <|> (liftDirectory <$> JSON.parseJSON json)
-- EXAMPLES --
doc1 :: Document
doc1 = Document "doc1" "content1"
doc2 :: Document
doc2 = Document "doc2" "content2"
type BranchName = String
type Timestamp = Integer
data Snapshot = Snapshot Timestamp Version DocumentOrDirectory
data Snapshot2 = Snapshot2 Timestamp DocumentOrDirectory deriving (Show, Eq)
instance Eq Snapshot where
(Snapshot timestampA versionA _ ) == (Snapshot timestampB versionB _ ) = (timestampA == timestampB) && (versionA == versionB)
_ == _ = False
instance Show Snapshot where
show (Snapshot timestamp version contents ) = ("Snapshot taken at " ++ (show timestamp) ++ ", Version " ++ (versionToString version) ++ ", " ++ (show contents) ++ "")
instance JSON.ToJSON Snapshot where
toJSON (Snapshot timestamp version document) = JSON.object [ T.pack "snapshot" JSON..= JSON.object [
T.pack "version" JSON..= JSON.toJSON version,
T.pack "timestamp" JSON..= timestamp,
T.pack "artifact" JSON..= JSON.toJSON document ]]
instance JSON.ToJSON Snapshot2 where
toJSON (Snapshot2 timestamp document) = JSON.object [ T.pack "snapshot" JSON..= JSON.object [
T.pack "timestamp" JSON..= timestamp,
T.pack "artifact" JSON..= JSON.toJSON document ]]
instance JSON.FromJSON Snapshot where
parseJSON (JSON.Object v) = maybe mzero parser $ HashMap.lookup (T.pack "snapshot") v
where parser (JSON.Object v') = Snapshot <$> v' JSON..: T.pack "version"
<*> v' JSON..: T.pack "timestamp"
<*> v' JSON..: T.pack "artifact"
parser _ = mzero
parseJSON _ = mzero
instance JSON.FromJSON Snapshot2 where
parseJSON (JSON.Object v) = maybe mzero parser $ HashMap.lookup (T.pack "snapshot") v
where parser (JSON.Object v') = Snapshot2 <$> v' JSON..: T.pack "timestamp"
<*> v' JSON..: T.pack "artifact"
parser _ = mzero
parseJSON _ = mzero
snapshot1 :: Snapshot
snapshot1 = Snapshot 12372 ( MaturityVersion Dev ( VersionCompound ( Number 10 ) ) ) ( liftDocument doc1 )
snapshot2 :: Snapshot2
snapshot2 = Snapshot2 12372 ( liftDocument doc1 )
一方面，JSON.decode $ JSON.encode snapshot2 :: Maybe Snapshot2 执行得很好，结果是 Just (Snapshot2 12372 (DocumentOrDirectory (Left (Document "doc1" "content1"))))。另一方面，JSON.decode $ JSON.encode snapshot :: Maybe Snapshot 导致 Nothing。
两个解析器的区别如下：
instance JSON.ToJSON Snapshot where
toJSON (Snapshot timestamp version document) = JSON.object [ T.pack "snapshot" JSON..= JSON.object [
T.pack "version" JSON..= JSON.toJSON version, -- <- includes version parsing
T.pack "timestamp" JSON..= timestamp,
T.pack "artifact" JSON..= JSON.toJSON document ]]
instance JSON.ToJSON Snapshot2 where
toJSON (Snapshot2 timestamp document) = JSON.object [ T.pack "snapshot" JSON..= JSON.object [
T.pack "timestamp" JSON..= timestamp,
T.pack "artifact" JSON..= JSON.toJSON document ]]
知道为什么 JSON.decode $ JSON.encode snapshot :: Maybe Snapshot 失败了吗？我知道版本解析有问题，但我不知道到底是什么。如果您能帮我弄清楚如何修复版本解析，以便我可以正确解析 JSON，我会很高兴。
问题是您将快照定义为：
data Snapshot = Snapshot Timestamp Version DocumentOrDirectory
但是您的 FromJSON 实例是：
where parser (JSON.Object v') = Snapshot <$> v' JSON..: T.pack "version"
<*> v' JSON..: T.pack "timestamp"
<*> v' JSON..: T.pack "artifact"
即- 您混淆了字段的顺序。
我有以下 haskell 代码。虽然太长了，复制粘贴一下就可以了：
module DebugVersionJSON where
import Data.Attoparsec.Char8
import qualified Data.Aeson as JSON
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as BS
import Control.Applicative
import Control.Monad
import qualified Data.HashMap.Strict as HashMap
data VersionCompound = NumberPlaceholder -- X
| Number Int -- 1, 2, 3, ..., 45, ...
deriving (Show)
instance Eq VersionCompound where
NumberPlaceholder == NumberPlaceholder = True
(Number v1) == (Number v2) = (v1 == v2)
_ == _ = False
type NumberOfDimensions = VersionCompound
versionCompoundToString :: VersionCompound -> String
versionCompoundToString (Number n) = (show n)
versionCompoundToString NumberPlaceholder = "x"
parseVersionCompound :: Parser VersionCompound
parseVersionCompound =
( string (BS.pack "x") >> return NumberPlaceholder)
<|> ( string (BS.pack "X") >> return NumberPlaceholder)
<|> ( decimal >>= \num -> return (Number num) )
data VersionNumber = VersionCompound VersionCompound
| VersionNumber VersionCompound VersionNumber
deriving (Show)
instance Eq VersionNumber where
( VersionCompound vc1 ) == ( VersionCompound vc2 ) = (vc1 == vc2)
( VersionNumber vc1 vn1 ) == ( VersionNumber vc2 vn2 ) = (vc1 == vc2 && vn1 == vn2)
( VersionNumber vc1 vn1 ) == ( VersionCompound vc2 ) = (vc1 == vc2 && vn1 == (VersionCompound NumberPlaceholder) )
( VersionCompound vc1 ) == ( VersionNumber vc2 vn2) = (vc1 == vc2 && vn2 == (VersionCompound NumberPlaceholder) )
versionNumberToString :: VersionNumber -> String
versionNumberToString (VersionNumber vc vn) = (versionCompoundToString vc) ++ "." ++ (versionNumberToString vn)
versionNumberToString (VersionCompound vc) = (versionCompoundToString vc)
parseVersionNumber :: Parser VersionNumber
parseVersionNumber = do
ds <- sepBy1 parseVersionCompound (char '.')
let vs = map VersionCompound ds
return (foldr1 (\(VersionCompound vc) -> VersionNumber vc) vs )
data MaturityLevel = Dev
| Test
| User
| ReleaseCandidate
| Prod
deriving (Show, Enum, Ord, Eq)
parseMaturity :: Parser MaturityLevel
parseMaturity =
( string (BS.pack "Dev") >> return Dev)
<|> ( string (BS.pack "Test") >> return Test)
<|> ( string (BS.pack "User") >> return User)
<|> ( string (BS.pack "ReleaseCandidate") >> return ReleaseCandidate)
<|> ( string (BS.pack "Prod") >> return Prod)
data Version = MaturityVersion MaturityLevel VersionNumber -- Dev/1.x.0, Test/1.x.3, User/1.x.4, User/2.5.1, ...
| Version VersionNumber
instance Show Version where
show version = versionToString version
instance Eq Version where
(Version vn1) == (Version vn2) = (vn1 == vn2)
(Version vn1) == (MaturityVersion ml vn2) = (ml == Dev) && vn1 == vn2
(MaturityVersion ml vn1) == (Version vn2) = (ml == Dev) && vn1 == vn2
(MaturityVersion ml1 vn1) == (MaturityVersion ml2 vn2) = ( ml1 == ml2 ) && (vn1 == vn2)
versionToString :: Version -> String
versionToString (MaturityVersion maturityLevel versionNumber) = (show maturityLevel) ++ "/" ++ (versionNumberToString versionNumber)
versionToString (Version versionNumber) = (versionNumberToString versionNumber)
instance JSON.ToJSON Version where
toJSON version =
JSON.object [ T.pack "version" JSON..= (T.pack $ show version)]
instance JSON.FromJSON Version where
parseJSON (JSON.Object v) = liftM stringToVersion ( v JSON..: T.pack "version" )
parseJSON _ = mzero
parseVersion :: Parser Version
parseVersion = do {
maturity <- parseMaturity
; char '/'
; version <- parseVersionNumber
; return $ MaturityVersion maturity version
}
<|> do {
version <- parseVersionNumber
; return $ Version version
}
class VersionOperations a where
decrement :: a -> a
decrementDimension :: NumberOfDimensions -> a -> a
increment :: a -> a
incrementDimension :: NumberOfDimensions -> a -> a
instance VersionOperations VersionCompound where
decrement NumberPlaceholder = NumberPlaceholder
decrement (Number 0) = Number 0
decrement (Number num) = Number (num - 1)
decrementDimension _ a = decrement a
increment NumberPlaceholder = NumberPlaceholder
increment (Number num) = Number (num + 1)
incrementDimension _ a = increment a
createVersionNumberByNumberOfDimensions :: NumberOfDimensions -> VersionNumber
createVersionNumberByNumberOfDimensions ( NumberPlaceholder ) = VersionCompound NumberPlaceholder
createVersionNumberByNumberOfDimensions ( Number 0 ) = VersionCompound NumberPlaceholder
createVersionNumberByNumberOfDimensions ( Number 1 ) = VersionCompound NumberPlaceholder
createVersionNumberByNumberOfDimensions num = VersionNumber NumberPlaceholder ( createVersionNumberByNumberOfDimensions ( decrement num ) )
stringToVersion :: String -> Version
stringToVersion str = case (parseOnly parseVersion $ BS.pack str) of
Right a -> a
Left _ -> Version ( createVersionNumberByNumberOfDimensions (Number 0) )
vc1 :: VersionCompound
vc1 = NumberPlaceholder
vc2 :: VersionCompound
vc2 = (Number 1)
vc3 :: VersionCompound
vc3 = (Number 2)
v4 :: Version
v4 = MaturityVersion Dev ( VersionCompound ( Number 3 ) )
v5 :: Version
v5 = MaturityVersion ReleaseCandidate ( VersionCompound ( Number 50 ) )
type DocumentName = String
type DirectoryName = String
type DocumentContent = String
data Document = Document DocumentName DocumentContent deriving (Show, Eq)
data Directory = Directory DirectoryName [DocumentOrDirectory] deriving (Show, Eq)
newtype DocumentOrDirectory = DocumentOrDirectory (Either Document Directory) deriving (Show, Eq)
emptyDocument = ( Document "" "" )
-- instance Show DocumentOrDirectory where
-- show (Document name content ) = "Document: " ++ name ++ ", Content: " ++ content ++ ""
-- show (Directory dirName content ) = "Directory: " ++ dirName ++ ", Content: " ++ (show content) ++ ""
liftDocument :: Document -> DocumentOrDirectory
liftDocument = DocumentOrDirectory . Left
liftDirectory :: Directory -> DocumentOrDirectory
liftDirectory = DocumentOrDirectory . Right
-- ToJSON
instance JSON.ToJSON Document where
toJSON (Document name content) = JSON.object [ T.pack "document" JSON..= JSON.object [
T.pack "name" JSON..= name,
T.pack "content" JSON..= content ]]
instance JSON.ToJSON Directory where
toJSON (Directory name content) = JSON.object [ T.pack "directory" JSON..= JSON.object [
T.pack "name" JSON..= name,
T.pack "content" JSON..= content ]]
instance JSON.ToJSON DocumentOrDirectory where
toJSON (DocumentOrDirectory (Left d)) = JSON.toJSON d
toJSON (DocumentOrDirectory (Right d)) = JSON.toJSON d
-- FromJSON
instance JSON.FromJSON Document where
parseJSON (JSON.Object v) = maybe mzero parser $ HashMap.lookup (T.pack "document") v
where parser (JSON.Object v') = Document <$> v' JSON..: T.pack "name"
<*> v' JSON..: T.pack "content"
parser _ = mzero
parseJSON _ = mzero
instance JSON.FromJSON Directory where
parseJSON (JSON.Object v) = maybe mzero parser $ HashMap.lookup (T.pack "directory") v
where parser (JSON.Object v') = Directory <$> v' JSON..: T.pack "name"
<*> v' JSON..: T.pack "content"
parser _ = mzero
parseJSON _ = mzero
instance JSON.FromJSON DocumentOrDirectory where
parseJSON json = (liftDocument <$> JSON.parseJSON json) <|> (liftDirectory <$> JSON.parseJSON json)
-- EXAMPLES --
doc1 :: Document
doc1 = Document "doc1" "content1"
doc2 :: Document
doc2 = Document "doc2" "content2"
type BranchName = String
type Timestamp = Integer
data Snapshot = Snapshot Timestamp Version DocumentOrDirectory
data Snapshot2 = Snapshot2 Timestamp DocumentOrDirectory deriving (Show, Eq)
instance Eq Snapshot where
(Snapshot timestampA versionA _ ) == (Snapshot timestampB versionB _ ) = (timestampA == timestampB) && (versionA == versionB)
_ == _ = False
instance Show Snapshot where
show (Snapshot timestamp version contents ) = ("Snapshot taken at " ++ (show timestamp) ++ ", Version " ++ (versionToString version) ++ ", " ++ (show contents) ++ "")
instance JSON.ToJSON Snapshot where
toJSON (Snapshot timestamp version document) = JSON.object [ T.pack "snapshot" JSON..= JSON.object [
T.pack "version" JSON..= JSON.toJSON version,
T.pack "timestamp" JSON..= timestamp,
T.pack "artifact" JSON..= JSON.toJSON document ]]
instance JSON.ToJSON Snapshot2 where
toJSON (Snapshot2 timestamp document) = JSON.object [ T.pack "snapshot" JSON..= JSON.object [
T.pack "timestamp" JSON..= timestamp,
T.pack "artifact" JSON..= JSON.toJSON document ]]
instance JSON.FromJSON Snapshot where
parseJSON (JSON.Object v) = maybe mzero parser $ HashMap.lookup (T.pack "snapshot") v
where parser (JSON.Object v') = Snapshot <$> v' JSON..: T.pack "version"
<*> v' JSON..: T.pack "timestamp"
<*> v' JSON..: T.pack "artifact"
parser _ = mzero
parseJSON _ = mzero
instance JSON.FromJSON Snapshot2 where
parseJSON (JSON.Object v) = maybe mzero parser $ HashMap.lookup (T.pack "snapshot") v
where parser (JSON.Object v') = Snapshot2 <$> v' JSON..: T.pack "timestamp"
<*> v' JSON..: T.pack "artifact"
parser _ = mzero
parseJSON _ = mzero
snapshot1 :: Snapshot
snapshot1 = Snapshot 12372 ( MaturityVersion Dev ( VersionCompound ( Number 10 ) ) ) ( liftDocument doc1 )
snapshot2 :: Snapshot2
snapshot2 = Snapshot2 12372 ( liftDocument doc1 )
一方面，JSON.decode $ JSON.encode snapshot2 :: Maybe Snapshot2 执行得很好，结果是 Just (Snapshot2 12372 (DocumentOrDirectory (Left (Document "doc1" "content1"))))。另一方面，JSON.decode $ JSON.encode snapshot :: Maybe Snapshot 导致 Nothing。
两个解析器的区别如下：
instance JSON.ToJSON Snapshot where
toJSON (Snapshot timestamp version document) = JSON.object [ T.pack "snapshot" JSON..= JSON.object [
T.pack "version" JSON..= JSON.toJSON version, -- <- includes version parsing
T.pack "timestamp" JSON..= timestamp,
T.pack "artifact" JSON..= JSON.toJSON document ]]
instance JSON.ToJSON Snapshot2 where
toJSON (Snapshot2 timestamp document) = JSON.object [ T.pack "snapshot" JSON..= JSON.object [
T.pack "timestamp" JSON..= timestamp,
T.pack "artifact" JSON..= JSON.toJSON document ]]
知道为什么 JSON.decode $ JSON.encode snapshot :: Maybe Snapshot 失败了吗？我知道版本解析有问题，但我不知道到底是什么。如果您能帮我弄清楚如何修复版本解析，以便我可以正确解析 JSON，我会很高兴。
问题是您将快照定义为：
data Snapshot = Snapshot Timestamp Version DocumentOrDirectory
但是您的 FromJSON 实例是：
where parser (JSON.Object v') = Snapshot <$> v' JSON..: T.pack "version"
<*> v' JSON..: T.pack "timestamp"
<*> v' JSON..: T.pack "artifact"
即- 您混淆了字段的顺序。