--  --                                                          ; {{{1
--
--  File        : Koneko/Read.hs
--  Maintainer  : Felix C. Stegerman <flx@obfusk.net>
--  Date        : 2022-02-12
--
--  Copyright   : Copyright (C) 2022  Felix C. Stegerman
--  Version     : v0.0.1
--  License     : GPLv3+
--
--  --                                                          ; }}}1

{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

                                                              --  {{{1
-- |
--
-- >>> :set -XOverloadedStrings
-- >>> x = read "nil #f 42 3.14 \"Hello, World!\" :foo foo"
-- >>> x
-- [nil,#f,42,3.14,"Hello, World!",:foo,foo]
-- >>> map D.typeOf x
-- [#<::nil>,#<::bool>,#<::int>,#<::float>,#<::str>,#<::kwd>,#<::ident>]
--
-- >>> x = read "( 1 2 :foo ) 'foo [ x . 'x 'x ]"
-- >>> x
-- [( 1 2 :foo ),'foo,[ x . 'x 'x ]]
-- >>> map D.typeOf x
-- [#<::list>,#<::quot>,#<::block>]
--
-- ... TODO ...
--

                                                              --  }}}1

module Koneko.Read (read, read') where

import Control.Exception (throw)
import Control.Monad (replicateM)
import Data.Functor
import Data.List (foldl')
import Data.Maybe (fromJust) -- careful!
import Data.Text (Text)
import Prelude hiding (quot, read)
import Text.Megaparsec
import Text.Megaparsec.Char

#if !MIN_VERSION_GLASGOW_HASKELL(8, 8, 1, 0)
import Control.Monad.Fail (MonadFail)
import Data.List (init)
#endif

import qualified Data.Char as C
import qualified Data.Text as T

import Koneko.Data (Identifier, Ident, Block(..), KValue(..))
import Koneko.Misc (Parser, pIdent, pIdent_, pInt, pFloat, lexeme,
                    symbol, sp)

import qualified Koneko.Data as D

-- TODO:
--  * parser labels
--  * test corner cases & failures

read :: Text -> [KValue]
read :: Text -> [KValue]
read = FilePath -> Text -> [KValue]
read' FilePath
"(read)"

read' :: FilePath -> Text -> [KValue]
read' :: FilePath -> Text -> [KValue]
read' FilePath
f Text
code  = (ParseErrorBundle Text Void -> [KValue])
-> ([KValue] -> [KValue])
-> Either (ParseErrorBundle Text Void) [KValue]
-> [KValue]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (KException -> [KValue]
forall a e. Exception e => e -> a
throw (KException -> [KValue])
-> (ParseErrorBundle Text Void -> KException)
-> ParseErrorBundle Text Void
-> [KValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> KException
D.ParseError (FilePath -> KException)
-> (ParseErrorBundle Text Void -> FilePath)
-> ParseErrorBundle Text Void
-> KException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseErrorBundle Text Void -> FilePath
forall s e.
(Stream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> FilePath
errorBundlePretty) [KValue] -> [KValue]
forall a. a -> a
id
              (Either (ParseErrorBundle Text Void) [KValue] -> [KValue])
-> Either (ParseErrorBundle Text Void) [KValue] -> [KValue]
forall a b. (a -> b) -> a -> b
$ Parsec Void Text [KValue]
-> FilePath -> Text -> Either (ParseErrorBundle Text Void) [KValue]
forall e s a.
Parsec e s a -> FilePath -> s -> Either (ParseErrorBundle s e) a
parse Parsec Void Text [KValue]
program FilePath
f Text
code

-- parser: primitives --

nil, bool, int, float, str, kwd :: Parser KValue

bool :: Parser KValue
bool = (KValue
D.false KValue -> ParsecT Void Text Identity Text -> Parser KValue
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"#f") Parser KValue -> Parser KValue -> Parser KValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
       (KValue
D.true  KValue -> ParsecT Void Text Identity Text -> Parser KValue
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"#t")

nil :: Parser KValue
nil   = KValue
D.nil   KValue -> ParsecT Void Text Identity Text -> Parser KValue
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"nil"
int :: Parser KValue
int   = Integer -> KValue
D.int   (Integer -> KValue)
-> ParsecT Void Text Identity Integer -> Parser KValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Integer
pInt
float :: Parser KValue
float = Double -> KValue
D.float (Double -> KValue)
-> ParsecT Void Text Identity Double -> Parser KValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Double
pFloat
str :: Parser KValue
str   = Text -> KValue
D.str   (Text -> KValue)
-> ParsecT Void Text Identity Text -> Parser KValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text
_str
kwd :: Parser KValue
kwd   = Text -> KValue
D.kwd   (Text -> KValue)
-> ParsecT Void Text Identity Text -> Parser KValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
':' ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ParsecT Void Text Identity Text
_str ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity Text
pIdent))

_str :: Parser Text
_str :: ParsecT Void Text Identity Text
_str  = Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'"' ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Text] -> Text
T.concat ([Text] -> Text)
-> ParsecT Void Text Identity [Text]
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity [Text]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill ([ParsecT Void Text Identity Text]
-> ParsecT Void Text Identity Text
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [
          ParsecT Void Text Identity Text
esc, Text -> Int -> ParsecT Void Text Identity Text
hex Text
"\\x" Int
2, Text -> Int -> ParsecT Void Text Identity Text
hex Text
"\\u" Int
4, Text -> Int -> ParsecT Void Text Identity Text
hex Text
"\\U" Int
8, ParsecT Void Text Identity Text
chr
        ]) (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'"')
  where
    esc :: ParsecT Void Text Identity Text
esc     = [ParsecT Void Text Identity Text]
-> ParsecT Void Text Identity Text
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [ Text
t Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Text
Tokens Text
f | (Text
f,Text
t) <- [(Text, Text)]
bsl ] ParsecT Void Text Identity Text
-> FilePath -> ParsecT Void Text Identity Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> FilePath -> m a
<?> FilePath
"escape sequence"
    chr :: ParsecT Void Text Identity Text
chr     = Char -> Text
T.singleton (Char -> Text)
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle ParsecT Void Text Identity Text
-> FilePath -> ParsecT Void Text Identity Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> FilePath -> m a
<?> FilePath
"character"
    bsl :: [(Text, Text)]
bsl     = [Text] -> [Text] -> [(Text, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
D.escapeFrom [Text]
D.escapeTo
    hex :: Text -> Int -> ParsecT Void Text Identity Text
hex Text
p Int
n = Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Text
Tokens Text
p ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> Text
T.singleton (Char -> Text)
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ParsecT Void Text Identity Char
_hex Int
n

_hex :: Int -> Parser Char
_hex :: Int -> ParsecT Void Text Identity Char
_hex Int
n = Int -> Char
C.chr (Int -> Char) -> (FilePath -> Int) -> FilePath -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Char -> Int) -> Int -> FilePath -> Int
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Int
a Char
c -> Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
C.digitToInt Char
c) Int
0 (FilePath -> Char)
-> ParsecT Void Text Identity FilePath
-> ParsecT Void Text Identity Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
         Int
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity FilePath
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n ((Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
C.isHexDigit ParsecT Void Text Identity Char
-> FilePath -> ParsecT Void Text Identity Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> FilePath -> m a
<?> FilePath
"hex digit")

-- TODO: rx

-- parser: values --

prim, list, ident, quot, block :: Parser KValue

prim :: Parser KValue
prim = [Parser KValue] -> Parser KValue
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([Parser KValue] -> Parser KValue)
-> [Parser KValue] -> Parser KValue
forall a b. (a -> b) -> a -> b
$ (Parser KValue -> Parser KValue)
-> [Parser KValue] -> [Parser KValue]
forall a b. (a -> b) -> [a] -> [b]
map (Parser KValue -> Parser KValue
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser KValue -> Parser KValue)
-> (Parser KValue -> Parser KValue)
-> Parser KValue
-> Parser KValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser KValue -> Parser KValue
forall a. Parser a -> Parser a
lexeme) [Parser KValue
nil, Parser KValue
int, Parser KValue
float] [Parser KValue] -> [Parser KValue] -> [Parser KValue]
forall a. [a] -> [a] -> [a]
++
                (Parser KValue -> Parser KValue)
-> [Parser KValue] -> [Parser KValue]
forall a b. (a -> b) -> [a] -> [b]
map        Parser KValue -> Parser KValue
forall a. Parser a -> Parser a
lexeme  [Parser KValue
bool, Parser KValue
str, Parser KValue
kwd]

list :: Parser KValue
list = Parser KValue -> Parser KValue
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser KValue -> Parser KValue) -> Parser KValue -> Parser KValue
forall a b. (a -> b) -> a -> b
$ [KValue] -> KValue
forall a. ToVal a => [a] -> KValue
D.list ([KValue] -> KValue) -> Parsec Void Text [KValue] -> Parser KValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parsec Void Text [KValue]
forall a. ParsecT Void Text Identity [a]
a Parsec Void Text [KValue]
-> Parsec Void Text [KValue] -> Parsec Void Text [KValue]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parsec Void Text [KValue]
b)
  where
    a :: ParsecT Void Text Identity [a]
a = [] [a]
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity [a]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Void Text Identity Text
symbol Text
"()"
    b :: Parsec Void Text [KValue]
b = Text -> ParsecT Void Text Identity Text
symbol Text
"(" ParsecT Void Text Identity Text
-> Parsec Void Text [KValue] -> Parsec Void Text [KValue]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Text -> Parsec Void Text [KValue]
forall a. Parser a -> Parsec Void Text [KValue]
manyValuesTill (Text -> ParsecT Void Text Identity Text
symbol Text
")")

-- | NB: also matches float and int (but they match earlier)
ident :: Parser KValue
ident = Ident -> KValue
KIdent (Ident -> KValue)
-> ParsecT Void Text Identity Ident -> Parser KValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Ident
ident_
quot :: Parser KValue
quot  = Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'\'' ParsecT Void Text Identity Char -> Parser KValue -> Parser KValue
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ident -> KValue
KQuot (Ident -> KValue)
-> ParsecT Void Text Identity Ident -> Parser KValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Ident
ident_
block :: Parser KValue
block = Block -> KValue
KBlock (Block -> KValue)
-> ParsecT Void Text Identity Block -> Parser KValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Block
block_

-- TODO
block_ :: Parser Block
block_ :: ParsecT Void Text Identity Block
block_ = ParsecT Void Text Identity Block
-> ParsecT Void Text Identity Block
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity Block
 -> ParsecT Void Text Identity Block)
-> ParsecT Void Text Identity Block
-> ParsecT Void Text Identity Block
forall a b. (a -> b) -> a -> b
$ do
  Text
_       <- Text -> ParsecT Void Text Identity Text
symbol Text
"["
  [Ident]
params  <- Maybe [Ident] -> [Ident]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Maybe [Ident] -> [Ident])
-> ParsecT Void Text Identity (Maybe [Ident])
-> ParsecT Void Text Identity [Ident]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Void Text Identity [Ident]
-> ParsecT Void Text Identity (Maybe [Ident])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void Text Identity [Ident]
 -> ParsecT Void Text Identity (Maybe [Ident]))
-> ParsecT Void Text Identity [Ident]
-> ParsecT Void Text Identity (Maybe [Ident])
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity [Ident]
-> ParsecT Void Text Identity [Ident]
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity [Ident]
 -> ParsecT Void Text Identity [Ident])
