{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FlexibleInstances #-}
{-# OPTIONS_GHC -fno-warn-missing-fields #-}
module Text.Heredoc ( heredoc
                    , heredocFile
                    ) where

import Control.Applicative ((<$>), (<*>))
import Control.Arrow ((***))
import Data.Function (on)
import Data.List (intercalate)
import Data.Monoid ((<>))
import Text.ParserCombinators.Parsec hiding (Line)
import Text.ParserCombinators.Parsec.Error
import Language.Haskell.TH
import Language.Haskell.TH.Quote

heredoc :: QuasiQuoter
heredoc :: QuasiQuoter
heredoc = QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
QuasiQuoter { quoteExp :: String -> Q Exp
quoteExp = String -> Q Exp
heredocFromString }

heredocFile :: FilePath -> Q Exp
heredocFile :: String -> Q Exp
heredocFile String
fp = do
  String
content <- IO String -> Q String
forall a. IO a -> Q a
runIO (IO String -> Q String) -> IO String -> Q String
forall a b. (a -> b) -> a -> b
$ String -> IO String
readFile String
fp
  String -> Q Exp
heredocFromString String
content

heredocFromString :: String -> Q Exp
heredocFromString :: String -> Q Exp
heredocFromString
    = (ParseError -> Q Exp)
-> ([(Indent, Line)] -> Q Exp)
-> Either ParseError [(Indent, Line)]
-> Q Exp
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ParseError -> Q Exp
err ([(Indent, Line)] -> Q Exp
forall a. ToQExp a => [a] -> Q Exp
concatToQExp ([(Indent, Line)] -> Q Exp)
-> ([(Indent, Line)] -> [(Indent, Line)])
-> [(Indent, Line)]
-> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Indent, Line)] -> [(Indent, Line)]
arrange) (Either ParseError [(Indent, Line)] -> Q Exp)
-> (String -> Either ParseError [(Indent, Line)])
-> String
-> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec String () [(Indent, Line)]
-> String -> String -> Either ParseError [(Indent, Line)]
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parsec String () [(Indent, Line)]
doc String
"heredoc"
    where
      err :: ParseError -> Q Exp
err = Maybe (Q Exp) -> Q Exp -> Maybe (Q Exp) -> Q Exp
infixE (Maybe (Q Exp) -> Q Exp -> Maybe (Q Exp) -> Q Exp)
-> (ParseError -> Maybe (Q Exp))
-> ParseError
-> Q Exp
-> Maybe (Q Exp)
-> Q Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just (Q Exp -> Maybe (Q Exp))
-> (ParseError -> Q Exp) -> ParseError -> Maybe (Q Exp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> Q Exp
pos (ParseError -> Q Exp -> Maybe (Q Exp) -> Q Exp)
-> (ParseError -> Q Exp) -> ParseError -> Maybe (Q Exp) -> Q Exp
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Q Exp -> ParseError -> Q Exp
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> Q Exp
varE '(<>)) (ParseError -> Maybe (Q Exp) -> Q Exp)
-> (ParseError -> Maybe (Q Exp)) -> ParseError -> Q Exp
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just (Q Exp -> Maybe (Q Exp))
-> (ParseError -> Q Exp) -> ParseError -> Maybe (Q Exp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> Q Exp
msg
      pos :: ParseError -> Q Exp
pos = Lit -> Q Exp
litE (Lit -> Q Exp) -> (ParseError -> Lit) -> ParseError -> Q Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Lit
stringL (String -> Lit) -> (ParseError -> String) -> ParseError -> Lit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SourcePos -> String
forall a. Show a => a -> String
show (SourcePos -> String)
-> (ParseError -> SourcePos) -> ParseError -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> SourcePos
errorPos)
      msg :: ParseError -> Q Exp
msg = Lit -> Q Exp
litE (Lit -> Q Exp) -> (ParseError -> Lit) -> ParseError -> Q Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Lit
stringL (String -> Lit) -> (ParseError -> String) -> ParseError -> Lit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Message -> String) -> [Message] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Message -> String
messageString ([Message] -> String)
-> (ParseError -> [Message]) -> ParseError -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> [Message]
errorMessages)

type Indent = Int
type Line' = (Indent, Line)
type ChildBlock = [Line']
type AltFlag = Bool

data InLine = Raw String
            | Quoted [Expr]
              deriving Indent -> InLine -> ShowS
[InLine] -> ShowS
InLine -> String
(Indent -> InLine -> ShowS)
-> (InLine -> String) -> ([InLine] -> ShowS) -> Show InLine
forall a.
(Indent -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InLine] -> ShowS
$cshowList :: [InLine] -> ShowS
show :: InLine -> String
$cshow :: InLine -> String
showsPrec :: Indent -> InLine -> ShowS
$cshowsPrec :: Indent -> InLine -> ShowS
Show

data Line = CtrlForall [Expr] [Expr] ChildBlock
          | CtrlMaybe AltFlag [Expr] [Expr] ChildBlock ChildBlock
          | CtrlNothing
          | CtrlIf AltFlag [Expr] ChildBlock ChildBlock
          | CtrlElse
          | CtrlCase [Expr] [([Expr], ChildBlock)]
          | CtrlOf [Expr]
          | CtrlLet [Expr] [Expr] ChildBlock
          | Normal [InLine]
            deriving Indent -> Line -> ShowS
[Line] -> ShowS
Line -> String
(Indent -> Line -> ShowS)
-> (Line -> String) -> ([Line] -> ShowS) -> Show Line
forall a.
(Indent -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Line] -> ShowS
$cshowList :: [Line] -> ShowS
show :: Line -> String
$cshow :: Line -> String
showsPrec :: Indent -> Line -> ShowS
$cshowsPrec :: Indent -> Line -> ShowS
Show

data Expr = S String
          | I Integer
          | W
          | A String Expr
          | V String
          | V' String
          | C String
          | O String
          | O' String
          | E [Expr]
          | T [[Expr]]
          | L [[Expr]]
          | N
            deriving Indent -> Expr -> ShowS
[Expr] -> ShowS
Expr -> String
(Indent -> Expr -> ShowS)
-> (Expr -> String) -> ([Expr] -> ShowS) -> Show Expr
forall a.
(Indent -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Expr] -> ShowS
$cshowList :: [Expr] -> ShowS
show :: Expr -> String
$cshow :: Expr -> String
showsPrec :: Indent -> Expr -> ShowS
$cshowsPrec :: Indent -> Expr -> ShowS
Show

eol :: Parser String
eol :: Parser String
eol =     Parser String -> Parser String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> Parser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\n\r")
      Parser String -> Parser String -> Parser String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser String -> Parser String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> Parser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\r\n")
      Parser String -> Parser String -> Parser String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> Parser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\n"
      Parser String -> Parser String -> Parser String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> Parser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\r"
      Parser String -> String -> Parser String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> ShowS
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"end of line"

spaceTabs :: Parser String
spaceTabs :: Parser String
spaceTabs = ParsecT String () Identity Char -> Parser String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
" \t")

doc :: Parser [(Indent, Line)]
doc :: Parsec String () [(Indent, Line)]
doc = Parser (Indent, Line)
line Parser (Indent, Line)
-> Parser String -> Parsec String () [(Indent, Line)]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`sepBy` Parser String
eol

line :: Parser (Indent, Line)
line :: Parser (Indent, Line)
line = (,) (Indent -> Line -> (Indent, Line))
-> ParsecT String () Identity Indent
-> ParsecT String () Identity (Line -> (Indent, Line))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity Indent
indent ParsecT String () Identity (Line -> (Indent, Line))
-> ParsecT String () Identity Line -> Parser (Indent, Line)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT String () Identity Line
contents

indent :: Parser Indent
indent :: ParsecT String () Identity Indent
indent = ([Indent] -> Indent)
-> ParsecT String () Identity [Indent]
-> ParsecT String () Identity Indent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Indent] -> Indent
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (ParsecT String () Identity [Indent]
 -> ParsecT String () Identity Indent)
-> ParsecT String () Identity [Indent]
-> ParsecT String () Identity Indent
forall a b. (a -> b) -> a -> b
$
         ParsecT String () Identity Indent
