module Hasklet2 where


--
-- * Parser type
--

-- | Given a string, a parser either fails or returns a parsed value and
--   the rest of the string to be parsed.
type Parser a = String -> Maybe (a, String)


--
-- * Single character parsers
--

-- | Match the end of the input string.
end :: Parser ()
end "" = Just ((),"")
end _  = Nothing

-- | Return the next character if it satisfies the given predicate.
nextIf :: (Char -> Bool) -> Parser Char
nextIf f (c:s) | f c = Just (c,s)
nextIf _ _           = Nothing

-- | Parse the given character.
char :: Char -> Parser Char
char c = nextIf (c ==)

-- | Parse one of the given characters.
oneOf :: [Char] -> Parser Char
oneOf cs = nextIf (flip elem cs)

-- | Parse a particular class of character.
lower, upper, digit, space :: Parser Char
lower = oneOf ['a'..'z']
upper = oneOf ['A'..'Z']
digit = oneOf ['0'..'9']
space = oneOf " \t\n\r"

-- | Parse a digit as an integer.
digitInt :: Parser Int
digitInt s = case digit s of
               Just (c, s') -> Just (fromEnum c - fromEnum '0', s')
               Nothing      -> Nothing


--
-- * Alternative and repeating parsers
--

-- | Run the first parser. If it succeeds, return the result. Otherwise run
--   the second parser.
--
--   >>> (upper <|> digit) "Hi"
--   Just ('H',"i")
--
--   >>> (upper <|> digit) "42"
--   Just ('4',"2")
--
--   >>> (upper <|> digit) "w00t"
--   Nothing
--
(<|>) :: Parser a -> Parser a -> Parser a
(<|>) p q s = maybe (q s) Just (p s)


-- | Parse a sequence of one or more items, returning the results as a list.
--   Parses the longest possible sequence (i.e. until the given parser fails).
--
--   >>> many1 lower "abcDEF123"
--   Just ("abc","DEF123")
--
--   >>> many1 lower "ABCdef123"
--   Nothing
--
--   >>> many1 (lower <|> upper) "ABCdef123"
--   Just ("ABCdef","123")
--
--   >>> many1 digitInt "123abc"
--   Just ([1,2,3],"abc")
--
many1 :: Parser a -> Parser [a]
many1 p s = case p s of
              Just (x, s') -> case many1 p s' of
                                Just (xs, s'') -> Just (x:xs, s'')
                                Nothing        -> Just ([x], s')
              Nothing      -> Nothing


-- | Parse a sequence of zero or more items, returning the results as a list.
--
--   >>> many lower "abcDEF123"
--   Just ("abc","DEF123")
--
--   >>> many lower "ABCdef123"
--   Just ("","ABCdef123")
--
--   >>> many (lower <|> upper) "abcDEF123"
--   Just ("abcDEF","123")
--
--   >>> many digitInt "123abc"
--   Just ([1,2,3],"abc")
--
--   >>> many digitInt "abc123"
--   Just ([],"abc123")
--
many :: Parser a -> Parser [a]
many p = many1 p <|> \s -> Just ([], s)


-- | Parse a natural number into a Haskell integer.
--   
--   >>> nat "123abc"
--   Just (123,"abc")
--
--   >>> nat "abc"
--   Nothing
--
nat :: Parser Int
nat s = case many1 digitInt s of
          Just (is, s') -> Just (foldl (\n i -> 10*n + i) 0 is, s')
          Nothing       -> Nothing


--
-- * Parsing structured data
--

-- | Parse a pair of natural numbers into a Haskell pair of integers. You can
--   assume there are no spaces within the substring encoding the pair,
--   although you're welcome to try to generalize it to handle whitespace too,
--   e.g. before/after parentheses and the comma.
--
--   This may get a little bit hairy, but the ugliness here will motivate some
--   key abstractions later. :-)
--
--   >>> natPair "(123,45) 678"
--   Just ((123,45)," 678")
--
--   >>> natPair "(123,45"
--   Nothing
--
--   >>> natPair "(123,x) 678"
--   Nothing
--
natPair :: Parser (Int,Int)
natPair = pair nat


-- | Parse a pair of values of an arbitrary type.
pair :: Parser a -> Parser (a,a)
pair p s
    | Just (_,s2) <- char '(' s
    , Just (l,s3) <- p s2
    , Just (_,s4) <- char ',' s3
    , Just (r,s5) <- p s4
    , Just (_,s6) <- char ')' s5 = Just ((l,r), s6)
    | otherwise                  = Nothing


-- | A simple tree data structure, isomorphic to arbitrarily nested pairs with
--   integers at the leaves.
data Tree
   = Leaf Int
   | Node Tree Tree
  deriving (Eq,Show)

-- | Parse a tree encoded as arbitrarily nested pairs. This is basically just
--   the 'natPair' parser, now with recursion.
--
--   >>> natTree "((1,2),3) abc"
--   Just (Node (Node (Leaf 1) (Leaf 2)) (Leaf 3)," abc")
--
--   >>> natTree "(1,((100,101),10))"
--   Just (Node (Leaf 1) (Node (Node (Leaf 100) (Leaf 101)) (Leaf 10)),"")
--
natTree :: Parser Tree
natTree s
    | Just (n,s')     <- nat s          = Just (Leaf n, s')
    | Just ((l,r),s') <- pair natTree s = Just (Node l r, s')
    | otherwise                         = Nothing