-> ParsecT Void Text Identity [Ident]
-> ParsecT Void Text Identity [Ident]
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity Ident
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity [Ident]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill ParsecT Void Text Identity Ident
ident_ (ParsecT Void Text Identity Text
 -> ParsecT Void Text Identity [Ident])
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity [Ident]
forall a b. (a -> b) -> a -> b
$ Text -> ParsecT Void Text Identity Text
symbol Text
".")
  [KValue]
code    <- ParsecT Void Text Identity Text -> Parsec Void Text [KValue]
forall a. Parser a -> Parsec Void Text [KValue]
manyValuesTill (ParsecT Void Text Identity Text -> Parsec Void Text [KValue])
-> ParsecT Void Text Identity Text -> Parsec Void Text [KValue]
forall a b. (a -> b) -> a -> b
$ Text -> ParsecT Void Text Identity Text
symbol Text
"]"
  Block -> ParsecT Void Text Identity Block
forall (m :: * -> *) a. Monad m => a -> m a
return (Block -> ParsecT Void Text Identity Block)
-> Block -> ParsecT Void Text Identity Block
forall a b. (a -> b) -> a -> b
$ [Ident] -> [KValue] -> Maybe Scope -> Block
Block [Ident]
params [KValue]
code Maybe Scope
forall a. Maybe a
Nothing