-> ParsecT String () Identity [Indent]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ((Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
' ' ParsecT String () Identity Char
-> ParsecT String () Identity Indent
-> ParsecT String () Identity Indent
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Indent -> ParsecT String () Identity Indent
forall (f :: * -> *) a. Applicative f => a -> f a
pure Indent
1) ParsecT String () Identity Indent
-> ParsecT String () Identity Indent
-> ParsecT String () Identity Indent
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
               (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\t' ParsecT String () Identity Char
-> ParsecT String () Identity Indent
-> ParsecT String () Identity Indent
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> ParsecT String () Identity Indent
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Tabs are not allowed in indentation"))

contents :: Parser Line
contents :: ParsecT String () Identity Line
contents = ParsecT String () Identity Line -> ParsecT String () Identity Line
forall tok st a. GenParser tok st a -> GenParser tok st a
try ParsecT String () Identity Line
ctrlForall ParsecT String () Identity Line
-> ParsecT String () Identity Line
-> ParsecT String () Identity Line
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
           ParsecT String () Identity Line -> ParsecT String () Identity Line
forall tok st a. GenParser tok st a -> GenParser tok st a
try ParsecT String () Identity Line
ctrlMaybe ParsecT String () Identity Line
-> ParsecT String () Identity Line
-> ParsecT String () Identity Line
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
           ParsecT String () Identity Line -> ParsecT String () Identity Line
forall tok st a. GenParser tok st a -> GenParser tok st a
try ParsecT String () Identity Line
ctrlNothing ParsecT String () Identity Line
-> ParsecT String () Identity Line
-> ParsecT String () Identity Line
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
           ParsecT String () Identity Line -> ParsecT String () Identity Line
forall tok st a. GenParser tok st a -> GenParser tok st a
try ParsecT String () Identity Line
ctrlIf ParsecT String () Identity Line
-> ParsecT String () Identity Line
-> ParsecT String () Identity Line
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
           ParsecT String () Identity Line -> ParsecT String () Identity Line
forall tok st a. GenParser tok st a -> GenParser tok st a
try ParsecT String () Identity Line
ctrlElse ParsecT String () Identity Line
-> ParsecT String () Identity Line
-> ParsecT String () Identity Line
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
           ParsecT String () Identity Line -> ParsecT String () Identity Line
forall tok st a. GenParser tok st a -> GenParser tok st a
try ParsecT String () Identity Line
ctrlCase ParsecT String () Identity Line
-> ParsecT String () Identity Line
-> ParsecT String () Identity Line
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
           ParsecT String () Identity Line -> ParsecT String () Identity Line
forall tok st a. GenParser tok st a -> GenParser tok st a
try ParsecT String () Identity Line
ctrlOf ParsecT String () Identity Line
-> ParsecT String () Identity Line
-> ParsecT String () Identity Line
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
           ParsecT String () Identity Line -> ParsecT String () Identity Line
forall tok st a. GenParser tok st a -> GenParser tok st a
try ParsecT String () Identity Line
ctrlLet ParsecT String () Identity Line
-> ParsecT String () Identity Line
-> ParsecT String () Identity Line
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
           ParsecT String () Identity Line
normal

ctrlForall :: Parser Line
ctrlForall :: ParsecT String () Identity Line
ctrlForall = [Expr] -> [Expr] -> [(Indent, Line)] -> Line
CtrlForall ([Expr] -> [Expr] -> [(Indent, Line)] -> Line)
-> ParsecT String () Identity [Expr]
-> ParsecT String () Identity ([Expr] -> [(Indent, Line)] -> Line)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity [Expr]
bindVal ParsecT String () Identity ([Expr] -> [(Indent, Line)] -> Line)
-> ParsecT String () Identity [Expr]
-> ParsecT String () Identity ([(Indent, Line)] -> Line)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT String () Identity [Expr]
expr ParsecT String () Identity ([(Indent, Line)] -> Line)
-> Parsec String () [(Indent, Line)]
-> ParsecT String () Identity Line
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [(Indent, Line)] -> Parsec String () [(Indent, Line)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    where
      bindVal :: ParsecT String () Identity [Expr]
bindVal = String -> Parser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"$forall" Parser String -> Parser String -> Parser String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser String
spaceTabs Parser String
-> ParsecT String () Identity [Expr]
-> ParsecT String () Identity [Expr]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                ParsecT String () Identity [Expr]
binding
                ParsecT String () Identity [Expr]
-> Parser String -> ParsecT String () Identity [Expr]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser String
spaceTabs ParsecT String () Identity [Expr]
-> Parser String -> ParsecT String () Identity [Expr]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String -> Parser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"<-" ParsecT String () Identity [Expr]
-> Parser String -> ParsecT String () Identity [Expr]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser String
spaceTabs

ctrlMaybe :: Parser Line
ctrlMaybe :: ParsecT String () Identity Line
ctrlMaybe = AltFlag
-> [Expr] -> [Expr] -> [(Indent, Line)] -> [(Indent, Line)] -> Line
CtrlMaybe (AltFlag
 -> [Expr]
 -> [Expr]
 -> [(Indent, Line)]
 -> [(Indent, Line)]
 -> Line)
-> ParsecT String () Identity AltFlag
-> ParsecT
     String
     ()
     Identity
     ([Expr] -> [Expr] -> [(Indent, Line)] -> [(Indent, Line)] -> Line)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AltFlag -> ParsecT String () Identity AltFlag
forall (f :: * -> *) a. Applicative f => a -> f a
pure AltFlag
False ParsecT
  String
  ()
  Identity
  ([Expr] -> [Expr] -> [(Indent, Line)] -> [(Indent, Line)] -> Line)
-> ParsecT String () Identity [Expr]
-> ParsecT
     String
     ()
     Identity
     ([Expr] -> [(Indent, Line)] -> [(Indent, Line)] -> Line)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT String () Identity [Expr]
bindVal ParsecT
  String
  ()
  Identity
  ([Expr] -> [(Indent, Line)] -> [(Indent, Line)] -> Line)
-> ParsecT String () Identity [Expr]
-> ParsecT
     String () Identity ([(Indent, Line)] -> [(Indent, Line)] -> Line)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT String () Identity [Expr]
expr ParsecT
  String () Identity ([(Indent, Line)] -> [(Indent, Line)] -> Line)
-> Parsec String () [(Indent, Line)]
-> ParsecT String () Identity ([(Indent, Line)] -> Line)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [(Indent, Line)] -> Parsec String () [(Indent, Line)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [] ParsecT String () Identity ([(Indent, Line)] -> Line)
-> Parsec String () [(Indent, Line)]
-> ParsecT String () Identity Line
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [(Indent, Line)] -> Parsec String () [(Indent, Line)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    where
      bindVal :: ParsecT String () Identity [Expr]
bindVal = String -> Parser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"$maybe" Parser String -> Parser String -> Parser String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser String
spaceTabs Parser String
-> ParsecT String () Identity [Expr]
-> ParsecT String () Identity [Expr]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                ParsecT String () Identity [Expr]
binding
                ParsecT String () Identity [Expr]
-> Parser String -> ParsecT String () Identity [Expr]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser String
spaceTabs ParsecT String () Identity [Expr]
-> Parser String -> ParsecT String () Identity [Expr]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String -> Parser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"<-" ParsecT String () Identity [Expr]
-> Parser String -> ParsecT String () Identity [Expr]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser String
spaceTabs

ctrlNothing :: Parser Line
ctrlNothing :: ParsecT String () Identity Line
ctrlNothing = String -> Parser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"$nothing" Parser String -> Parser String -> Parser String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser String
spaceTabs Parser String
-> ParsecT String () Identity Line
-> ParsecT String () Identity Line
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Line -> ParsecT String () Identity Line
forall (f :: * -> *) a. Applicative f => a -> f a
pure Line
CtrlNothing

ctrlIf :: Parser Line
ctrlIf :: ParsecT String () Identity Line
ctrlIf = AltFlag -> [Expr] -> [(Indent, Line)] -> [(Indent, Line)] -> Line
CtrlIf (AltFlag -> [Expr] -> [(Indent, Line)] -> [(Indent, Line)] -> Line)
-> ParsecT String () Identity AltFlag
-> ParsecT
     String
     ()
     Identity
     ([Expr] -> [(Indent, Line)] -> [(Indent, Line)] -> Line)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AltFlag -> ParsecT String () Identity AltFlag
forall (f :: * -> *) a. Applicative f => a -> f a
pure AltFlag
False ParsecT
  String
  ()
  Identity
  ([Expr] -> [(Indent, Line)] -> [(Indent, Line)] -> Line)
-> ParsecT String () Identity [Expr]
-> ParsecT
     String () Identity ([(Indent, Line)] -> [(Indent, Line)] -> Line)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> Parser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"$if" Parser String -> Parser String -> Parser String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser String
spaceTabs Parser String
-> ParsecT String () Identity [Expr]
-> ParsecT String () Identity [Expr]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT String () Identity [Expr]
expr ParsecT String () Identity [Expr]
-> Parser String -> ParsecT String () Identity [Expr]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser String
spaceTabs) ParsecT
  String () Identity ([(Indent, Line)] -> [(Indent, Line)] -> Line)
-> Parsec String () [(Indent, Line)]
-> ParsecT String () Identity ([(Indent, Line)] -> Line)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [(Indent, Line)] -> Parsec String () [(Indent, Line)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [] ParsecT String () Identity ([(Indent, Line)] -> Line)
-> Parsec String () [(Indent, Line)]
-> ParsecT String () Identity Line
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [(Indent, Line)] -> Parsec String () [(Indent, Line)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

ctrlElse :: Parser Line
ctrlElse :: ParsecT String () Identity Line
ctrlElse = String -> Parser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"$else" Parser String -> Parser String -> Parser String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser String
spaceTabs Parser String
-> ParsecT String () Identity Line
-> ParsecT String () Identity Line
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Line -> ParsecT String () Identity Line
forall (f :: * -> *) a. Applicative f => a -> f a
pure Line
CtrlElse

ctrlCase :: Parser Line
ctrlCase :: ParsecT String () Identity Line
ctrlCase = [Expr] -> [([Expr], [(Indent, Line)])] -> Line
CtrlCase ([Expr] -> [([Expr], [(Indent, Line)])] -> Line)
-> ParsecT String () Identity [Expr]
-> ParsecT
     String () Identity ([([Expr], [(Indent, Line)])] -> Line)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Parser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"$case" Parser String -> Parser String -> Parser String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser String
spaceTabs Parser String
-> ParsecT String () Identity [Expr]
-> ParsecT String () Identity [Expr]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT String () Identity [Expr]
expr ParsecT String () Identity [Expr]
-> Parser String -> ParsecT String () Identity [Expr]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser String
spaceTabs) ParsecT String () Identity ([([Expr], [(Indent, Line)])] -> Line)
-> ParsecT String () Identity [([Expr], [(Indent, Line)])]
-> ParsecT String () Identity Line
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [([Expr], [(Indent, Line)])]
-> ParsecT String () Identity [([Expr], [(Indent, Line)])]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

ctrlOf :: Parser Line
ctrlOf :: ParsecT String () Identity Line
ctrlOf = [Expr] -> Line
CtrlOf ([Expr] -> Line)
-> ParsecT String () Identity [Expr]
-> ParsecT String () Identity Line
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity [Expr]
bindVal
    where
      bindVal :: ParsecT String () Identity [Expr]
bindVal = String -> Parser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"$of" Parser String -> Parser String -> Parser String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser String
spaceTabs Parser String
-> ParsecT String () Identity [Expr]
-> ParsecT String () Identity [Expr]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                ParsecT String () Identity [Expr]
binding
                ParsecT String () Identity [Expr]
-> Parser String -> ParsecT String () Identity [Expr]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser String
spaceTabs

ctrlLet :: Parser Line
ctrlLet :: ParsecT String () Identity Line
ctrlLet = [Expr] -> [Expr] -> [(Indent, Line)] -> Line
CtrlLet ([Expr] -> [Expr] -> [(Indent, Line)] -> Line)
-> ParsecT String () Identity [Expr]
-> ParsecT String () Identity ([Expr] -> [(Indent, Line)] -> Line)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity [Expr]
bindVal ParsecT String () Identity ([Expr] -> [(Indent, Line)] -> Line)
-> ParsecT String () Identity [Expr]
-> ParsecT String () Identity ([(Indent, Line)] -> Line)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT String () Identity [Expr]
expr ParsecT String () Identity ([(Indent, Line)] -> Line)
-> Parsec String () [(Indent, Line)]
-> ParsecT String () Identity Line
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [(Indent, Line)] -> Parsec String () [(Indent, Line)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    where
      bindVal :: ParsecT String () Identity [Expr]
bindVal = String -> Parser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"$let" Parser String -> Parser String -> Parser String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser String
spaceTabs Parser String
-> ParsecT String () Identity [Expr]
-> ParsecT String () Identity [Expr]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                ParsecT String () Identity [Expr]
binding
                ParsecT String () Identity [Expr]
-> Parser String -> ParsecT String () Identity [Expr]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser String
spaceTabs ParsecT String () Identity [Expr]
-> Parser String -> ParsecT String () Identity [Expr]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String -> Parser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"=" ParsecT String () Identity [Expr]
-> Parser String -> ParsecT String () Identity [Expr]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser String
spaceTabs

binding :: Parser [Expr]
binding :: ParsecT String () Identity [Expr]
binding = Parser String
spaceTabs Parser String
-> ParsecT String () Identity [Expr]
-> ParsecT String () Identity [Expr]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT String () Identity Expr
-> ParsecT String () Identity [Expr]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT String () Identity Expr -> ParsecT String () Identity Expr
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> Expr -> Expr
A (String -> Expr -> Expr)
-> Parser String -> ParsecT String () Identity (Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String
var ParsecT String () Identity (Expr -> Expr)
-> ParsecT String () Identity Char
-> ParsecT String () Identity (Expr -> Expr)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'@' ParsecT String () Identity (Expr -> Expr)
-> ParsecT String () Identity Expr
-> ParsecT String () Identity Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT String () Identity Expr
term) ParsecT String () Identity Expr
-> ParsecT String () Identity Expr
-> ParsecT String () Identity Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                              ParsecT String () Identity Expr
term)
    where
      term :: Parser Expr
      term :: ParsecT String () Identity Expr
term = ([[Expr]] -> Expr
T ([[Expr]] -> Expr)
-> ParsecT String () Identity [[Expr]]
-> ParsecT String () Identity Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity [[Expr]]
tuple ParsecT String () Identity Expr
-> ParsecT String () Identity Expr
-> ParsecT String () Identity Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
              (ParsecT String () Identity Expr -> ParsecT String () Identity Expr
forall tok st a. GenParser tok st a -> GenParser tok st a
try (Parser String
nil Parser String
-> ParsecT String () Identity Expr
-> ParsecT String () Identity Expr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Expr -> ParsecT String () Identity Expr
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr
N) ParsecT String () Identity Expr
-> ParsecT String () Identity Expr
-> ParsecT String () Identity Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
               ParsecT String () Identity Expr -> ParsecT String () Identity Expr
forall tok st a. GenParser tok st a -> GenParser tok st a
try ([[Expr]] -> Expr
L ([[Expr]] -> Expr)
-> ParsecT String () Identity [[Expr]]
-> ParsecT String () Identity Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity [[Expr]]
list) ParsecT String () Identity Expr
-> ParsecT String () Identity Expr
-> ParsecT String () Identity Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
               ParsecT String () Identity Expr -> ParsecT String () Identity Expr
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> Expr
O (String -> Expr)
-> Parser String -> ParsecT String () Identity Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Parser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
":")) ParsecT String () Identity Expr
-> ParsecT String () Identity Expr
-> ParsecT String () Identity Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> -- only pattern operator
              (ParsecT String () Identity Expr -> ParsecT String () Identity Expr
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> Expr
V (String -> Expr)
-> Parser String -> ParsecT String () Identity Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> ShowS
forall a. Semigroup a => a -> a -> a
(<>) (String -> ShowS)
-> Parser String -> ParsecT String () Identity ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String
wild ParsecT String () Identity ShowS -> Parser String -> Parser String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT String () Identity Char -> Parser String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"_'"))) ParsecT String () Identity Expr
-> ParsecT String () Identity Expr
-> ParsecT String () Identity Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
               ParsecT String () Identity Expr -> ParsecT String () Identity Expr
forall tok st a. GenParser tok st a -> GenParser tok st a
try (Parser String
wild Parser String
-> ParsecT String () Identity Expr
-> ParsecT String () Identity Expr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Expr -> ParsecT String () Identity Expr
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr
W) ParsecT String () Identity Expr
-> ParsecT String () Identity Expr
-> ParsecT String () Identity Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
               String -> Expr
V (String -> Expr)
-> Parser String -> ParsecT String () Identity Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String
var) ParsecT String () Identity Expr
-> ParsecT String () Identity Expr
-> ParsecT String () Identity Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
              String -> Expr
C (String -> Expr)
-> Parser String -> ParsecT String () Identity Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String
con) ParsecT String () Identity Expr
-> Parser String -> ParsecT String () Identity Expr
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser String
spaceTabs

expr :: Parser [Expr]
expr :: ParsecT String () Identity [Expr]
expr = Parser String
spaceTabs Parser String
-> ParsecT String () Identity [Expr]
-> ParsecT String () Identity [Expr]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT String () Identity Expr
-> ParsecT String () Identity [Expr]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT String () Identity Expr -> ParsecT String () Identity Expr
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> Expr -> Expr
A (String -> Expr -> Expr)
-> Parser String -> ParsecT String () Identity (Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String
var ParsecT String () Identity (Expr -> Expr)
-> ParsecT String () Identity Char
-> ParsecT String () Identity (Expr -> Expr)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'@' ParsecT String () Identity (Expr -> Expr)
-> ParsecT String () Identity Expr
-> ParsecT String () Identity Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT String () Identity Expr
term) ParsecT String () Identity Expr
-> ParsecT String () Identity Expr
-> ParsecT String () Identity Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                           ParsecT String () Identity Expr
term)
    where
      term :: Parser Expr
      term :: ParsecT String () Identity Expr
