{-# language CPP #-}

module SitePipe.Parse
  ( processSource
  ) where

import Control.Monad.Catch hiding (try)
import Text.Megaparsec
import Data.Aeson
import qualified Data.HashMap.Lazy as HM
import Data.Yaml hiding (Parser)
import SitePipe.Types
import Data.ByteString.Char8 (pack)
import Data.Maybe

#if MIN_VERSION_megaparsec(6,0,0)
import Text.Megaparsec.Char
import Data.Void
type Parser = Parsec Void String
#else
import Text.Megaparsec.String
#endif

-- | Parses yaml block from the file if it exists, returning the inner yaml block and the remaining file contents
resourceP :: Parser (String, String)
resourceP :: Parser (String, String)
resourceP = do
  String
yaml <- String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String)
-> ParsecT Void String Identity (Maybe String)
-> ParsecT Void String Identity String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void String Identity String
-> ParsecT Void String Identity (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void String Identity String
yamlParser
  ParsecT Void String Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
  String
rest <- ParsecT Void String Identity Char
-> ParsecT Void String Identity ()
-> ParsecT Void String Identity String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill ParsecT Void String Identity Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle ParsecT Void String Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
  (String, String) -> Parser (String, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
yaml, String
rest)

-- | Given an identifier and file contents runs the yaml parser and returns
-- the contents of the yaml block and the remaining file contents; handling
-- any errors.
splitMeta :: MonadThrow m => String -> String -> m (String, String)
splitMeta :: String -> String -> m (String, String)
splitMeta String
ident String
str =
  case Parser (String, String)
-> String
-> String
-> Either (ParseErrorBundle String Void) (String, String)
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse Parser (String, String)
resourceP String
ident String
str of
    Left ParseErrorBundle String Void
err -> SitePipeError -> m (String, String)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ParseErrorBundle String Void -> SitePipeError
MParseErr ParseErrorBundle String Void
err)
    Right (String, String)
res -> (String, String) -> m (String, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String, String)
res

-- | Parses a yaml metadata block, returning the string which contains the yaml.
yamlParser :: Parser String
yamlParser :: ParsecT Void String Identity String
yamlParser = do
  String
_ <- ParsecT Void String Identity String
yamlSep
  ParsecT Void String Identity Char
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill ParsecT Void String Identity Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle (ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void String Identity String
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
eol ParsecT Void String Identity String
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void String Identity String
yamlSep))
    where
      yamlSep :: ParsecT Void String Identity String
yamlSep = Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
Tokens String
"---" ParsecT Void String Identity String
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void String Identity String
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
eol

-- | Decodes a yaml metadata block into an Aeson object containing the data in the yaml.
decodeMeta :: MonadThrow m => String -> String -> m Value
decodeMeta :: String -> String -> m Value
decodeMeta String
ident String
metaBlock =
  case ByteString -> Either ParseException Value
forall a. FromJSON a => ByteString -> Either ParseException a
decodeEither' (String -> ByteString
pack String
metaBlock) of
    Left ParseException
err -> SitePipeError -> m Value
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (String -> String -> SitePipeError
YamlErr String
ident (ParseException -> String
forall a. Show a => a -> String
show ParseException
err))
    Right (Object Object
metaObj) -> Value -> m Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Object -> Value
Object Object
metaObj)
    Right Value
Null -> Value -> m Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Object -> Value
Object Object
forall k v. HashMap k v
HM.empty)
    Right Value
_ -> SitePipeError -> m Value
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (String -> String -> SitePipeError
YamlErr String
ident String
"Top level yaml must be key-value pairs")

-- | Given a resource identifier and the file contents; parses and returns
-- a 'Value' representing any metadata and the file contents.
processSource :: MonadThrow m => String -> String -> m (Value, String)
processSource :: String -> String -> m (Value, String)
processSource String
ident String
source = do
  (String
metaBlock, String
contents) <- String -> String -> m (String, String)
forall (m :: * -> *).
MonadThrow m =>
String -> String -> m (String, String)
splitMeta String
ident String
source
  Value
metaObj <- String -> String -> m Value
forall (m :: * -> *). MonadThrow m => String -> String -> m Value
decodeMeta String
ident String
metaBlock
  (Value, String) -> m (Value, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Value
metaObj, String
contents)