-- parser: sugar --

ellipsis, modid, qmodid, qhole, dhole, qdig, ddig, qdot, qbang, dot,
  bang, dict, key, apply, applyDict, idblk :: Parser [KValue]

ellipsis :: Parsec Void Text [KValue]
ellipsis = [Text -> KValue
_IDENT Text
"ellipsis"] [KValue]
-> ParsecT Void Text Identity Text -> Parsec Void Text [KValue]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Void Text Identity Text
symbol Text
"..."

modid :: Parsec Void Text [KValue]
modid = Parsec Void Text [KValue] -> Parsec Void Text [KValue]
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parsec Void Text [KValue] -> Parsec Void Text [KValue])
-> Parsec Void Text [KValue] -> Parsec Void Text [KValue]
forall a b. (a -> b) -> a -> b
$ do
  KValue
m <- Text -> KValue
D.kwd (Text -> KValue) -> (Ident -> Text) -> Ident -> KValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> Text
D.unIdent (Ident -> KValue)
-> ParsecT Void Text Identity Ident -> Parser KValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Ident
identNL Parser KValue -> ParsecT Void Text Identity Char -> Parser KValue
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'.'
  KValue
i <- Text -> KValue
D.kwd (Text -> KValue) -> (Ident -> Text) -> Ident -> KValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> Text
D.unIdent (Ident -> KValue)
-> ParsecT Void Text Identity Ident -> Parser KValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Ident
ident_
  [KValue] -> Parsec Void Text [KValue]