term = (String -> Expr
S  (String -> Expr)
-> Parser String -> ParsecT String () Identity Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String
str ParsecT String () Identity Expr
-> ParsecT String () Identity Expr
-> ParsecT String () Identity Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
              [[Expr]] -> Expr
T  ([[Expr]] -> Expr)
-> ParsecT String () Identity [[Expr]]
-> ParsecT String () Identity Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity [[Expr]]
tuple ParsecT String () Identity Expr
-> ParsecT String () Identity Expr
-> ParsecT String () Identity Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
              (ParsecT String () Identity Expr -> ParsecT String () Identity Expr
forall tok st a. GenParser tok st a -> GenParser tok st a
try (Parser String
nil Parser String
-> ParsecT String () Identity Expr
-> ParsecT String () Identity Expr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Expr -> ParsecT String () Identity Expr
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr
N) ParsecT String () Identity Expr
-> ParsecT String () Identity Expr
-> ParsecT String () Identity Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
               ParsecT String () Identity Expr -> ParsecT String () Identity Expr
forall tok st a. GenParser tok st a -> GenParser tok st a
try ([[Expr]] -> Expr
L ([[Expr]] -> Expr)
-> ParsecT String () Identity [[Expr]]
-> ParsecT String () Identity Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity [[Expr]]
list) ParsecT String () Identity Expr
-> ParsecT String () Identity Expr
-> ParsecT String () Identity Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
               ParsecT String () Identity Expr -> ParsecT String () Identity Expr
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> Expr
O (String -> Expr)
-> Parser String -> ParsecT String () Identity Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String
op)) ParsecT String () Identity Expr
-> ParsecT String () Identity Expr
-> ParsecT String () Identity Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
              (ParsecT String () Identity Expr -> ParsecT String () Identity Expr
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> Expr
O' (String -> Expr)
-> Parser String -> ParsecT String () Identity Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String
op') ParsecT String () Identity Expr
-> ParsecT String () Identity Expr
-> ParsecT String () Identity Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String () Identity Expr -> ParsecT String () Identity Expr
forall tok st a. GenParser tok st a -> GenParser tok st a
try ([Expr] -> Expr
E  ([Expr] -> Expr)
-> ParsecT String () Identity [Expr]
-> ParsecT String () Identity Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity [Expr]
subexp)) ParsecT String () Identity Expr
-> ParsecT String () Identity Expr
-> ParsecT String () Identity Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
              String -> Expr
V' (String -> Expr)
-> Parser String -> ParsecT String () Identity Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String
var' ParsecT String () Identity Expr
-> ParsecT String () Identity Expr
-> ParsecT String () Identity Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
              (ParsecT String () Identity Expr -> ParsecT String () Identity Expr
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> Expr
V (String -> Expr)
-> Parser String -> ParsecT String () Identity Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> ShowS
forall a. Semigroup a => a -> a -> a
(<>) (String -> ShowS)
-> Parser String -> ParsecT String () Identity ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String
wild ParsecT String () Identity ShowS -> Parser String -> Parser String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT String () Identity Char -> Parser String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"_'"))) ParsecT String () Identity Expr
-> ParsecT String () Identity Expr
-> ParsecT String () Identity Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
               ParsecT String () Identity Expr -> ParsecT String () Identity Expr
forall tok st a. GenParser tok st a -> GenParser tok st a
try (Parser String
wild Parser String
-> ParsecT String () Identity Expr
-> ParsecT String () Identity Expr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Expr -> ParsecT String () Identity Expr
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr
W) ParsecT String () Identity Expr
-> ParsecT String () Identity Expr
-> ParsecT String () Identity Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
               String -> Expr
