Parser.hs

module Hydrogen.Data.Parser where

import Hydrogen.Prelude hiding (left, many, right, (<|>))
import Hydrogen.Data.Types

import Hydrogen.Syntax.Types

import Hydrogen.Parsing

import qualified Data.Map as Map


parseData :: Parser POPs Data
parseData = either mkError Right . runIdentity . runParserT items () ""

items :: Monad m => ParsecT POPs u m Data
items = do

    let left  = Left <$> (keyValue <|> node)
        right = Right <$> value

    (keyValues, values) <- partitionEithers <$> sepBy (left <|> right) separator
    
    return (DNode (Map.fromList keyValues) values)

value :: Monad m => ParsecT POPs u m Data
value = val <|> link <|> (DConstant <$> matches "^[A-Z](_?[A-Z0-9])*$")
  where
      val = sourceToken $ \case
        Token AposString "" xs -> Just (DString xs)
        Token QuotString "" xs -> Just (DString xs)
        Token SomethingT "" xs -> firstJust [
            fmap DNumber . tryReadDecimal
          , fmap DNumber . tryReadRational
          , fmap DNumber . tryReadHex
          , fmap DBool . tryReadBool
          , fmap DVersion . tryReadVersion
          , fmap DUUID . tryReadUUID
          , fmap DDateTime . join . tryReadDateTime
          , fmap DDate . join . tryReadDate
          , fmap DTime . join . tryReadTime
          ] xs
        _ -> Nothing

link :: (Monad m) => ParsecT POPs u m Data
link = DLink <$> matches url
  where
    url = concat [
        "^[a-z](-?[a-z0-9])*(\\.[a-z](-?[a-z0-9])*)+"
      , "(/([a-z0-9_.=-]|%[a-fA-F0-9]{2}|%u[a-fA-F0-9]{4})*)+"
      , "(\\?([a-z0-9_.=-]|%[a-fA-F0-9]{2}|%u[a-fA-F0-9]{4})*)?$"
      ]

keyValue :: Monad m => ParsecT [(SourcePos, POP)] u m (String, Data)
keyValue = liftA2 (,) (init <$> matches "^[a-z](\\-?[a-z0-9])*:$") value

node :: Monad m => ParsecT [(SourcePos, POP)] u m (String, Data)
node = sourceToken $ \case
    Block Mustache key pops | not (null key) -> (key ,) <$> dataNode pops
    _ -> Nothing
  where
    dataNode :: POPs -> Maybe Data
    dataNode = either (const Nothing) Just . runIdentity . runParserT items () "-"

separator :: Monad m => ParsecT POPs u m String
separator = equals ";;" <|> equals ";"

noSeparator :: Monad m => ParsecT POPs u m POP
noSeparator = sourceToken $ \case
    Token SomethingT "" val | elem val [";;", ";"] -> Nothing
    t -> Just t

equals, matches :: Monad m => String -> ParsecT POPs u m String

equals string = sourceToken $ \case
    Token SomethingT "" val | val == string -> Just val
    _ -> Nothing

matches regex = sourceToken $ \case
    Token SomethingT "" val | val =~ regex -> Just val
    _ -> Nothing