forall (m :: * -> *) a. Monad m => a -> m a
return [KValue
i, KValue
m, Text -> KValue
_IDENT Text
"module-get", Text -> KValue
_IDENT Text
"call"]

qmodid :: Parsec Void Text [KValue]
qmodid = Parsec Void Text [KValue] -> Parsec Void Text [KValue]
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parsec Void Text [KValue] -> Parsec Void Text [KValue])
-> Parsec Void Text [KValue] -> Parsec Void Text [KValue]
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'\'' ParsecT Void Text Identity Char
-> Parsec Void Text [KValue] -> Parsec Void Text [KValue]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [KValue] -> [KValue]
forall a. [a] -> [a]
init ([KValue] -> [KValue])
-> Parsec Void Text [KValue] -> Parsec Void Text [KValue]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parsec Void Text [KValue]
modid                    -- safe!

-- TODO
qhole :: Parsec Void Text [KValue]
qhole = Parsec Void Text [KValue] -> Parsec Void Text [KValue]
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parsec Void Text [KValue] -> Parsec Void Text [KValue])
-> Parsec Void Text [KValue] -> Parsec Void Text [KValue]
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'\'' ParsecT Void Text Identity Char
-> Parsec Void Text [KValue] -> Parsec Void Text [KValue]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>                         Block -> [KValue]
_wrap  (Block -> [KValue])
-> ParsecT Void Text Identity Block -> Parsec Void Text [KValue]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Block
block_
dhole :: Parsec Void Text [KValue]
dhole = Parsec Void Text [KValue] -> Parsec Void Text [KValue]
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parsec Void Text [KValue] -> Parsec Void Text [KValue])
-> Parsec Void Text [KValue] -> Parsec Void Text [KValue]
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'.'  ParsecT Void Text Identity Char
-> Parsec Void Text [KValue] -> Parsec Void Text [KValue]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (([KValue] -> [KValue] -> [KValue]
forall a. [a] -> [a] -> [a]
++ [Text -> KValue
_IDENT Text
"call"]) ([KValue] -> [KValue]) -> (Block -> [KValue]) -> Block -> [KValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> [KValue]
_wrap) (Block -> [KValue])
-> ParsecT Void Text Identity Block -> Parsec Void Text [KValue]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Block
block_

qdig :: Parsec Void Text [KValue]
qdig  = Parsec Void Text [KValue] -> Parsec Void Text [KValue]
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parsec Void Text [KValue] -> Parsec Void Text [KValue])
-> Parsec Void Text [KValue] -> Parsec Void Text [KValue]
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'\'' ParsecT Void Text Identity Char
-> Parsec Void Text [KValue] -> Parsec Void Text [KValue]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Text -> KValue) -> Parsec Void Text [KValue]
_dig (Ident -> KValue
KQuot (Ident -> KValue) -> (Text -> Ident) -> Text -> KValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Ident
_IDENT')             -- safe!
ddig :: Parsec Void Text [KValue]
ddig  = Parsec Void Text [KValue] -> Parsec Void Text [KValue]
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parsec Void Text [KValue] -> Parsec Void Text [KValue])
-> Parsec Void Text [KValue] -> Parsec Void Text [KValue]
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'.'  ParsecT Void Text Identity Char
-> Parsec Void Text [KValue] -> Parsec Void Text [KValue]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Text -> KValue) -> Parsec Void Text [KValue]
_dig          Text -> KValue
_IDENT               -- safe!