V (String -> Expr)
-> Parser String -> ParsecT String () Identity Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String
var) ParsecT String () Identity Expr
-> ParsecT String () Identity Expr
-> ParsecT String () Identity Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
              String -> Expr
C  (String -> Expr)
-> Parser String -> ParsecT String () Identity Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String
con ParsecT String () Identity Expr
-> ParsecT String () Identity Expr
-> ParsecT String () Identity Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
              Integer -> Expr
I  (Integer -> Expr)
-> ParsecT String () Identity Integer
-> ParsecT String () Identity Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity Integer
integer) ParsecT String () Identity Expr
-> Parser String -> ParsecT String () Identity Expr
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser String
spaceTabs


tuple :: Parser [[Expr]]
tuple :: ParsecT String () Identity [[Expr]]
tuple = Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'(' ParsecT String () Identity Char
-> ParsecT String () Identity [[Expr]]
-> ParsecT String () Identity [[Expr]]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT String () Identity [Expr]
-> ParsecT String () Identity Char
-> ParsecT String () Identity [[Expr]]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy ParsecT String () Identity [Expr]
expr (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
',')  ParsecT String () Identity [[Expr]]
-> ParsecT String () Identity Char
-> ParsecT String () Identity [[Expr]]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
')'

list :: Parser [[Expr]]
list :: ParsecT String () Identity [[Expr]]
list = Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'[' ParsecT String () Identity Char
-> ParsecT String () Identity [[Expr]]
-> ParsecT String () Identity [[Expr]]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT String () Identity [Expr]
-> ParsecT String () Identity Char
-> ParsecT String () Identity [[Expr]]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy ParsecT String () Identity [Expr]
expr (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
',') ParsecT String () Identity [[Expr]]
-> ParsecT String () Identity Char
-> ParsecT String () Identity [[Expr]]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
']'

integer :: Parser Integer
integer :: ParsecT String () Identity Integer
integer = String -> Integer
forall a. Read a => String -> a
read (String -> Integer)
-> Parser String -> ParsecT String () Identity Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity Char -> Parser String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit

str :: Parser String
str :: Parser String
str = Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'"' ParsecT String () Identity Char -> Parser String -> Parser String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT String () Identity Char -> Parser String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT String () Identity Char
quotedChar Parser String -> ParsecT String () Identity Char -> Parser String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'"'
    where
      quotedChar :: Parser Char
      quotedChar :: ParsecT String () Identity Char
quotedChar = String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"\\\"" ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String () Identity Char -> ParsecT String () Identity Char
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> Parser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\\\"" Parser String
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ParsecT String () Identity Char
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
'"')

subexp :: Parser [Expr]
subexp :: ParsecT String () Identity [Expr]
subexp = Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'(' ParsecT String () Identity Char
-> ParsecT String () Identity [Expr]
-> ParsecT String () Identity [Expr]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT String () Identity [Expr]
expr ParsecT String () Identity [Expr]
-> ParsecT String () Identity Char
-> ParsecT String () Identity [Expr]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
')'

var :: Parser String
var :: Parser String
var = Parser String -> Parser String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> ShowS
(+.+) (String -> ShowS)
-> Parser String -> ParsecT String () Identity ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String
modul ParsecT String () Identity ShowS -> Parser String -> Parser String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser String
v) Parser String -> Parser String -> Parser String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser String
v
    where
      String
x +.+ :: String -> ShowS
+.+ String
y = String
x String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"." String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
y
      v :: Parser String
      v :: Parser String
v = (:) (Char -> ShowS)
-> ParsecT String () Identity Char
-> ParsecT String () Identity ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
lower ParsecT String () Identity ShowS -> Parser String -> Parser String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT String () Identity Char -> Parser String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"_'")

modul :: Parser String
modul :: Parser String
modul = Parser String -> Parser String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"." ([String] -> String)
-> ParsecT String () Identity [String] -> Parser String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String -> ParsecT String () Identity [String]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (Parser String
mod' Parser String -> ParsecT String () Identity Char -> Parser String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.')) Parser String -> Parser String -> Parser String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser String
mod'
    where
      mod' :: Parser String
      mod' :: Parser String
mod' = (:) (Char -> ShowS)
-> ParsecT String () Identity Char
-> ParsecT String () Identity ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
upper ParsecT String () Identity ShowS -> Parser String -> Parser String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT String () Identity Char -> Parser String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum



var' :: Parser String
var' :: Parser String
var' = Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'`' ParsecT String () Identity Char -> Parser String -> Parser String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser String
var Parser String -> ParsecT String () Identity Char -> Parser String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'`'

wild :: Parser String
wild :: Parser String
wild = String -> Parser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"_"

nil :: Parser String
nil :: Parser String
nil = String -> Parser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"[]"

con :: Parser String
con :: Parser String
con = (:) (Char -> ShowS)
-> ParsecT String () Identity Char
-> ParsecT String () Identity ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
upper ParsecT String () Identity ShowS -> Parser String -> Parser String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT String () Identity Char -> Parser String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"_'")

op :: Parser String
op :: Parser String
op = ParsecT String () Identity Char -> Parser String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
":!#$%&*+./<=>?@\\^|-~")

op' :: Parser String
op' :: Parser String
op' = Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'(' ParsecT String () Identity Char -> Parser String -> Parser String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser String
op Parser String -> ParsecT String () Identity Char -> Parser String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
')'

normal :: Parser Line
normal :: ParsecT String () Identity Line
normal = [InLine] -> Line
Normal ([InLine] -> Line)
-> ParsecT String () Identity [InLine]
-> ParsecT String () Identity Line
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity InLine
-> ParsecT String () Identity [InLine]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT String () Identity InLine
-> ParsecT String () Identity InLine
forall tok st a. GenParser tok st a -> GenParser tok st a
try ParsecT String () Identity InLine
quoted ParsecT String () Identity InLine
-> ParsecT String () Identity InLine
-> ParsecT String () Identity InLine
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String () Identity InLine
-> ParsecT String () Identity InLine
forall tok st a. GenParser tok st a -> GenParser tok st a
try ParsecT String () Identity InLine
raw' ParsecT String () Identity InLine
-> ParsecT String () Identity InLine
-> ParsecT String () Identity InLine
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String () Identity InLine
-> ParsecT String () Identity InLine
forall tok st a. GenParser tok st a -> GenParser tok st a
try ParsecT String () Identity InLine
raw)

quoted :: Parser InLine
quoted :: ParsecT String () Identity InLine
quoted = [Expr] -> InLine
Quoted ([Expr] -> InLine)
-> ParsecT String () Identity [Expr]
-> ParsecT String () Identity InLine
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Parser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"${" Parser String
-> ParsecT String () Identity [Expr]
-> ParsecT String () Identity [Expr]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT String () Identity [Expr]
expr ParsecT String () Identity [Expr]
-> Parser String -> ParsecT String () Identity [Expr]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String -> Parser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"}")

raw' :: Parser InLine
raw' :: ParsecT String () Identity InLine
raw' = String -> InLine
Raw (String -> InLine)
-> Parser String -> ParsecT String () Identity InLine
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((:) (Char -> ShowS)
-> ParsecT String () Identity Char
-> ParsecT String () Identity ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'$')
                ParsecT String () Identity ShowS -> Parser String -> Parser String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((:) (Char -> ShowS)
-> ParsecT String () Identity Char
-> ParsecT String () Identity ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"{" ParsecT String () Identity ShowS -> Parser String -> Parser String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT String () Identity Char -> Parser String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"$\n\r")))

raw :: Parser InLine
raw :: ParsecT String () Identity InLine
raw = String -> InLine
Raw (String -> InLine)
-> Parser String -> ParsecT String () Identity InLine
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity Char -> Parser String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"$\n\r")

----
arrange :: [(Indent, Line)] -> [(Indent, Line)]
arrange :: [(Indent, Line)] -> [(Indent, Line)]
arrange = [(Indent, Line)] -> [(Indent, Line)]
norm ([(Indent, Line)] -> [(Indent, Line)])
-> ([(Indent, Line)] -> [(Indent, Line)])
-> [(Indent, Line)]
-> [(Indent, Line)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Indent, Line)] -> [(Indent, Line)]
rev ([(Indent, Line)] -> [(Indent, Line)])
-> ([(Indent, Line)] -> [(Indent, Line)])
-> [(Indent, Line)]
-> [(Indent, Line)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Indent, Line)] -> (Indent, Line) -> [(Indent, Line)])
-> [(Indent, Line)] -> [(Indent, Line)] -> [(Indent, Line)]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (((Indent, Line) -> [(Indent, Line)] -> [(Indent, Line)])
-> [(Indent, Line)] -> (Indent, Line) -> [(Indent, Line)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Indent, Line) -> [(Indent, Line)] -> [(Indent, Line)]
push) []
    where
      isCtrlNothing :: (a, Line) -> AltFlag
isCtrlNothing (a
_, Line
CtrlNothing) = AltFlag
True
      isCtrlNothing (a, Line)
_ = AltFlag
False
      isCtrlElse :: (a, Line) -> AltFlag
isCtrlElse (a
_, Line
CtrlElse) = AltFlag
True
      isCtrlElse (a, Line)
_ = AltFlag
False
      isCtrlOf :: (a, Line) -> AltFlag
isCtrlOf (a
_, CtrlOf [Expr]
_) = AltFlag
True
      isCtrlOf (a, Line)
_ = AltFlag
False

      push :: Line' -> [Line'] -> [Line']
      push :: (Indent, Line) -> [(Indent, Line)] -> [(Indent, Line)]
push (Indent, Line)
x [] = (Indent, Line)
x(Indent, Line) -> [(Indent, Line)] -> [(Indent, Line)]
forall a. a -> [a] -> [a]
:[]
      push (Indent, Line)
x ss' :: [(Indent, Line)]
ss'@((Indent
_, Normal [InLine]
_):[(Indent, Line)]
_) = (Indent, Line)
x(Indent, Line) -> [(Indent, Line)] -> [(Indent, Line)]
forall a. a -> [a] -> [a]
:[(Indent, Line)]
ss'

      push x :: (Indent, Line)
