{-# LANGUAGE ScopedTypeVariables #-}

module Wrench.Translator.Parser.DataSection (
    dataSection,
) where

import Data.List (singleton)
import Relude
import Text.Megaparsec (choice, manyTill, sepBy, try)
import Text.Megaparsec.Char (char, hspace, hspace1, string)
import Text.Megaparsec.Char.Lexer (charLiteral)
import Wrench.Translator.Parser.Misc
import Wrench.Translator.Parser.Types
import Wrench.Translator.Types

dataSection :: (IsWord w) => String -> Parser (Section isa w Text)
dataSection :: forall w isa. IsWord w => String -> Parser (Section isa w Text)
dataSection String
cstart = do
    Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens String
".data" ParsecT Void String Identity (Tokens String)
-> ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
forall a b.
ParsecT Void String Identity a
-> ParsecT Void String Identity b -> ParsecT Void String Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> ParsecT Void String Identity ()
eol' String
cstart
    items <-
        [Maybe (SectionItem (DataToken w Text))]
-> [SectionItem (DataToken w Text)]
forall a. [Maybe a] -> [a]
catMaybes
            ([Maybe (SectionItem (DataToken w Text))]
 -> [SectionItem (DataToken w Text)])
-> ParsecT
     Void String Identity [Maybe (SectionItem (DataToken w Text))]
-> ParsecT Void String Identity [SectionItem (DataToken w Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT
  Void String Identity (Maybe (SectionItem (DataToken w Text)))
-> ParsecT
     Void String Identity [Maybe (SectionItem (DataToken w Text))]
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many
                ( [ParsecT
   Void String Identity (Maybe (SectionItem (DataToken w Text)))]
-> ParsecT
     Void String Identity (Maybe (SectionItem (DataToken w Text)))
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
                    [ ParsecT Void String Identity ()
-> ParsecT
     Void String Identity (Maybe (SectionItem (DataToken w Text)))
forall (m :: * -> *) a b. Monad m => m a -> m (Maybe b)
nothing (ParsecT Void String Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace1 ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
forall a.
ParsecT Void String Identity a
-> ParsecT Void String Identity a -> ParsecT Void String Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> ParsecT Void String Identity ()
eol' String
cstart)
                    , SectionItem (DataToken w Text)
-> Maybe (SectionItem (DataToken w Text))
forall a. a -> Maybe a
Just (SectionItem (DataToken w Text)
 -> Maybe (SectionItem (DataToken w Text)))
-> (DataToken w Text -> SectionItem (DataToken w Text))
-> DataToken w Text
-> Maybe (SectionItem (DataToken w Text))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataToken w Text -> SectionItem (DataToken w Text)
forall i. i -> SectionItem i
Item (DataToken w Text -> Maybe (SectionItem (DataToken w Text)))
-> ParsecT Void String Identity (DataToken w Text)
-> ParsecT
     Void String Identity (Maybe (SectionItem (DataToken w Text)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> ParsecT Void String Identity (DataToken w Text)
forall w. IsWord w => String -> Parser (DataToken w Text)
dataSectionItemM String
cstart
                    , SectionItem (DataToken w Text)
-> Maybe (SectionItem (DataToken w Text))
forall a. a -> Maybe a
Just (SectionItem (DataToken w Text)
 -> Maybe (SectionItem (DataToken w Text)))
-> (Int -> SectionItem (DataToken w Text))
-> Int
-> Maybe (SectionItem (DataToken w Text))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> SectionItem (DataToken w Text)
forall i. Int -> SectionItem i
Org (Int -> Maybe (SectionItem (DataToken w Text)))
-> ParsecT Void String Identity Int
-> ParsecT
     Void String Identity (Maybe (SectionItem (DataToken w Text)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> ParsecT Void String Identity Int
orgDirective String
cstart
                    ]
                )
    return $ Data (sectionOrg items) $ sectionItems items

dataSectionItemM :: (IsWord w) => String -> Parser (DataToken w Text)
dataSectionItemM :: forall w. IsWord w => String -> Parser (DataToken w Text)
dataSectionItemM String
cstart = do
    n <- Parser Text
label
    hspace1
    DataToken n <$> dataValue cstart

dataValue :: forall w. (IsWord w) => String -> Parser (DataValue w)
dataValue :: forall w. IsWord w => String -> Parser (DataValue w)
dataValue String
cstart = [ParsecT Void String Identity (DataValue w)]
-> ParsecT Void String Identity (DataValue w)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [String
-> Parser Word8
-> ([Word8] -> DataValue w)
-> ParsecT Void String Identity (DataValue w)
forall a.
Num a =>
String
-> Parser a
-> ([a] -> DataValue w)
-> ParsecT Void String Identity (DataValue w)
directive String
".byte" Parser Word8
byteLiteral [Word8] -> DataValue w
forall w. [Word8] -> DataValue w
DByte, String
-> Parser w
-> ([w] -> DataValue w)
-> ParsecT Void String Identity (DataValue w)
forall a.
Num a =>
String
-> Parser a
-> ([a] -> DataValue w)
-> ParsecT Void String Identity (DataValue w)
directive String
".word" Parser w
forall w. IsWord w => Parser w
wordLiteral [w] -> DataValue w
forall w. [w] -> DataValue w
DWord]
    where
        directive :: (Num a) => String -> Parser a -> ([a] -> DataValue w) -> Parser (DataValue w)
        directive :: forall a.
Num a =>
String
-> Parser a
-> ([a] -> DataValue w)
-> ParsecT Void String Identity (DataValue w)
directive String
keyword Parser a
item [a] -> DataValue w
wrap = do
            ParsecT Void String Identity (Tokens String)
-> ParsecT Void String Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void String Identity (Tokens String)
 -> ParsecT Void String Identity ())
-> ParsecT Void String Identity (Tokens String)
-> ParsecT Void String Identity ()
forall a b. (a -> b) -> a -> b
$ 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
keyword
            ParsecT Void String Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace1
            values <- Parser a -> Parser [a]
forall a. Num a => Parser a -> Parser [a]
items Parser a
item
            eol' cstart
            return $ wrap values
        items :: (Num a) => Parser a -> Parser [a]
        items :: forall a. Num a => Parser a -> Parser [a]
items Parser a
item = [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[a]] -> [a])
-> ParsecT Void String Identity [[a]]
-> ParsecT Void String Identity [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void String Identity [a]
-> ParsecT Void String Identity ()
-> ParsecT Void String Identity [[a]]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy ([ParsecT Void String Identity [a]]
-> ParsecT Void String Identity [a]
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [ParsecT Void String Identity [a]
forall a. Num a => Parser [a]
stringArray, a -> [a]
forall a. a -> [a]
singleton (a -> [a]) -> Parser a -> ParsecT Void String Identity [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a
item]) (ParsecT Void String Identity () -> ParsecT Void String Identity ()
forall a.
ParsecT Void String Identity a -> ParsecT Void String Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void String Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace ParsecT Void String Identity ()
-> ParsecT Void String Identity (Tokens String)
-> ParsecT Void String Identity (Tokens String)
forall a b.
ParsecT Void String Identity a
-> ParsecT Void String Identity b -> ParsecT Void String Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens String
"," ParsecT Void String Identity (Tokens String)
-> ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
forall a b.
ParsecT Void String Identity a
-> ParsecT Void String Identity b -> ParsecT Void String Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void String Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace))

stringArray :: (Num a) => Parser [a]
stringArray :: forall a. Num a => Parser [a]
stringArray = do
    _ <- ParsecT Void String Identity (Token String)
quote
    strings <- manyTill charLiteral quote
    return $ map (fromIntegral . ord) strings
    where
        quote :: ParsecT Void String Identity (Token String)
quote = Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'\''