qdot :: Parsec Void Text [KValue]
qdot  = Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string    Tokens Text
"'."  ParsecT Void Text Identity Text
-> Parsec Void Text [KValue] -> Parsec Void Text [KValue]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [KValue] -> [KValue]
_blk ([KValue] -> [KValue])
-> Parsec Void Text [KValue] -> Parsec Void Text [KValue]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [KValue] -> Parsec Void Text [KValue]
_isc []
qbang :: Parsec Void Text [KValue]
qbang = Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string    Tokens Text
"'!"  ParsecT Void Text Identity Text
-> Parsec Void Text [KValue] -> Parsec Void Text [KValue]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [KValue] -> [KValue]
_blk ([KValue] -> [KValue])
-> Parsec Void Text [KValue] -> Parsec Void Text [KValue]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [KValue] -> Parsec Void Text [KValue]
_isc [Text -> KValue
_IDENT Text
"call"]

dot :: Parsec Void Text [KValue]
dot   = Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char       Char
Token Text
'.'  ParsecT Void Text Identity Char
-> Parsec Void Text [KValue] -> Parsec Void Text [KValue]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>          [KValue] -> Parsec Void Text [KValue]
_isc []
bang :: Parsec Void Text [KValue]
bang  = Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char       Char
Token Text
'!'  ParsecT Void Text Identity Char
-> Parsec Void Text [KValue] -> Parsec Void Text [KValue]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>          [KValue] -> Parsec Void Text [KValue]
_isc [Text -> KValue
_IDENT Text
"call"]

dict :: Parsec Void Text [KValue]
dict  = Parsec Void Text [KValue] -> Parsec Void Text [KValue]
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parsec Void Text [KValue] -> Parsec Void Text [KValue])
-> Parsec Void Text [KValue] -> Parsec Void Text [KValue]
forall a b. (a -> b) -> a -> b
$ ([KValue] -> [KValue])
-> Parsec Void Text [KValue] -> Parsec Void Text [KValue]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((KValue -> [KValue] -> [KValue]
forall a. a -> [a] -> [a]
:[Text -> KValue
_IDENT Text
"dict"]) (KValue -> [KValue])
-> ([KValue] -> KValue) -> [KValue] -> [KValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [KValue] -> KValue
forall a. ToVal a => [a] -> KValue
D.list)
      (Parsec Void Text [KValue] -> Parsec Void Text [KValue])
-> Parsec Void Text [KValue] -> Parsec Void Text [KValue]
forall a b. (a -> b) -> a -> b
$ Text -> ParsecT Void Text Identity Text
symbol Text
"{" ParsecT Void Text Identity Text
-> Parsec Void Text [KValue] -> Parsec Void Text [KValue]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Text -> Parsec Void Text [KValue]
forall a. Parser a -> Parsec Void Text [KValue]
manyValuesTill (Text -> ParsecT Void Text Identity Text
symbol Text
"}")

key :: Parsec Void Text [KValue]
key = Parsec Void Text [KValue] -> Parsec Void Text [KValue]
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parsec Void Text [KValue] -> Parsec Void Text [KValue])
-> Parsec Void Text [KValue] -> Parsec Void Text [KValue]
forall a b. (a -> b) -> a -> b
$ do
  Text
k <- Char -> ParsecT Void Text Identity Text
sugarIdent Char
':'; [KValue]
v <- Parsec Void Text [KValue]
value_
  [KValue] -> Parsec Void Text [KValue]