x@(Indent
i, Line
_) ss' :: [(Indent, Line)]
ss'@((Indent
j, CtrlForall [Expr]
b [Expr]
e [(Indent, Line)]
body):[(Indent, Line)]
ss)
          | Indent
i Indent -> Indent -> AltFlag
forall a. Ord a => a -> a -> AltFlag
> Indent
j = (Indent
j, [Expr] -> [Expr] -> [(Indent, Line)] -> Line
CtrlForall [Expr]
b [Expr]
e ((Indent, Line) -> [(Indent, Line)] -> [(Indent, Line)]
push (Indent, Line)
x [(Indent, Line)]
body))(Indent, Line) -> [(Indent, Line)] -> [(Indent, Line)]
forall a. a -> [a] -> [a]
:[(Indent, Line)]
ss
          | AltFlag
otherwise = (Indent, Line)
x(Indent, Line) -> [(Indent, Line)] -> [(Indent, Line)]
forall a. a -> [a] -> [a]
:[(Indent, Line)]
ss'

      push x :: (Indent, Line)
x@(Indent
i, Line
_) ss' :: [(Indent, Line)]
ss'@((Indent
j, CtrlLet [Expr]
b [Expr]
e [(Indent, Line)]
body):[(Indent, Line)]
ss)
          | Indent
i Indent -> Indent -> AltFlag
forall a. Ord a => a -> a -> AltFlag
> Indent
j = (Indent
j, [Expr] -> [Expr] -> [(Indent, Line)] -> Line
CtrlLet [Expr]
b [Expr]
e ((Indent, Line) -> [(Indent, Line)] -> [(Indent, Line)]
push (Indent, Line)
x [(Indent, Line)]
body))(Indent, Line) -> [(Indent, Line)] -> [(Indent, Line)]
forall a. a -> [a] -> [a]
:[(Indent, Line)]
ss
          | AltFlag
otherwise = (Indent, Line)
x(Indent, Line) -> [(Indent, Line)] -> [(Indent, Line)]
forall a. a -> [a] -> [a]
:[(Indent, Line)]
ss'

      push x :: (Indent, Line)
x@(Indent
i, Line
_) ss' :: [(Indent, Line)]
ss'@((Indent
j, CtrlMaybe AltFlag
flg [Expr]
b [Expr]
e [(Indent, Line)]
body [(Indent, Line)]
alt):[(Indent, Line)]
ss)
          | Indent
i Indent -> Indent -> AltFlag
forall a. Ord a => a -> a -> AltFlag
> Indent
j = if AltFlag
flg
                    then (Indent
j, AltFlag
-> [Expr] -> [Expr] -> [(Indent, Line)] -> [(Indent, Line)] -> Line
CtrlMaybe AltFlag
flg [Expr]
b [Expr]
e [(Indent, Line)]
body ((Indent, Line) -> [(Indent, Line)] -> [(Indent, Line)]
push (Indent, Line)
x [(Indent, Line)]
alt))(Indent, Line) -> [(Indent, Line)] -> [(Indent, Line)]
forall a. a -> [a] -> [a]
:[(Indent, Line)]
ss
                    else (Indent
j, AltFlag
-> [Expr] -> [Expr] -> [(Indent, Line)] -> [(Indent, Line)] -> Line
CtrlMaybe AltFlag
flg [Expr]
b [Expr]
e ((Indent, Line) -> [(Indent, Line)] -> [(Indent, Line)]
push (Indent, Line)
x [(Indent, Line)]
body) [(Indent, Line)]
alt)(Indent, Line) -> [(Indent, Line)] -> [(Indent, Line)]
forall a. a -> [a] -> [a]
:[(Indent, Line)]
ss
          | Indent
i Indent -> Indent -> AltFlag
forall a. Eq a => a -> a -> AltFlag
== Indent
j AltFlag -> AltFlag -> AltFlag
&& (Indent, Line) -> AltFlag
forall a. (a, Line) -> AltFlag
isCtrlNothing (Indent, Line)
x
              = if AltFlag
flg
                then String -> [(Indent, Line)]
forall a. HasCallStack => String -> a
error String
"too many $nothing found"
                else (Indent
j, AltFlag
-> [Expr] -> [Expr] -> [(Indent, Line)] -> [(Indent, Line)] -> Line
CtrlMaybe AltFlag
True [Expr]
b [Expr]
e [(Indent, Line)]
body [(Indent, Line)]
alt)(Indent, Line) -> [(Indent, Line)] -> [(Indent, Line)]
forall a. a -> [a] -> [a]
:[(Indent, Line)]
ss
          | AltFlag
otherwise = (Indent, Line)
x(Indent, Line) -> [(Indent, Line)] -> [(Indent, Line)]
forall a. a -> [a] -> [a]
:[(Indent, Line)]
ss'
      push (Indent, Line)
x ((Indent
j, Line
CtrlNothing):[(Indent, Line)]
_) = String -> [(Indent, Line)]
forall a. HasCallStack => String -> a
error String
"orphan $nothing found"

      push x :: (Indent, Line)
x@(Indent
i, Line
_) ss' :: [(Indent, Line)]
ss'@((Indent
j, CtrlIf AltFlag
flg [Expr]
e [(Indent, Line)]
body [(Indent, Line)]
alt):[(Indent, Line)]
ss)
          | Indent
i Indent -> Indent -> AltFlag
forall a. Ord a => a -> a -> AltFlag
> Indent
j = if AltFlag
flg
                    then (Indent
j, AltFlag -> [Expr] -> [(Indent, Line)] -> [(Indent, Line)] -> Line
CtrlIf AltFlag
flg [Expr]
e [(Indent, Line)]
body ((Indent, Line) -> [(Indent, Line)] -> [(Indent, Line)]
push (Indent, Line)
x [(Indent, Line)]
alt))(Indent, Line) -> [(Indent, Line)] -> [(Indent, Line)]
forall a. a -> [a] -> [a]
:[(Indent, Line)]
ss
                    else (Indent
j, AltFlag -> [Expr] -> [(Indent, Line)] -> [(Indent, Line)] -> Line
CtrlIf AltFlag
flg [Expr]
e ((Indent, Line) -> [(Indent, Line)] -> [(Indent, Line)]
push (Indent, Line)
x [(Indent, Line)]
body) [(Indent, Line)]
alt)(Indent, Line) -> [(Indent, Line)] -> [(Indent, Line)]
forall a. a -> [a] -> [a]
:[(Indent, Line)]
ss
          | Indent
i Indent -> Indent -> AltFlag
forall a. Eq a => a -> a -> AltFlag
== Indent
j AltFlag -> AltFlag -> AltFlag
&& (Indent, Line) -> AltFlag
forall a. (a, Line) -> AltFlag
isCtrlElse (Indent, Line)
x
              = if AltFlag
flg
                then String -> [(Indent, Line)]
forall a. HasCallStack => String -> a
error String
"too many $else found"
                else (Indent
j, AltFlag -> [Expr] -> [(Indent, Line)] -> [(Indent, Line)] -> Line
CtrlIf AltFlag
True [Expr]
e [(Indent, Line)]
body [(Indent, Line)]
alt)(Indent, Line) -> [(Indent, Line)] -> [(Indent, Line)]
forall a. a -> [a] -> [a]
:[(Indent, Line)]
ss
          | AltFlag
otherwise = (Indent, Line)
x(Indent, Line) -> [(Indent, Line)] -> [(Indent, Line)]
forall a. a -> [a] -> [a]
:[(Indent, Line)]
ss'
      push (Indent, Line)
x ((Indent
j, Line
CtrlElse):[(Indent, Line)]
_) = String -> [(Indent, Line)]
forall a. HasCallStack => String -> a
error String
"orphan $else found"

      push x :: (Indent, Line)
x@(Indent
i, Line
_) ss' :: [(Indent, Line)]
ss'@((Indent
j, CtrlCase [Expr]
e [([Expr], [(Indent, Line)])]
alts):[(Indent, Line)]
ss)
          | Indent
i Indent -> Indent -> AltFlag
forall a. Ord a => a -> a -> AltFlag
> Indent
j = (Indent
j, [Expr] -> [([Expr], [(Indent, Line)])] -> Line
CtrlCase [Expr]
e ((Indent, Line)
-> [([Expr], [(Indent, Line)])] -> [([Expr], [(Indent, Line)])]
push' (Indent, Line)
x [([Expr], [(Indent, Line)])]
alts))(Indent, Line) -> [(Indent, Line)] -> [(Indent, Line)]
forall a. a -> [a] -> [a]
:[(Indent, Line)]
ss
          | AltFlag
otherwise
            = if (Indent, Line) -> AltFlag
forall a. (a, Line) -> AltFlag
isCtrlOf (Indent, Line)
x
              then String -> [(Indent, Line)]
forall a. HasCallStack => String -> a
error String
"orphan $of found"
              else (Indent, Line)
x(Indent, Line) -> [(Indent, Line)] -> [(Indent, Line)]
forall a. a -> [a] -> [a]
:[(Indent, Line)]
ss'
      push (Indent, Line)
x ((Indent
j, CtrlOf [Expr]
_):[(Indent, Line)]
_) = String -> [(Indent, Line)]
forall a. HasCallStack => String -> a
error String
"orphan $of found"

      push' :: (Indent, Line)
-> [([Expr], [(Indent, Line)])] -> [([Expr], [(Indent, Line)])]
push' x :: (Indent, Line)
x@(Indent
i, CtrlOf [Expr]
e) [([Expr], [(Indent, Line)])]
alts = ([Expr]
e, [])([Expr], [(Indent, Line)])
-> [([Expr], [(Indent, Line)])] -> [([Expr], [(Indent, Line)])]
forall a. a -> [a] -> [a]
:[([Expr], [(Indent, Line)])]
alts
      push' (Indent, Line)
x [] = String -> [([Expr], [(Indent, Line)])]
forall a. HasCallStack => String -> a
error String
"$of not found"
      push' (Indent, Line)
