1
我有以下一段haskell代码。即使它是太长，你可以复制粘贴，它就会马上工作：Haskell中的递归JSON解析
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。
你会帮助自己很多 - 也许到了能够回答你自己的问题的地步，但肯定是人们可能有兴趣看看你的问题 - 如果你最小化这个代码。这只是标准的调试练习。 –