forall (m :: * -> *) a. Monad m => a -> m a
return ([KValue] -> Parsec Void Text [KValue])
-> [KValue] -> Parsec Void Text [KValue]
forall a b. (a -> b) -> a -> b
$ [Text -> KValue
D.kwd Text
k] [KValue] -> [KValue] -> [KValue]
forall a. [a] -> [a] -> [a]
++ [KValue]
v [KValue] -> [KValue] -> [KValue]
forall a. [a] -> [a] -> [a]
++ [Text -> KValue
_IDENT Text
"=>"]

apply :: Parsec Void Text [KValue]
apply = Parsec Void Text [KValue] -> Parsec Void Text [KValue]
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parsec Void Text [KValue] -> Parsec Void Text [KValue])
-> Parsec Void Text [KValue] -> Parsec Void Text [KValue]
forall a b. (a -> b) -> a -> b
$ do
  (KValue
q, KValue
l) <- Char -> Text -> Parser (KValue, KValue)
_ap Char
'(' Text
")"; [KValue] -> Parsec Void Text [KValue]
forall (m :: * -> *) a. Monad m => a -> m a
return [KValue
l, KValue
q, Text -> KValue
_IDENT Text
"apply"]

applyDict :: Parsec Void Text [KValue]
applyDict = Parsec Void Text [KValue] -> Parsec Void Text [KValue]
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parsec Void Text [KValue] -> Parsec Void Text [KValue])
-> Parsec Void Text [KValue] -> Parsec Void Text [KValue]
forall a b. (a -> b) -> a -> b
$ do
  (KValue
q, KValue
l) <- Char -> Text -> Parser (KValue, KValue)
_ap Char
'{' Text
"}"
  [KValue] -> Parsec Void Text [KValue]
forall (m :: * -> *) a. Monad m => a -> m a
return [KValue
l, Text -> KValue
_IDENT Text
"dict", KValue
q, Text -> KValue
_IDENT Text
"apply-dict"]

idblk :: Parsec Void Text [KValue]
idblk = Parsec Void Text [KValue] -> Parsec Void Text [KValue]
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parsec Void Text [KValue] -> Parsec Void Text [KValue])
-> Parsec Void Text [KValue] -> Parsec Void Text [KValue]
forall a b. (a -> b) -> a -> b
$ do Ident
i <- ParsecT Void Text Identity Ident
identNL; Block
b <- ParsecT Void Text Identity Block
block_; [KValue] -> Parsec Void Text [KValue]
forall (m :: * -> *) a. Monad m => a -> m a
return [Block -> KValue
KBlock Block
b, Ident -> KValue
KIdent Ident
i]

_wrap :: Block -> [KValue]
_wrap :: Block -> [KValue]
_wrap Block
b = [[Ident] -> [KValue] -> Maybe Scope -> KValue
D.block (Block -> [Ident]
D.digitParams Block
b) [Block -> KValue
KBlock Block
b] Maybe Scope
forall a. Maybe a
Nothing]