x (([Expr]
e, [(Indent, Line)]
body):[([Expr], [(Indent, Line)])]
alts) = ([Expr]
e, ((Indent, Line) -> [(Indent, Line)] -> [(Indent, Line)]
push (Indent, Line)
x [(Indent, Line)]
body))([Expr], [(Indent, Line)])
-> [([Expr], [(Indent, Line)])] -> [([Expr], [(Indent, Line)])]
forall a. a -> [a] -> [a]
:[([Expr], [(Indent, Line)])]
alts

      rev :: [Line'] -> [Line']
      rev :: [(Indent, Line)] -> [(Indent, Line)]
rev = ((Indent, Line) -> [(Indent, Line)] -> [(Indent, Line)])
-> [(Indent, Line)] -> [(Indent, Line)] -> [(Indent, Line)]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Indent, Line)
x [(Indent, Line)]
xs -> [(Indent, Line)]
xs [(Indent, Line)] -> [(Indent, Line)] -> [(Indent, Line)]
forall a. [a] -> [a] -> [a]
++ [(Indent, Line) -> (Indent, Line)
rev' (Indent, Line)
x]) []
      rev' :: Line' -> Line'
      rev' :: (Indent, Line) -> (Indent, Line)
rev' x :: (Indent, Line)
x@(Indent
_, Normal [InLine]
_) = (Indent, Line)
x
      rev' (Indent
i, CtrlForall [Expr]
b [Expr]
e [(Indent, Line)]
body)
          = (Indent
i, [Expr] -> [Expr] -> [(Indent, Line)] -> Line
CtrlForall [Expr]
b [Expr]
e ([(Indent, Line)] -> [(Indent, Line)]
rev [(Indent, Line)]
body))
      rev' (Indent
i, CtrlLet [Expr]
b [Expr]
e [(Indent, Line)]
body)
          = (Indent
i, [Expr] -> [Expr] -> [(Indent, Line)] -> Line
CtrlLet [Expr]
b [Expr]
e ([(Indent, Line)] -> [(Indent, Line)]
rev [(Indent, Line)]
body))
      rev' (Indent
i, CtrlMaybe AltFlag
flg [Expr]
b [Expr]
e [(Indent, Line)]
body [(Indent, Line)]
alt)
          = (Indent
i, AltFlag
-> [Expr] -> [Expr] -> [(Indent, Line)] -> [(Indent, Line)] -> Line
CtrlMaybe AltFlag
flg [Expr]
b [Expr]
e ([(Indent, Line)] -> [(Indent, Line)]
rev [(Indent, Line)]
body) ([(Indent, Line)] -> [(Indent, Line)]
rev [(Indent, Line)]
alt))
      rev' (Indent
i, CtrlIf AltFlag
flg [Expr]
e [(Indent, Line)]
body [(Indent, Line)]
alt)
          = (Indent
i, AltFlag -> [Expr] -> [(Indent, Line)] -> [(Indent, Line)] -> Line
CtrlIf AltFlag
flg [Expr]
e ([(Indent, Line)] -> [(Indent, Line)]
rev [(Indent, Line)]
body) ([(Indent, Line)] -> [(Indent, Line)]
rev [(Indent, Line)]
alt))
      rev' (Indent
i, CtrlCase [Expr]
e [([Expr], [(Indent, Line)])]
alts)
          = (Indent
i, [Expr] -> [([Expr], [(Indent, Line)])] -> Line
CtrlCase [Expr]
e ((([Expr], [(Indent, Line)]) -> ([Expr], [(Indent, Line)]))
-> [([Expr], [(Indent, Line)])] -> [([Expr], [(Indent, Line)])]
forall a b. (a -> b) -> [a] -> [b]
map ([Expr] -> [Expr]
forall a. a -> a
id ([Expr] -> [Expr])
-> ([(Indent, Line)] -> [(Indent, Line)])
-> ([Expr], [(Indent, Line)])
-> ([Expr], [(Indent, Line)])
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** [(Indent, Line)] -> [(Indent, Line)]
rev) ([([Expr], [(Indent, Line)])] -> [([Expr], [(Indent, Line)])])
-> [([Expr], [(Indent, Line)])] -> [([Expr], [(Indent, Line)])]
forall a b. (a -> b) -> a -> b
$ [([Expr], [(Indent, Line)])] -> [([Expr], [(Indent, Line)])]
forall a. [a] -> [a]
reverse [([Expr], [(Indent, Line)])]
alts))

      norm :: [Line'] -> [Line']
      norm :: [(Indent, Line)] -> [(Indent, Line)]
norm = ((Indent, Line) -> [(Indent, Line)] -> [(Indent, Line)])
-> [(Indent, Line)] -> [(Indent, Line)] -> [(Indent, Line)]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Indent, Line)
x [(Indent, Line)]
xs -> (Indent, Line) -> (Indent, Line)
norm' (Indent, Line)
x(Indent, Line) -> [(Indent, Line)] -> [(Indent, Line)]
forall a. a -> [a] -> [a]
:[(Indent, Line)]
xs) []
      norm' :: Line' -> Line'
      norm' :: (Indent, Line) -> (Indent, Line)
norm' x :: (Indent, Line)
x@(Indent
_, Normal [InLine]
_) = (Indent, Line)
x
      norm' (Indent
i, CtrlForall [Expr]
b [Expr]
e [(Indent, Line)]
body)
          = (Indent
i, [Expr] -> [Expr] -> [(Indent, Line)] -> Line
CtrlForall [Expr]
b [Expr]
e (Indent -> [(Indent, Line)] -> [(Indent, Line)]
normsub Indent
i [(Indent, Line)]
body [(Indent, Line)] -> [(Indent, Line)] -> [(Indent, Line)]
forall a. [a] -> [a] -> [a]
++ [(Indent, Line)]
blockEnd))
      norm' (Indent
i, CtrlLet [Expr]
b [Expr]
e [(Indent, Line)]
body)
          = (Indent
i, [Expr] -> [Expr] -> [(Indent, Line)] -> Line
CtrlLet [Expr]
b [Expr]
e (Indent -> [(Indent, Line)] -> [(Indent, Line)]
normsub Indent
i [(Indent, Line)]
body [(Indent, Line)] -> [(Indent, Line)] -> [(Indent, Line)]
forall a. [a] -> [a] -> [a]
++ [(Indent, Line)]
blockEnd))
      norm' (Indent
i, CtrlMaybe AltFlag
flg [Expr]
b [Expr]
e [(Indent, Line)]
body [(Indent, Line)]
alt)
          = (Indent
i, AltFlag
-> [Expr] -> [Expr] -> [(Indent, Line)] -> [(Indent, Line)] -> Line
CtrlMaybe AltFlag
flg [Expr]
b [Expr]
e (Indent -> [(Indent, Line)] -> [(Indent, Line)]
normsub Indent
i [(Indent, Line)]
body [(Indent, Line)] -> [(Indent, Line)] -> [(Indent, Line)]
forall a. [a] -> [a] -> [a]
++ [(Indent, Line)]
blockEnd) (Indent -> [(Indent, Line)] -> [(Indent, Line)]
normsub Indent
i [(Indent, Line)]
alt [(Indent, Line)] -> [(Indent, Line)] -> [(Indent, Line)]
forall a. [a] -> [a] -> [a]
++ [(Indent, Line)]
blockEnd))
      norm' (Indent
i, Line
CtrlNothing) = String -> (Indent, Line)
forall a. HasCallStack => String -> a
error String
"orphan $nothing found"
      norm' (Indent
i, CtrlIf AltFlag
flg [Expr]
e [(Indent, Line)]
body [(Indent, Line)]
alt)
          = (Indent
i, AltFlag -> [Expr] -> [(Indent, Line)] -> [(Indent, Line)] -> Line
CtrlIf AltFlag
flg [Expr]
e (Indent -> [(Indent, Line)] -> [(Indent, Line)]
normsub Indent
i [(Indent, Line)]
body [(Indent, Line)] -> [(Indent, Line)] -> [(Indent, Line)]
forall a. [a] -> [a] -> [a]
++ [(Indent, Line)]
blockEnd) (Indent -> [(Indent, Line)] -> [(Indent, Line)]
normsub Indent
i [(Indent, Line)]
alt [(Indent, Line)] -> [(Indent, Line)] -> [(Indent, Line)]
forall a. [a] -> [a] -> [a]
++ [(Indent, Line)]
blockEnd))
      norm' (Indent
i, Line
CtrlElse) = String -> (Indent, Line)
forall a. HasCallStack => String -> a
error String
"orphan $else found"
      norm' (Indent
i, CtrlCase [Expr]
e [([Expr], [(Indent, Line)])]
alts)
          = (Indent
i, [Expr] -> [([Expr], [(Indent, Line)])] -> Line
CtrlCase [Expr]
e ((([Expr], [(Indent, Line)]) -> ([Expr], [(Indent, Line)]))
-> [([Expr], [(Indent, Line)])] -> [([Expr], [(Indent, Line)])]
forall a b. (a -> b) -> [a] -> [b]
map ([Expr] -> [Expr]
forall a. a -> a
id ([Expr] -> [Expr])
-> ([(Indent, Line)] -> [(Indent, Line)])
-> ([Expr], [(Indent, Line)])
-> ([Expr], [(Indent, Line)])
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** ([(Indent, Line)] -> [(Indent, Line)] -> [(Indent, Line)]
forall a. [a] -> [a] -> [a]
++ [(Indent, Line)]
blockEnd) ([(Indent, Line)] -> [(Indent, Line)])
-> ([(Indent, Line)] -> [(Indent, Line)])
-> [(Indent, Line)]
-> [(Indent, Line)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Indent -> [(Indent, Line)] -> [(Indent, Line)]
normsub Indent
i) [([Expr], [(Indent, Line)])]
alts))
      norm' (Indent
i, CtrlOf [Expr]
_) = String -> (Indent, Line)
forall a. HasCallStack => String -> a
error String
"orphan $of found"

      normsub :: Indent -> [Line'] -> [Line']
      normsub :: Indent -> [(Indent, Line)] -> [(Indent, Line)]
