json_parser.hs

-- https://www.slideshare.net/redongjun/simple-json-parser
-- https://www.youtube.com/watch?v=r_Enynu_TV0


import Text.ParserCombinators.Parsec
import Control.Monad

matchTrue :: Parser String
matchTrue = string "true"

alwaysTrue :: Parser Bool
alwaysTrue = pure True

boolTrue :: Parser Bool
boolTrue = matchTrue *> alwaysTrue

matchFalse :: Parser String
matchFalse = string "false"

alwaysFalse :: Parser Bool
alwaysFalse = pure False

boolFalse :: Parser Bool
boolFalse = matchFalse *> alwaysFalse

bool :: Parser Bool
bool = boolTrue <|> boolFalse

stringLiteral :: Parser String
stringLiteral = 
    char '"' *> (many (noneOf ['"'])) <* char '"'

-- value = bool <|> stringLiteral
data JSONVal = Bool Bool
             | String String
             | Number Integer
             | Float Double
             | Array [JSONVal]
             | Object [(String, JSONVal)]
             deriving Show

number :: Parser String
number = many1 digit

--number = liftM (Number . read) (many1 digit) 
--https://stackoverflow.com/questions/44105493/relationship-between-fmap-and-bind
parseNumber :: Parser JSONVal 
parseNumber = many1 digit >>= return . (Number . read)


--parseJSON = Bool <$> bool <|> String <$> stringLiteral
--
parseBool :: Parser JSONVal
parseBool = lexeme (Bool <$> bool)

parseString :: Parser JSONVal
parseString = lexeme (String <$> stringLiteral)


parseFloat :: Parser JSONVal
parseFloat = 
  many1 digit >>= (\whole ->
  char '.' >>= (\c -> 
  many1 digit >>= (\decimal -> 
      return $ (Float . read) (whole ++ [c] ++ decimal))))

-- answer: --parseFloat = 
--  whole <- many1 digit
--  char '.'
--  decimal <- many1 digit
--  return $ (Float . read) (whole ++ "." ++ decimal)
--
--http://www.haskellforall.com/2014/10/how-to-desugar-haskell-code.html
--
--failed attempts
--parseFloat = liftA2 (+) many1 digit *> (char '.') *> many1 digit >>= return . (Float . read)
--parseFloat = many1 digit *> (char '.') *> many1 digit >>= return . (Float . read)

--parse parseJSON "" "3.0"

--parseJSON :: Parser JSONVal
--parseJSON = parseBool <|> parseString <|> (try parseFloat) <|> parseNumber

--testOr :: JSONVal
--testOr = String <$> (string "a"))
-- <|> String "b"
--run testOr "(b)"

array :: Parser [JSONVal]
array = (lexeme $char '[') *> sepBy parseJSON (lexeme $ char ',') <* (lexeme $ char ']')

parseArray :: Parser JSONVal
parseArray = Array <$> array

objectEntry :: Parser (String, JSONVal)
objectEntry = do
  key <- stringLiteral
  (lexeme $ char ':')
  value <- parseJSON
  return (key, value)

main :: IO ()
main = do
  print $ parse objectEntry "" "\"male\":true"

p = parse objectEntry "" "\"male\":true"

parseObject :: Parser JSONVal
parseObject = do
  (lexeme $ char '{')
  obj <- sepBy objectEntry (lexeme $ char ',')
  (lexeme $ char '}')
  return $ Object obj

ws :: Parser String
ws = many (oneOf " \t\n")

lexeme p = p <* ws

parseJSON :: Parser JSONVal
parseJSON = (try parseArray) <|> parseBool <|> parseString <|> (try parseFloat) <|> 
            parseNumber <|> parseObject
           


{--
 
  1 {
  2   "bio": "lessis.me",
  3   "city": "New York",
  4   "country": "us",
  5   "id": 123,
  6   "joined": 1223340961000,
  7   "lat": 40.77,
  8   "localized_country_name": "USA",
  9   "lon": 73.95,
 10   "name": "Bobby Tables",
 11   "photo": {
 12     "base_url": "http://photos3.meetupstatic.com",
 13     "highres_link": "http://photos3.meetupstatic.com/photos/member/...jpeg",
 14     "id": 456,
 15     "photo_link": "http://photos3.meetupstatic.com/photos/member/...jpeg",
 16     "thumb_link": "http://photos3.meetupstatic.com/photos/member/...jpeg",
 17     "type": "member"
 18   },
 19   "state": "NY",
 20   "status": "active"
 21 }
 22
~
parseFromFile parseJSON "example.json"
Right (Object [("bio",String "lessis.me"),("city",String "New York"),("country",String "us"),("id",Number 123),("join
ed",Number 1223340961000),("lat",Float 40.77),("localized_country_name",String "USA"),("lon",Float 73.95),("name",Str
ing "Bobby Tables"),("photo",Object [("base_url",String "http://photos3.meetupstatic.com"),("highres_link",String "ht
tp://photos3.meetupstatic.com/photos/member/...jpeg"),("id",Number 456),("photo_link",String "http://photos3.meetupst
atic.com/photos/member/...jpeg"),("thumb_link",String "http://photos3.meetupstatic.com/photos/member/...jpeg"),("type",String "member")]),("state",String "NY"),("status",String "active")])  
--}




-- interesting related exercise:
--https://www.cnblogs.com/ncore/p/6892500.html
--https://stackoverflow.com/questions/6029371/whats-the-difference-between-text-parsercombinators-parsec-and-text-parsec/6030195

meetup.json

{
    "rsvp_limit": 15,
    "status": "upcoming",
    "visibility": "public",
    "venue": {
        "name": "Hyperconnect, Inc",
        "address": "14F, 5 Seocho-daero 78-gil, Seocho-gu",
        "city": "Seoul",
        "country": "kr",
        "lat": 37.49721,
        "lon": 127.027374
    },
    "id": "140930019688259",
    "time": 1474326000,
    "event_url": "https://www.facebook.com/events/140930019688259/",
    "name": "Parsing Stuff in Haskell",
    "group": {
        "id": 1065398240148353,
        "name": "Haskell School",
        "join_mode": "open",
        "group_url": "https://www.facebook.com/groups/1065398240148353/"
    }
}