_dig :: (Text -> KValue) -> Parser [KValue]
_dig :: (Text -> KValue) -> Parsec Void Text [KValue]
_dig Text -> KValue
f  = (Char -> [KValue])
-> ParsecT Void Text Identity Char -> Parsec Void Text [KValue]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((KValue -> [KValue] -> [KValue]
forall a. a -> [a] -> [a]
:[]) (KValue -> [KValue]) -> (Char -> KValue) -> Char -> [KValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> KValue
f (Text -> KValue) -> (Char -> Text) -> Char -> KValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
T.singleton)
        (ParsecT Void Text Identity Char -> Parsec Void Text [KValue])
-> ParsecT Void Text Identity Char -> Parsec Void Text [KValue]
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity Char -> ParsecT Void Text Identity Char
forall a. Parser a -> Parser a
lexeme (ParsecT Void Text Identity Char
 -> ParsecT Void Text Identity Char)
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall a b. (a -> b) -> a -> b
$ (Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy (Char -> FilePath -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'1'..Char
'9'])

_blk :: [KValue] -> [KValue]
_blk :: [KValue] -> [KValue]
_blk [KValue]
code = [[Ident] -> [KValue] -> Maybe Scope -> KValue
D.block [] [KValue]
code Maybe Scope
forall a. Maybe a
Nothing]

_isc :: [KValue] -> Parser [KValue]
_isc :: [KValue] -> Parsec Void Text [KValue]
_isc [KValue]
vs = Ident -> [KValue]
f (Ident -> [KValue])
-> ParsecT Void Text Identity Ident -> Parsec Void Text [KValue]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Ident
ident_
  where
    f :: Ident -> [KValue]
f Ident
i = [Text -> KValue
D.kwd (Text -> KValue) -> Text -> KValue
forall a b. (a -> b) -> a -> b
$ Ident -> Text
D.unIdent Ident
i, Text -> KValue
_IDENT Text
"swap", Text -> KValue
_IDENT Text
"call"] [KValue] -> [KValue] -> [KValue]
forall a. [a] -> [a] -> [a]
++ [KValue]
vs

_ap :: Char -> Text -> Parser (KValue, KValue)
_ap :: Char -> Text -> Parser (KValue, KValue)
_ap Char
op Text
cl = do
  Text
i <- Char -> ParsecT Void Text Identity Text
sugarIdent Char
op; [KValue]
vs <- ParsecT Void Text Identity Text -> Parsec Void Text [KValue]
forall a. Parser a -> Parsec Void Text [KValue]
manyValuesTill (ParsecT Void Text Identity Text -> Parsec Void Text [KValue])
-> ParsecT Void Text Identity Text -> Parsec Void Text [KValue]
forall a b. (a -> b) -> a -> b
$ Text -> ParsecT Void Text Identity Text
symbol Text
cl
  KValue
q <- Ident -> KValue
KQuot (Ident -> KValue)
-> ParsecT Void Text Identity Ident -> Parser KValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ParsecT Void Text Identity Ident
forall (m :: * -> *). MonadFail m => Text -> m Ident
identOrFail Text
i
  (KValue, KValue) -> Parser (KValue, KValue)
forall (m :: * -> *) a. Monad m => a -> m a
return (KValue
q, [KValue] -> KValue
forall a. ToVal a => [a] -> KValue
D.list [KValue]
vs)

sugar :: Parser [KValue]
sugar :: Parsec Void Text [KValue]
sugar = [Parsec Void Text [KValue]] -> Parsec Void Text [KValue]
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [
    Parsec Void Text [KValue]
ellipsis, Parsec Void Text [KValue]
modid, Parsec Void Text [KValue]
qmodid, Parsec Void Text [KValue]
qhole, Parsec Void Text [KValue]
dhole, Parsec Void Text [KValue]
qdig, Parsec Void Text [KValue]
ddig, Parsec Void Text [KValue]
qdot, Parsec Void Text [KValue]
qbang,
    Parsec Void Text [KValue]
dot, Parsec Void Text [KValue]
bang, Parsec Void Text [KValue]
dict, Parsec Void Text [KValue]
key, Parsec Void Text [KValue]
apply, Parsec Void Text [KValue]
applyDict, Parsec Void Text [KValue]
idblk
  ]

-- parser: multiple values & program --

-- | NB: match ident last
oneValue :: Parser KValue
oneValue :: Parser KValue
oneValue = [Parser KValue] -> Parser KValue
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [Parser KValue
prim, Parser KValue
list, Parser KValue
quot, Parser KValue
block, Parser KValue
ident]

value_, manyValues, program :: Parser [KValue]

value_ :: Parsec Void Text [KValue]
value_      = Parsec Void Text [KValue]
sugar Parsec Void Text [KValue]
-> Parsec Void Text [KValue] -> Parsec Void Text [KValue]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (KValue -> [KValue] -> [KValue]
forall a. a -> [a] -> [a]
:[]) (KValue -> [KValue]) -> Parser KValue -> Parsec Void Text [KValue]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser KValue
oneValue
manyValues :: Parsec Void Text [KValue]
manyValues  = [[KValue]] -> [KValue]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[KValue]] -> [KValue])
-> ParsecT Void Text Identity [[KValue]]
-> Parsec Void Text [KValue]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parsec Void Text [KValue] -> ParsecT Void Text Identity [[KValue]]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many Parsec Void Text [KValue]
value_
program :: Parsec Void Text [KValue]
program     = ParsecT Void Text Identity ()
-> ParsecT Void Text Identity (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void Text Identity ()
shebang ParsecT Void Text Identity (Maybe ())
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity ()
sp ParsecT Void Text Identity ()
-> Parsec Void Text [KValue] -> Parsec Void Text [KValue]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec Void Text [KValue]
manyValues Parsec Void Text [KValue]
-> ParsecT Void Text Identity () -> Parsec Void Text [KValue]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof

manyValuesTill :: Parser a -> Parser [KValue]
manyValuesTill :: Parser a -> Parsec Void Text [KValue]
manyValuesTill Parser a
end = [[KValue]] -> [KValue]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[KValue]] -> [KValue])
-> ParsecT Void Text Identity [[KValue]]
-> Parsec Void Text [KValue]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parsec Void Text [KValue]
-> Parser a -> ParsecT Void Text Identity [[KValue]]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill Parsec Void Text [KValue]
value_ Parser a
end