normsub Indent
i [(Indent, Line)]
body = let j :: Indent
j = [Indent] -> Indent
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([Indent] -> Indent) -> [Indent] -> Indent
forall a b. (a -> b) -> a -> b
$ ((Indent, Line) -> Indent) -> [(Indent, Line)] -> [Indent]
forall a b. (a -> b) -> [a] -> [b]
map (Indent, Line) -> Indent
forall a b. (a, b) -> a
fst [(Indent, Line)]
body
                           deIndent :: Indent -> Indent
deIndent Indent
n = Indent
iIndent -> Indent -> Indent
forall a. Num a => a -> a -> a
+(Indent
nIndent -> Indent -> Indent
forall a. Num a => a -> a -> a
-Indent
j)
                       in [(Indent, Line)] -> [(Indent, Line)]
norm ([(Indent, Line)] -> [(Indent, Line)])
-> [(Indent, Line)] -> [(Indent, Line)]
forall a b. (a -> b) -> a -> b
$ ((Indent, Line) -> (Indent, Line))
-> [(Indent, Line)] -> [(Indent, Line)]
forall a b. (a -> b) -> [a] -> [b]
map (Indent -> Indent
deIndent (Indent -> Indent)
-> (Line -> Line) -> (Indent, Line) -> (Indent, Line)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** Line -> Line
forall a. a -> a
id) [(Indent, Line)]
body

      blockEnd :: [Line']
      blockEnd :: [(Indent, Line)]
blockEnd = [(Indent
0, [InLine] -> Line
Normal [])]

class ToQPat a where
    toQPat :: a -> Q Pat
    concatToQPat :: [a] -> Q Pat

instance ToQPat Expr where
    toQPat :: Expr -> Q Pat
toQPat (S String
s) = Lit -> Q Pat
litP (String -> Lit
stringL String
s)
    toQPat (I Integer
i) = Lit -> Q Pat
litP (Integer -> Lit
integerL Integer
i)
    toQPat Expr
W     = Q Pat
wildP
    toQPat (V String
v) = Name -> Q Pat
varP (String -> Name
mkName String
v)
    toQPat (O String
o) = Name -> Q Pat
varP (String -> Name
mkName String
o)
    toQPat (E [Expr]
e) = [Expr] -> Q Pat
forall a. ToQPat a => [a] -> Q Pat
concatToQPat [Expr]
e
    toQPat (C String
c) = Name -> [Q Pat] -> Q Pat
conP (String -> Name
mkName String
c) []
    toQPat (T [[Expr]]
t) = [Q Pat] -> Q Pat
tupP ([Q Pat] -> Q Pat) -> [Q Pat] -> Q Pat
forall a b. (a -> b) -> a -> b
$ ([Expr] -> Q Pat) -> [[Expr]] -> [Q Pat]
forall a b. (a -> b) -> [a] -> [b]
map [Expr] -> Q Pat
forall a. ToQPat a => [a] -> Q Pat
concatToQPat [[Expr]]
t
    toQPat (A String
a Expr
e) = Name -> Q Pat -> Q Pat
asP (String -> Name
mkName String
a) (Q Pat -> Q Pat) -> Q Pat -> Q Pat
forall a b. (a -> b) -> a -> b
$ Expr -> Q Pat
forall a. ToQPat a => a -> Q Pat
toQPat Expr
e

    -- special case for list
    concatToQPat :: [Expr] -> Q Pat
concatToQPat (Expr
x:O String
":":[Expr]
xs) = Q Pat -> Name -> Q Pat -> Q Pat
infixP (Expr -> Q Pat
forall a. ToQPat a => a -> Q Pat
toQPat Expr
x)
                                       (String -> Name
mkName String
":")
                                       ([Expr] -> Q Pat
forall a. ToQPat a => [a] -> Q Pat
concatToQPat [Expr]
xs)
    concatToQPat ((C String
c):[Expr]
args) = Name -> [Q Pat] -> Q Pat
conP (String -> Name
mkName String
c) ([Q Pat] -> Q Pat) -> [Q Pat] -> Q Pat
forall a b. (a -> b) -> a -> b
$ (Expr -> Q Pat) -> [Expr] -> [Q Pat]
forall a b. (a -> b) -> [a] -> [b]
map Expr -> Q Pat
forall a. ToQPat a => a -> Q Pat
toQPat [Expr]
args
    concatToQPat ((V String
v):[Expr]
args) = Name -> Q Pat
varP (String -> Name
mkName String
v) -- OK?
    concatToQPat (p :: Expr
p@(T [[Expr]]
t):[]) = Expr -> Q Pat
forall a. ToQPat a => a -> Q Pat
toQPat Expr
p -- OK?
    concatToQPat (Expr
W:[]) = Q Pat
wildP -- OK?
    concatToQPat (p :: Expr
p@(A String
_ Expr
_):[]) = Expr -> Q Pat
forall a. ToQPat a => a -> Q Pat
toQPat Expr
p
    concatToQPat [Expr]
_ = String -> Q Pat
forall a. HasCallStack => String -> a
error String
"don't support this pattern"

class ToQExp a where
    toQExp :: a -> Q Exp
    concatToQExp :: [a] -> Q Exp

instance ToQExp Expr where
    toQExp :: Expr -> Q Exp
toQExp (S String
s) = Lit -> Q Exp
litE (String -> Lit
stringL String
s)
    toQExp (I Integer
i) = Lit -> Q Exp
litE (Integer -> Lit
integerL Integer
i)
    toQExp Expr
W     = String -> Q Exp
forall a. HasCallStack => String -> a
error String
"wildcard is NOT legal expression"
    toQExp (V String
v) = Name -> Q Exp
varE (String -> Name
mkName String
v)
    toQExp (O String
o) = Name -> Q Exp
varE (String -> Name
mkName String
o)
    toQExp (E [Expr]
e) = [Expr] -> Q Exp
forall a. ToQExp a => [a] -> Q Exp
concatToQExp [Expr]
e
    toQExp (C String
c) = Name -> Q Exp
conE (String -> Name
mkName String
c)
    toQExp (T [[Expr]]
t) = [Q Exp] -> Q Exp
tupE ([Q Exp] -> Q Exp) -> [Q Exp] -> Q Exp
forall a b. (a -> b) -> a -> b
$ ([Expr] -> Q Exp) -> [[Expr]] -> [Q Exp]
forall a b. (a -> b) -> [a] -> [b]
map [Expr] -> Q Exp
forall a. ToQExp a => [a] -> Q Exp
concatToQExp [[Expr]]
t
    toQExp Expr
N     = [Q Exp] -> Q Exp
listE []
    toQExp (L [[Expr]]
l) = [Q Exp] -> Q Exp
listE ([Q Exp] -> Q Exp) -> [Q Exp] -> Q Exp
forall a b. (a -> b) -> a -> b
$ ([Expr] -> Q Exp) -> [[Expr]] -> [Q Exp]
forall a b. (a -> b) -> [a] -> [b]
map [Expr] -> Q Exp
forall a. ToQExp a => [a] -> Q Exp
concatToQExp [[Expr]]
l

    concatToQExp :: [Expr] -> Q Exp
concatToQExp [Expr]
xs = Maybe (Q Exp) -> [Expr] -> Q Exp
concatToQ' Maybe (Q Exp)
forall a. Maybe a
Nothing [Expr]
xs
        where
          concatToQ' :: Maybe (Q Exp) -> [Expr] -> Q Exp
concatToQ' (Just Q Exp
acc) [] = Q Exp
acc
          concatToQ' Maybe (Q Exp)
Nothing  [Expr
x] = Expr -> Q Exp
forall a. ToQExp a => a -> Q Exp
toQExp Expr
x
          concatToQ' Maybe (Q Exp)
Nothing (Expr
x:[Expr]
xs) = Maybe (Q Exp) -> [Expr] -> Q Exp
concatToQ' (Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just (Expr -> Q Exp
forall a. ToQExp a => a -> Q Exp
toQExp Expr
x)) [Expr]
xs
          -- spacial case for list
          concatToQ' (Just Q Exp
acc) ((O String
":"):[Expr]
xs)
              = Maybe (Q Exp) -> Q Exp -> Maybe (Q Exp) -> Q Exp
infixE (Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just Q Exp
acc)
                       (Name -> Q Exp
conE (String -> Name
mkName String
":"))
                       (Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just ([Expr] -> Q Exp
forall a. ToQExp a => [a] -> Q Exp
concatToQExp [Expr]
xs))
          concatToQ' (Just Q Exp
acc) ((O String
o):[Expr]
xs)
              = Maybe (Q Exp) -> Q Exp -> Maybe (Q Exp) -> Q Exp
infixE (Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just Q Exp
acc)
                       (Name -> Q Exp
varE (String -> Name
mkName String
o))
                       (Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just ([Expr] -> Q Exp
forall a. ToQExp a => [a] -> Q Exp
concatToQExp [Expr]
xs))
          concatToQ' (Just Q Exp
acc) ((V' String
v'):[Expr]
xs)
              = Maybe (Q Exp) -> Q Exp -> Maybe (Q Exp) -> Q Exp
infixE (Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just Q Exp
acc)
                       (Name -> Q Exp
varE (String -> Name
mkName String
v'))
                       (Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just ([Expr] -> Q Exp
forall a. ToQExp a => [a] -> Q Exp
concatToQExp [Expr]
xs))
          concatToQ' (Just Q Exp
acc) (Expr
x:[Expr]
xs)
              = Maybe (Q Exp) -> [Expr] -> Q Exp
concatToQ' (Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just (Q Exp -> Q Exp -> Q Exp
appE Q Exp
acc (Expr -> Q Exp
forall a. ToQExp a => a -> Q Exp
toQExp Expr
x))) [Expr]
xs

instance ToQExp InLine where
    toQExp :: InLine -> Q Exp
