hrds.hs

data Noun = Atom Int | Pair Noun Noun

instance Show Noun where
  show (Atom a) = show a
  show (Pair a b) = "[" ++ ( (show a) ++ " " ++ (show b) ) ++ "]"

-- No BS helper function for getting the numeric value from a string
nobs :: [(Int, String)] -> Int
nobs [(x, "")] = x
nobs _ = error "Invalid atom"

-- Parses an atom from a decimal number
p_num :: GenParser Char st Noun
p_num = Atom <$> (nobs <$> readDec <$> (many1 digit))

-- Parses an atom from a hexadecimal number
p_hex :: GenParser Char st Noun
p_hex = Atom <$> (nobs <$> readHex <$> ((string "0x") >> (many1 hexDigit)))

-- Parses possible spaces or newliens
p_spac = (many (oneOf " \n"))

-- Parses a given expression with possible spaces around it
p_spaced x = p_spac >> x <* p_spac

-- Parses a decimal or hexadecimal atom
p_atom :: GenParser Char st Noun
p_atom = (try $ p_spaced p_hex)
         <|> (try $ p_spaced p_num)
         <?> "a valid atom"

-- Parses a pair of nouns inclosed in square brackets
p_pair :: GenParser Char st Noun
p_pair = Pair <$> ((char '[') >> p_noun)
              <*> (p_noun <* (p_spaced $ char ']'))

-- Parses a noun chain including the trailing ']'
p_dnoun :: GenParser Char st Noun
p_dnoun = try ( Pair <$> p_noun <*> (p_dnoun))
          <|> try ( p_noun <* (p_spaced $ char ']'))
          <?> "a valid list"

-- Parses a list of nouns and turns them into a pair chain
p_list :: GenParser Char st Noun
p_list = (p_spaced (char '[')) >> (p_dnoun)

-- Parses a noun
p_noun :: GenParser Char st Noun
p_noun = try p_atom
         <|> try p_pair
         <|> try p_list
         <?> "a valid atom, pair or list"

-- Parses a Human Readable Data Structure
parseHRDS :: String -> Either ParseError Noun
parseHRDS input = parse (p_noun <* eof) "(line)" input