shebang :: Parser ()
shebang :: ParsecT Void Text Identity ()
shebang = ParsecT Void Text Identity Char -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity Char -> ParsecT Void Text Identity ())
-> ParsecT Void Text Identity Char -> ParsecT Void Text Identity ()
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"#!" ParsecT Void Text Identity Text
-> ParsecT Void Text Identity FilePath
-> ParsecT Void Text Identity FilePath
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity FilePath
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ((Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n')) ParsecT Void Text Identity FilePath
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline

-- parser: miscellaneous --

ident_, identNL :: Parser Ident
ident_ :: ParsecT Void Text Identity Ident
ident_  = ParsecT Void Text Identity Ident
-> ParsecT Void Text Identity Ident
forall a. Parser a -> Parser a
lexeme (ParsecT Void Text Identity Ident
 -> ParsecT Void Text Identity Ident)
-> ParsecT Void Text Identity Ident
-> ParsecT Void Text Identity Ident
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity Ident
identNL
identNL :: ParsecT Void Text Identity Ident
identNL = ParsecT Void Text Identity Text
pIdent ParsecT Void Text Identity Text
-> (Text -> ParsecT Void Text Identity Ident)
-> ParsecT Void Text Identity Ident
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> ParsecT Void Text Identity Ident
forall (m :: * -> *). MonadFail m => Text -> m Ident
identOrFail

-- TODO
sugarIdent :: Char -> Parser Identifier
sugarIdent :: Char -> ParsecT Void Text Identity Text
sugarIdent Char
c = ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity Text
 -> ParsecT Void Text Identity Text)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a b. (a -> b) -> a -> b
$ do
  Text
i <- ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall a. Parser a -> Parser a
lexeme (ParsecT Void Text Identity Text
 -> ParsecT Void Text Identity Text)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a b. (a -> b) -> a -> b
$ Maybe Char -> ParsecT Void Text Identity Text
pIdent_ (Maybe Char -> ParsecT Void Text Identity Text)
-> Maybe Char -> ParsecT Void Text Identity Text
forall a b. (a -> b) -> a -> b
$ Char -> Maybe Char
forall a. a -> Maybe a
Just Char
c
  if Text -> Char
T.last Text
i Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
c then FilePath -> ParsecT Void Text Identity Text
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"TODO" else Text -> ParsecT Void Text Identity Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ParsecT Void Text Identity Text)
-> Text -> ParsecT Void Text Identity Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.init Text
i    -- safe!

-- miscellaneous --

-- UNSAFE!
_IDENT  :: Text -> KValue
_IDENT' :: Text -> Ident
_IDENT :: Text -> KValue
_IDENT  = Ident -> KValue
KIdent (Ident -> KValue) -> (Text -> Ident) -> Text -> KValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Ident
_IDENT'
_IDENT' :: Text -> Ident
_IDENT' = Maybe Ident -> Ident
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Ident -> Ident) -> (Text -> Maybe Ident) -> Text -> Ident
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Ident
D.ident (Text -> Maybe Ident) -> (Text -> Text) -> Text -> Maybe Ident
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
D.underscored

identOrFail :: MonadFail m => Identifier -> m Ident
identOrFail :: Text -> m Ident
identOrFail = m Ident -> (Ident -> m Ident) -> Maybe Ident -> m Ident
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath -> m Ident
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"invalid ident") Ident -> m Ident
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Ident -> m Ident)
-> (Text -> Maybe Ident) -> Text -> m Ident
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Ident
D.ident

-- vim: set tw=70 sw=2 sts=2 et fdm=marker :