toQExp (Raw String
s) = Lit -> Q Exp
litE (String -> Lit
stringL String
s)
    toQExp (Quoted [Expr]
expr) = [Expr] -> Q Exp
forall a. ToQExp a => [a] -> Q Exp
concatToQExp [Expr]
expr

    concatToQExp :: [InLine] -> Q Exp
concatToQExp [] = Lit -> Q Exp
litE (String -> Lit
stringL String
"")
    concatToQExp (InLine
x:[InLine]
xs) = Maybe (Q Exp) -> Q Exp -> Maybe (Q Exp) -> Q Exp
infixE (Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just (InLine -> Q Exp
forall a. ToQExp a => a -> Q Exp
toQExp InLine
x))
                                 (Name -> Q Exp
varE '(<>))
                                 (Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just ([InLine] -> Q Exp
forall a. ToQExp a => [a] -> Q Exp
concatToQExp [InLine]
xs))

instance ToQExp Line where
    toQExp :: Line -> Q Exp
toQExp (CtrlForall [Expr]
b [Expr]
e [(Indent, Line)]
body)
        = Q Exp -> Q Exp -> Q Exp
appE (Q Exp -> Q Exp -> Q Exp
appE (Q Exp -> Q Exp -> Q Exp
appE (Name -> Q Exp
varE 'foldr)
                           ([Q Pat] -> Q Exp -> Q Exp
lamE [[Expr] -> Q Pat
forall a. ToQPat a => [a] -> Q Pat
concatToQPat [Expr]
b]
                                 (Maybe (Q Exp) -> Q Exp -> Maybe (Q Exp) -> Q Exp
infixE (Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just ([(Indent, Line)] -> Q Exp
forall a. ToQExp a => [a] -> Q Exp
concatToQExp [(Indent, Line)]
body))
                                         (Name -> Q Exp
varE '(<>))
                                         Maybe (Q Exp)
forall a. Maybe a
Nothing)))
                (Lit -> Q Exp
litE (String -> Lit
stringL String
"")))
          ([Expr] -> Q Exp
forall a. ToQExp a => [a] -> Q Exp
concatToQExp [Expr]
e)
    toQExp (CtrlMaybe AltFlag
flg [Expr]
b [Expr]
e [(Indent, Line)]
body [(Indent, Line)]
alt)
        = Q Exp -> [MatchQ] -> Q Exp
caseE ([Expr] -> Q Exp
forall a. ToQExp a => [a] -> Q Exp
concatToQExp [Expr]
e)
                [ Q Pat -> BodyQ -> [DecQ] -> MatchQ
match (Name -> [Q Pat] -> Q Pat
conP 'Just [[Expr] -> Q Pat
forall a. ToQPat a => [a] -> Q Pat
concatToQPat [Expr]
b])
                        (Q Exp -> BodyQ
normalB ([(Indent, Line)] -> Q Exp
forall a. ToQExp a => [a] -> Q Exp
concatToQExp [(Indent, Line)]
body))
                        []
                , Q Pat -> BodyQ -> [DecQ] -> MatchQ
match (Name -> [Q Pat] -> Q Pat
conP 'Nothing [])
                        (Q Exp -> BodyQ
normalB ([(Indent, Line)] -> Q Exp
forall a. ToQExp a => [a] -> Q Exp
concatToQExp [(Indent, Line)]
alt))
                         []
                ]
    toQExp (CtrlIf AltFlag
flg [Expr]
e [(Indent, Line)]
body [(Indent, Line)]
alt)
        = Q Exp -> Q Exp -> Q Exp -> Q Exp
condE ([Expr] -> Q Exp
forall a. ToQExp a => [a] -> Q Exp
concatToQExp [Expr]
e) ([(Indent, Line)] -> Q Exp
forall a. ToQExp a => [a] -> Q Exp
concatToQExp [(Indent, Line)]
body) ([(Indent, Line)] -> Q Exp
forall a. ToQExp a => [a] -> Q Exp
concatToQExp [(Indent, Line)]
alt)
    toQExp Line
CtrlElse = String -> Q Exp
forall a. HasCallStack => String -> a
error String
"illegal $else found"
    toQExp (CtrlCase [Expr]
e [([Expr], [(Indent, Line)])]
alts)
        = Q Exp -> [MatchQ] -> Q Exp
caseE ([Expr] -> Q Exp
forall a. ToQExp a => [a] -> Q Exp
concatToQExp [Expr]
e) ((([Expr], [(Indent, Line)]) -> MatchQ)
-> [([Expr], [(Indent, Line)])] -> [MatchQ]
forall a b. (a -> b) -> [a] -> [b]
map ([Expr], [(Indent, Line)]) -> MatchQ
forall a a. (ToQPat a, ToQExp a) => ([a], [a]) -> MatchQ
mkMatch [([Expr], [(Indent, Line)])]
alts)
        where
          mkMatch :: ([a], [a]) -> MatchQ
mkMatch ([a]
e', [a]
body) = Q Pat -> BodyQ -> [DecQ] -> MatchQ
match ([a] -> Q Pat
forall a. ToQPat a => [a] -> Q Pat
concatToQPat [a]
e')
                                     (Q Exp -> BodyQ
normalB ([a] -> Q Exp
forall a. ToQExp a => [a] -> Q Exp
concatToQExp [a]
body))
                                     []
    toQExp (CtrlOf [Expr]
e) = String -> Q Exp
forall a. HasCallStack => String -> a
error String
"illegal $of found"
    toQExp (CtrlLet [Expr]
b [Expr]
e [(Indent, Line)]
body)
        = [DecQ] -> Q Exp -> Q Exp
letE [Q Pat -> BodyQ -> [DecQ] -> DecQ
valD ([Expr] -> Q Pat
forall a. ToQPat a => [a] -> Q Pat
concatToQPat [Expr]
b) (Q Exp -> BodyQ
normalB (Q Exp -> BodyQ) -> Q Exp -> BodyQ
forall a b. (a -> b) -> a -> b
$ [Expr] -> Q Exp
forall a. ToQExp a => [a] -> Q Exp
concatToQExp [Expr]
e) []]
               ([(Indent, Line)] -> Q Exp
forall a. ToQExp a => [a] -> Q Exp
concatToQExp [(Indent, Line)]
body)
    toQExp (Normal [InLine]
xs) = [InLine] -> Q Exp
forall a. ToQExp a => [a] -> Q Exp
concatToQExp [InLine]
xs

    concatToQExp :: [Line] -> Q Exp
concatToQExp (Line
x:[]) = Line -> Q Exp
forall a. ToQExp a => a -> Q Exp
toQExp Line
x
    concatToQExp (Line
x:[Line]
xs) = Maybe (Q Exp) -> Q Exp -> Maybe (Q Exp) -> Q Exp
infixE (Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just (Line -> Q Exp
forall a. ToQExp a => a -> Q Exp
toQExp Line
x))
                                 (Name -> Q Exp
varE '(<>))
                                 (Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just ([Line] -> Q Exp
forall a. ToQExp a => [a] -> Q Exp
concatToQExp [Line]
xs))

instance ToQExp Line' where
    toQExp :: (Indent, Line) -> Q Exp
toQExp (Indent
n, x :: Line
x@(Normal [InLine]
_))
        = Maybe (Q Exp) -> Q Exp -> Maybe (Q Exp) -> Q Exp
infixE (Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just (Lit -> Q Exp
litE (String -> Lit
stringL (Indent -> Char -> String
forall a. Indent -> a -> [a]
replicate Indent
n Char
' '))))
                 (Name -> Q Exp
varE '(<>))
                 (Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just (Line -> Q Exp
forall a. ToQExp a => a -> Q Exp
toQExp Line
x))
    toQExp (Indent
n, Line
x) =  Line -> Q Exp
forall a. ToQExp a => a -> Q Exp
toQExp Line
x -- Ctrl*

    concatToQExp :: [(Indent, Line)] -> Q Exp
concatToQExp [] = Lit -> Q Exp
litE (String -> Lit
stringL String
"")
    concatToQExp (x :: (Indent, Line)
x@(Indent
_, Normal [InLine]
_):(Indent, Line)
y:[(Indent, Line)]
ys)
        = Maybe (Q Exp) -> Q Exp -> Maybe (Q Exp) -> Q Exp
infixE (Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just (Maybe (Q Exp) -> Q Exp -> Maybe (Q Exp) -> Q Exp
infixE (Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just ((Indent, Line) -> Q Exp
forall a. ToQExp a => a -> Q Exp
toQExp (Indent, Line)
x))
                               (Name -> Q Exp
varE '(<>))
                               (Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just (Lit -> Q Exp
litE (String -> Lit
stringL String
"\n")))))
                 (Name -> Q Exp
varE '(<>))
                 (Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just ([(Indent, Line)] -> Q Exp
forall a. ToQExp a => [a] -> Q Exp
concatToQExp ((Indent, Line)
y(Indent, Line) -> [(Indent, Line)] -> [(Indent, Line)]
forall a. a -> [a] -> [a]
:[(Indent, Line)]
ys)))
    concatToQExp (x :: (Indent, Line)
x@(Indent
_, Normal [InLine]
_):[(Indent, Line)]
xs)
        = Maybe (Q Exp) -> Q Exp -> Maybe (Q Exp) -> Q Exp
infixE (Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just ((Indent, Line) -> Q Exp
forall a. ToQExp a => a -> Q Exp
toQExp (Indent, Line)
x))
                 (Name -> Q Exp
varE '(<>))
                 (Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just ([(Indent, Line)] -> Q Exp
forall a. ToQExp a => [a] -> Q Exp
concatToQExp [(Indent, Line)]
xs))
    concatToQExp ((Indent, Line)
x:[(Indent, Line)]
xs) = Maybe (Q Exp) -> Q Exp -> Maybe (Q Exp) -> Q Exp
infixE (Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just ((Indent, Line) -> Q Exp
forall a. ToQExp a => a -> Q Exp
toQExp (Indent, Line)
x))
                                 (Name -> Q Exp
varE '(<>))
                                 (Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just ([(Indent, Line)] -> Q Exp
forall a. ToQExp a => [a] -> Q Exp
concatToQExp [(Indent, Line)]
xs))