{-# LANGUAGE TupleSections, DeriveGeneric, OverloadedStrings, CPP #-}
module Sugar
  ( Sugar(..)
  , Wrap(..)
  , Note
  , FromSugar(..)
  , ToSugar(..)
  , sugarTextMay
  , readSugarFromFile
  , readSugarListFromFile
  , parseSugarFromText
  , parseSugarListFromText
  , prettyPrintSugarIO
  , prettyPrintSugar
  ) where

import Control.Applicative (Alternative(..))
import Data.Void (Void)
import Data.Text (Text)
import Data.Map (Map)
import Data.Maybe (isNothing)
import Data.Text.Conversions (ToText(..), fromText, unUTF8, decodeConvertText, UTF8(..))
import Data.String (IsString(..))
import Data.Word (Word8,Word16,Word32,Word64)
import Data.Int (Int8,Int16,Int32,Int64)
import Data.Char (isSeparator)
import GHC.Generics (Generic)
import TextShow (TextShow, showt)

import qualified Data.Map as Map
import qualified Data.Serialize as Serialize
import qualified Data.ByteString as BS
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import qualified Text.Megaparsec as P
import qualified Text.Megaparsec.Char as P
import qualified Text.Megaparsec.Char.Lexer as L

---

data Sugar
  = Sugar'Unit Note
  | Sugar'Text Text Note
  | Sugar'List [Sugar] Wrap Note
  | Sugar'Map [(Sugar,Sugar)] Note
  deriving (Sugar -> Sugar -> Bool
(Sugar -> Sugar -> Bool) -> (Sugar -> Sugar -> Bool) -> Eq Sugar
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Sugar -> Sugar -> Bool
$c/= :: Sugar -> Sugar -> Bool
== :: Sugar -> Sugar -> Bool
$c== :: Sugar -> Sugar -> Bool
Eq, Int -> Sugar -> ShowS
[Sugar] -> ShowS
Sugar -> String
(Int -> Sugar -> ShowS)
-> (Sugar -> String) -> ([Sugar] -> ShowS) -> Show Sugar
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Sugar] -> ShowS
$cshowList :: [Sugar] -> ShowS
show :: Sugar -> String
$cshow :: Sugar -> String
showsPrec :: Int -> Sugar -> ShowS
$cshowsPrec :: Int -> Sugar -> ShowS
Show, (forall x. Sugar -> Rep Sugar x)
-> (forall x. Rep Sugar x -> Sugar) -> Generic Sugar
forall x. Rep Sugar x -> Sugar
forall x. Sugar -> Rep Sugar x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Sugar x -> Sugar
$cfrom :: forall x. Sugar -> Rep Sugar x
Generic)
  
data Wrap
  = Wrap'Square
  | Wrap'Paren
  deriving (Wrap -> Wrap -> Bool
(Wrap -> Wrap -> Bool) -> (Wrap -> Wrap -> Bool) -> Eq Wrap
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Wrap -> Wrap -> Bool
$c/= :: Wrap -> Wrap -> Bool
== :: Wrap -> Wrap -> Bool
$c== :: Wrap -> Wrap -> Bool
Eq, Int -> Wrap -> ShowS
[Wrap] -> ShowS
Wrap -> String
(Int -> Wrap -> ShowS)
-> (Wrap -> String) -> ([Wrap] -> ShowS) -> Show Wrap
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Wrap] -> ShowS
$cshowList :: [Wrap] -> ShowS
show :: Wrap -> String
$cshow :: Wrap -> String
showsPrec :: Int -> Wrap -> ShowS
$cshowsPrec :: Int -> Wrap -> ShowS
Show, (forall x. Wrap -> Rep Wrap x)
-> (forall x. Rep Wrap x -> Wrap) -> Generic Wrap
forall x. Rep Wrap x -> Wrap
forall x. Wrap -> Rep Wrap x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Wrap x -> Wrap
$cfrom :: forall x. Wrap -> Rep Wrap x
Generic)
  
type Note = Maybe Sugar
  
--

instance Serialize.Serialize Sugar where
  get :: Get Sugar
get = do
    Word8
tag <- Get Word8
Serialize.getWord8
    Word8 -> Get Sugar
go Word8
tag
    where
      go :: Word8 -> Serialize.Get Sugar
      go :: Word8 -> Get Sugar
go Word8
0 = Note -> Sugar
Sugar'Unit (Note -> Sugar) -> Get Note -> Get Sugar
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Note
forall t. Serialize t => Get t
Serialize.get
      go Word8
1 = Text -> Note -> Sugar
Sugar'Text (Text -> Note -> Sugar) -> Get Text -> Get (Note -> Sugar)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Text
getSerializedText Get (Note -> Sugar) -> Get Note -> Get Sugar
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Note
forall t. Serialize t => Get t
Serialize.get
      go Word8
2 = [Sugar] -> Wrap -> Note -> Sugar
Sugar'List ([Sugar] -> Wrap -> Note -> Sugar)
-> Get [Sugar] -> Get (Wrap -> Note -> Sugar)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [Sugar]
forall t. Serialize t => Get t
Serialize.get Get (Wrap -> Note -> Sugar) -> Get Wrap -> Get (Note -> Sugar)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Wrap
forall t. Serialize t => Get t
Serialize.get Get (Note -> Sugar) -> Get Note -> Get Sugar
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Note
forall t. Serialize t => Get t
Serialize.get
      go Word8
3 = [(Sugar, Sugar)] -> Note -> Sugar
Sugar'Map ([(Sugar, Sugar)] -> Note -> Sugar)
-> Get [(Sugar, Sugar)] -> Get (Note -> Sugar)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [(Sugar, Sugar)]
forall t. Serialize t => Get t
Serialize.get Get (Note -> Sugar) -> Get Note -> Get Sugar
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Note
forall t. Serialize t => Get t
Serialize.get
      go Word8
_ = String -> Get Sugar
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"No matching Sugar value"
      
      getSerializedText :: Serialize.Get Text
      getSerializedText :: Get Text
getSerializedText = do
        Maybe Text
txt <- (UTF8 ByteString -> Maybe Text
forall (f :: * -> *) a b. (DecodeText f a, FromText b) => a -> f b
decodeConvertText (UTF8 ByteString -> Maybe Text)
-> (ByteString -> UTF8 ByteString) -> ByteString -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> UTF8 ByteString
forall a. a -> UTF8 a
UTF8) (ByteString -> Maybe Text) -> Get ByteString -> Get (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Get ByteString
forall t. Serialize t => Get t
Serialize.get :: Serialize.Get BS.ByteString)
        Get Text -> (Text -> Get Text) -> Maybe Text -> Get Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Get Text
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Cannot deserialize text as UTF8") Text -> Get Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
txt
  
  put :: Putter Sugar
put (Sugar'Unit Note
note) = do
    Putter Word8
forall t. Serialize t => Putter t
Serialize.put (Word8
0 :: Word8)
    Putter Note
forall t. Serialize t => Putter t
Serialize.put Note
note
  put (Sugar'Text Text
txt Note
note) = do
    Putter Word8
forall t. Serialize t => Putter t
Serialize.put (Word8
1 :: Word8)
    Putter ByteString
forall t. Serialize t => Putter t
Serialize.put (UTF8 ByteString -> ByteString
forall a. UTF8 a -> a
unUTF8 (UTF8 ByteString -> ByteString) -> UTF8 ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> UTF8 ByteString
forall a. FromText a => Text -> a
fromText Text
txt :: BS.ByteString)
    Putter Note
forall t. Serialize t => Putter t
Serialize.put Note
note
  put (Sugar'List [Sugar]
xs Wrap
w Note
note) = do
    Putter Word8
forall t. Serialize t => Putter t
Serialize.put (Word8
2 :: Word8)
    Putter [Sugar]
forall t. Serialize t => Putter t
Serialize.put [Sugar]
xs
    Putter Wrap
forall t. Serialize t => Putter t
Serialize.put Wrap
w
    Putter Note
forall t. Serialize t => Putter t
Serialize.put Note
note
  put (Sugar'Map [(Sugar, Sugar)]
m Note
note) = do
    Putter Word8
forall t. Serialize t => Putter t
Serialize.put (Word8
3 :: Word8)
    Putter [(Sugar, Sugar)]
forall t. Serialize t => Putter t
Serialize.put [(Sugar, Sugar)]
m
    Putter Note
forall t. Serialize t => Putter t
Serialize.put Note
note  

instance Serialize.Serialize Wrap where

instance IsString Sugar where
  fromString :: String -> Sugar
fromString String
str = Text -> Note -> Sugar
Sugar'Text (String -> Text
forall a. ToText a => a -> Text
toText String
str) Note
forall a. Maybe a
Nothing

--

class FromSugar a where
  parseSugar :: Sugar -> Maybe a
  
instance FromSugar a => FromSugar [a] where
  parseSugar :: Sugar -> Maybe [a]
parseSugar (Sugar'List [Sugar]
xs Wrap
_ Note
_) = (Sugar -> Maybe a) -> [Sugar] -> Maybe [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Sugar -> Maybe a
forall a. FromSugar a => Sugar -> Maybe a
parseSugar [Sugar]
xs
  parseSugar Sugar
_ = Maybe [a]
forall a. Maybe a
Nothing

sugarTextMay :: Sugar -> Maybe Text
sugarTextMay :: Sugar -> Maybe Text
sugarTextMay (Sugar'Text Text
t Note
_) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t
sugarTextMay Sugar
_ = Maybe Text
forall a. Maybe a
Nothing

--

class ToSugar a where
  toSugar :: a -> Sugar

instance ToSugar () where
  toSugar :: () -> Sugar
toSugar () = Note -> Sugar
Sugar'Unit Note
forall a. Maybe a
Nothing

instance ToSugar Text where
  toSugar :: Text -> Sugar
toSugar Text
t = Text -> Note -> Sugar
Sugar'Text Text
t Note
forall a. Maybe a
Nothing

-- TODO: Review this if it causes problems in the REPL
instance ToSugar a => ToSugar [a] where
  toSugar :: [a] -> Sugar
toSugar [a]
xs = [Sugar] -> Wrap -> Note -> Sugar
Sugar'List ((a -> Sugar) -> [a] -> [Sugar]
forall a b. (a -> b) -> [a] -> [b]
map a -> Sugar
forall a. ToSugar a => a -> Sugar
toSugar [a]
xs) Wrap
Wrap'Square Note
forall a. Maybe a
Nothing

instance (ToSugar a, ToSugar b) => ToSugar (Map a b) where
  toSugar :: Map a b -> Sugar
toSugar Map a b
m = [(Sugar, Sugar)] -> Note -> Sugar
Sugar'Map (((a, b) -> (Sugar, Sugar)) -> [(a, b)] -> [(Sugar, Sugar)]
forall a b. (a -> b) -> [a] -> [b]
map (\(a
k,b
v) -> (a -> Sugar
forall a. ToSugar a => a -> Sugar
toSugar a
k, b -> Sugar
forall a. ToSugar a => a -> Sugar
toSugar b
v)) ([(a, b)] -> [(Sugar, Sugar)]) -> [(a, b)] -> [(Sugar, Sugar)]
forall a b. (a -> b) -> a -> b
$ Map a b -> [(a, b)]
forall k a. Map k a -> [(k, a)]
Map.toList Map a b
m) Note
forall a. Maybe a
Nothing
  
instance (ToSugar a, ToSugar b) => ToSugar (a,b) where
  toSugar :: (a, b) -> Sugar
toSugar (a
a,b
b) = [Sugar] -> Wrap -> Note -> Sugar
Sugar'List [a -> Sugar
forall a. ToSugar a => a -> Sugar
toSugar a
a, b -> Sugar
forall a. ToSugar a => a -> Sugar
toSugar b
b] Wrap
Wrap'Paren Note
forall a. Maybe a
Nothing

instance (ToSugar a, ToSugar b, ToSugar c) => ToSugar (a,b,c) where
  toSugar :: (a, b, c) -> Sugar
toSugar (a
a,b
b,c
c) = [Sugar] -> Wrap -> Note -> Sugar
Sugar'List [a -> Sugar
forall a. ToSugar a => a -> Sugar
toSugar a
a, b -> Sugar
forall a. ToSugar a => a -> Sugar
toSugar b
b, c -> Sugar
forall a. ToSugar a => a -> Sugar
toSugar c
c] Wrap
Wrap'Paren Note
forall a. Maybe a
Nothing

instance ToSugar Integer where toSugar :: Integer -> Sugar
toSugar = Integer -> Sugar
forall a. TextShow a => a -> Sugar
sugarShow
instance ToSugar Int where toSugar :: Int -> Sugar
toSugar = Int -> Sugar
forall a. TextShow a => a -> Sugar
sugarShow
instance ToSugar Int8 where toSugar :: Int8 -> Sugar
toSugar = Int8 -> Sugar
forall a. TextShow a => a -> Sugar
sugarShow
instance ToSugar Int16 where toSugar :: Int16 -> Sugar
toSugar = Int16 -> Sugar
forall a. TextShow a => a -> Sugar
sugarShow
instance ToSugar Int32 where toSugar :: Int32 -> Sugar
toSugar = Int32 -> Sugar
forall a. TextShow a => a -> Sugar
sugarShow
instance ToSugar Int64 where toSugar :: Int64 -> Sugar
toSugar = Int64 -> Sugar
forall a. TextShow a => a -> Sugar
sugarShow
instance ToSugar Word where toSugar :: Word -> Sugar
toSugar = Word -> Sugar
forall a. TextShow a => a -> Sugar
sugarShow
instance ToSugar Word8 where toSugar :: Word8 -> Sugar
toSugar = Word8 -> Sugar
forall a. TextShow a => a -> Sugar
sugarShow
instance ToSugar Word16 where toSugar :: Word16 -> Sugar
toSugar = Word16 -> Sugar
forall a. TextShow a => a -> Sugar
sugarShow
instance ToSugar Word32 where toSugar :: Word32 -> Sugar
toSugar = Word32 -> Sugar
forall a. TextShow a => a -> Sugar
sugarShow
instance ToSugar Word64 where toSugar :: Word64 -> Sugar
toSugar = Word64 -> Sugar
forall a. TextShow a => a -> Sugar
sugarShow
instance ToSugar Float where toSugar :: Float -> Sugar
toSugar = Float -> Sugar
forall a. TextShow a => a -> Sugar
sugarShow
instance ToSugar Double where toSugar :: Double -> Sugar
toSugar = Double -> Sugar
forall a. TextShow a => a -> Sugar
sugarShow

sugarShow :: TextShow a => a -> Sugar
sugarShow :: a -> Sugar
sugarShow a
s = Text -> Note -> Sugar
Sugar'Text (a -> Text
forall a. TextShow a => a -> Text
showt a
s) Note
forall a. Maybe a
Nothing

---

data PrettyPrintConfig = PrettyPrintConfig
  { PrettyPrintConfig -> Int
ppcTabbedSpaces :: Int
  } deriving (Int -> PrettyPrintConfig -> ShowS
[PrettyPrintConfig] -> ShowS
PrettyPrintConfig -> String
(Int -> PrettyPrintConfig -> ShowS)
-> (PrettyPrintConfig -> String)
-> ([PrettyPrintConfig] -> ShowS)
-> Show PrettyPrintConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PrettyPrintConfig] -> ShowS
$cshowList :: [PrettyPrintConfig] -> ShowS
show :: PrettyPrintConfig -> String
$cshow :: PrettyPrintConfig -> String
showsPrec :: Int -> PrettyPrintConfig -> ShowS
$cshowsPrec :: Int -> PrettyPrintConfig -> ShowS
Show, PrettyPrintConfig -> PrettyPrintConfig -> Bool
(PrettyPrintConfig -> PrettyPrintConfig -> Bool)
-> (PrettyPrintConfig -> PrettyPrintConfig -> Bool)
-> Eq PrettyPrintConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PrettyPrintConfig -> PrettyPrintConfig -> Bool
$c/= :: PrettyPrintConfig -> PrettyPrintConfig -> Bool
== :: PrettyPrintConfig -> PrettyPrintConfig -> Bool
$c== :: PrettyPrintConfig -> PrettyPrintConfig -> Bool
Eq)
  
data PrettyPrintState = PrettyPrintState
  { PrettyPrintState -> Int
ppsNesting :: Int
  } deriving (Int -> PrettyPrintState -> ShowS
[PrettyPrintState] -> ShowS
PrettyPrintState -> String
(Int -> PrettyPrintState -> ShowS)
-> (PrettyPrintState -> String)
-> ([PrettyPrintState] -> ShowS)
-> Show PrettyPrintState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PrettyPrintState] -> ShowS
$cshowList :: [PrettyPrintState] -> ShowS
show :: PrettyPrintState -> String
$cshow :: PrettyPrintState -> String
showsPrec :: Int -> PrettyPrintState -> ShowS
$cshowsPrec :: Int -> PrettyPrintState -> ShowS
Show, PrettyPrintState -> PrettyPrintState -> Bool
(PrettyPrintState -> PrettyPrintState -> Bool)
-> (PrettyPrintState -> PrettyPrintState -> Bool)
-> Eq PrettyPrintState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PrettyPrintState -> PrettyPrintState -> Bool
$c/= :: PrettyPrintState -> PrettyPrintState -> Bool
== :: PrettyPrintState -> PrettyPrintState -> Bool
$c== :: PrettyPrintState -> PrettyPrintState -> Bool
Eq)

prettyPrintSugarIO :: Sugar -> IO ()
prettyPrintSugarIO :: Sugar -> IO ()
prettyPrintSugarIO = Text -> IO ()
TIO.putStr (Text -> IO ()) -> (Sugar -> Text) -> Sugar -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sugar -> Text
prettyPrintSugar

prettyPrintSugar :: Sugar -> Text
prettyPrintSugar :: Sugar -> Text
prettyPrintSugar = PrettyPrintConfig -> Sugar -> Text
prettyPrintSugar' (Int -> PrettyPrintConfig
PrettyPrintConfig Int
2)

prettyPrintSugar' :: PrettyPrintConfig -> Sugar -> Text
prettyPrintSugar' :: PrettyPrintConfig -> Sugar -> Text
prettyPrintSugar' PrettyPrintConfig
ppc = PrettyPrintConfig -> PrettyPrintState -> Sugar -> Text
prettyPrintStep PrettyPrintConfig
ppc (Int -> PrettyPrintState
PrettyPrintState Int
0)

prettyPrintNesting :: PrettyPrintConfig -> PrettyPrintState -> Text
prettyPrintNesting :: PrettyPrintConfig -> PrettyPrintState -> Text
prettyPrintNesting PrettyPrintConfig
ppc PrettyPrintState
pps = Int -> Text -> Text
T.replicate (PrettyPrintConfig -> Int
ppcTabbedSpaces PrettyPrintConfig
ppc Int -> Int -> Int
forall a. Num a => a -> a -> a
* PrettyPrintState -> Int
ppsNesting PrettyPrintState
pps) Text
" "

ppsIncrNesting :: PrettyPrintState -> PrettyPrintState
ppsIncrNesting :: PrettyPrintState -> PrettyPrintState
ppsIncrNesting PrettyPrintState
pps = PrettyPrintState
pps { ppsNesting :: Int
ppsNesting = PrettyPrintState -> Int
ppsNesting PrettyPrintState
pps Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 }

ppsDecrNesting :: PrettyPrintState -> PrettyPrintState
ppsDecrNesting :: PrettyPrintState -> PrettyPrintState
ppsDecrNesting PrettyPrintState
pps = PrettyPrintState
pps { ppsNesting :: Int
ppsNesting = if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 then Int
n else Int
0 }
  where
    n :: Int
n = PrettyPrintState -> Int
ppsNesting PrettyPrintState
pps Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

ppNewLine :: PrettyPrintConfig -> PrettyPrintState -> Text
ppNewLine :: PrettyPrintConfig -> PrettyPrintState -> Text
ppNewLine PrettyPrintConfig
ppc PrettyPrintState
pps = Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PrettyPrintConfig -> PrettyPrintState -> Text
prettyPrintNesting PrettyPrintConfig
ppc PrettyPrintState
pps 

prettyPrintStep :: PrettyPrintConfig -> PrettyPrintState -> Sugar -> Text
prettyPrintStep :: PrettyPrintConfig -> PrettyPrintState -> Sugar -> Text
prettyPrintStep PrettyPrintConfig
_ PrettyPrintState
_ (Sugar'Unit Note
note) = Text
"()" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Note -> Text
minifyPrintNote Note
note
prettyPrintStep PrettyPrintConfig
_ PrettyPrintState
_ (Sugar'Text Text
txt Note
note) = Text -> Text
sanitizeText Text
txt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Note -> Text
minifyPrintNote Note
note
prettyPrintStep PrettyPrintConfig
ppc PrettyPrintState
pps (Sugar'List [Sugar]
xs Wrap
w Note
note) =
    Text
open
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.concat ((Sugar -> Text) -> [Sugar] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\Sugar
x -> [Text] -> Text
T.concat [PrettyPrintConfig -> PrettyPrintState -> Text
ppNewLine PrettyPrintConfig
ppc PrettyPrintState
pps, PrettyPrintConfig -> PrettyPrintState -> Sugar -> Text
prettyPrintStep PrettyPrintConfig
ppc (PrettyPrintState -> PrettyPrintState
ppsIncrNesting PrettyPrintState
pps) Sugar
x]) [Sugar]
xs)
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PrettyPrintConfig -> PrettyPrintState -> Text
ppNewLine PrettyPrintConfig
ppc (PrettyPrintState -> PrettyPrintState
ppsDecrNesting PrettyPrintState
pps)
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
close
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Note -> Text
minifyPrintNote Note
note
  where
    open, close :: Text
    (Text
open,Text
close) = case Wrap
w of Wrap
Wrap'Square -> (Text
"[",Text
"]"); Wrap
Wrap'Paren -> (Text
"(",Text
")")
prettyPrintStep PrettyPrintConfig
ppc PrettyPrintState
pps (Sugar'Map [(Sugar, Sugar)]
m Note
note) = if PrettyPrintState -> Int
ppsNesting PrettyPrintState
pps Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Note -> Bool
forall a. Maybe a -> Bool
isNothing Note
note then Text
topLevel else Text
nested
    where
      topLevel :: Text
topLevel =
        [Text] -> Text
T.concat (((Sugar, Sugar) -> Text) -> [(Sugar, Sugar)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\(Sugar
k,Sugar
v) -> [Text] -> Text
T.concat [PrettyPrintConfig -> PrettyPrintState -> Sugar -> Text
prettyPrintStep PrettyPrintConfig
ppc PrettyPrintState
nextPps Sugar
k, Text
" ", PrettyPrintConfig -> PrettyPrintState -> Sugar -> Text
prettyPrintStep PrettyPrintConfig
ppc PrettyPrintState
nextPps Sugar
v, Text
"\n"]) [(Sugar, Sugar)]
m)
      nested :: Text
nested =
        Text
"{"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.concat (((Sugar, Sugar) -> Text) -> [(Sugar, Sugar)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\(Sugar
k,Sugar
v) -> [Text] -> Text
T.concat [PrettyPrintConfig -> PrettyPrintState -> Text
ppNewLine PrettyPrintConfig
ppc PrettyPrintState
pps, PrettyPrintConfig -> PrettyPrintState -> Sugar -> Text
prettyPrintStep PrettyPrintConfig
ppc PrettyPrintState
nextPps Sugar
k, Text
" ", PrettyPrintConfig -> PrettyPrintState -> Sugar -> Text
prettyPrintStep PrettyPrintConfig
ppc PrettyPrintState
nextPps Sugar
v]) [(Sugar, Sugar)]
m)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PrettyPrintConfig -> PrettyPrintState -> Text
ppNewLine PrettyPrintConfig
ppc (PrettyPrintState -> PrettyPrintState
ppsDecrNesting PrettyPrintState
pps)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Note -> Text
minifyPrintNote Note
note
      nextPps :: PrettyPrintState
nextPps = PrettyPrintState -> PrettyPrintState
ppsIncrNesting PrettyPrintState
pps

minifyPrint :: Sugar -> Text
minifyPrint :: Sugar -> Text
minifyPrint (Sugar'Unit Note
note) = Text
"()" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Note -> Text
minifyPrintNote Note
note
minifyPrint (Sugar'Text Text
txt Note
note) = Text -> Text
sanitizeText Text
txt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Note -> Text
minifyPrintNote Note
note
minifyPrint (Sugar'List [Sugar]
xs Wrap
w Note
note) = Text
open Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
" " ((Sugar -> Text) -> [Sugar] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Sugar -> Text
minifyPrint [Sugar]
xs) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
close Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Note -> Text
minifyPrintNote Note
note
  where
    open, close :: Text
    (Text
open,Text
close) = case Wrap
w of Wrap
Wrap'Square -> (Text
"[",Text
"]"); Wrap
Wrap'Paren -> (Text
"(",Text
")")
minifyPrint (Sugar'Map [(Sugar, Sugar)]
m Note
note) = Text
"{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
" " ((Sugar -> Text) -> [Sugar] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Sugar -> Text
minifyPrint [Sugar]
xs) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Note -> Text
minifyPrintNote Note
note
  where
    xs :: [Sugar]
    xs :: [Sugar]
xs = (\(Sugar
k,Sugar
v) -> [Sugar
k,Sugar
v]) ((Sugar, Sugar) -> [Sugar]) -> [(Sugar, Sugar)] -> [Sugar]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [(Sugar, Sugar)]
m

minifyPrintNote :: Note -> Text
minifyPrintNote :: Note -> Text
minifyPrintNote Note
Nothing = Text
""
minifyPrintNote (Just Sugar
s) = Text
"<" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Sugar -> Text
minifyPrint Sugar
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
">"

sanitizeText :: Text -> Text
sanitizeText :: Text -> Text
sanitizeText Text
t
  | Text -> Int
T.length Text
t Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Text
"\"\""
  | (Char -> Bool) -> Text -> Maybe Char
T.find (\Char
c -> Char -> Bool
isSeparator Char
c Bool -> Bool -> Bool
|| Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Char
c String
reservedChars) Text
t Maybe Char -> Maybe Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe Char
forall a. Maybe a
Nothing = Text
"\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
replaceDoubleQuotes Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""
  | Bool
otherwise = Text
t
  where
    replaceDoubleQuotes :: Text -> Text
    replaceDoubleQuotes :: Text -> Text
replaceDoubleQuotes = Text -> Text -> Text -> Text
T.replace Text
"\"" Text
"\\\""
    
reservedChars :: [Char]
reservedChars :: String
reservedChars = [Char
'\"',Char
'[',Char
']',Char
'<',Char
'>',Char
'(',Char
')',Char
'{',Char
'}',Char
';']

---
---

readSugarFromFile :: FilePath -> IO (Maybe Sugar)
readSugarFromFile :: String -> IO Note
readSugarFromFile String
path = do
  Text
content <- String -> IO Text
TIO.readFile String
path
  Note -> IO Note
forall (m :: * -> *) a. Monad m => a -> m a
return (Note -> IO Note) -> Note -> IO Note
forall a b. (a -> b) -> a -> b
$ Text -> Note
parseSugarFromText Text
content

parseSugarFromText :: Text -> Maybe Sugar
parseSugarFromText :: Text -> Note
parseSugarFromText Text
t = case Parsec Void Text Sugar
-> String -> Text -> Either (ParseErrorBundle Text Void) Sugar
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
P.runParser Parsec Void Text Sugar
sugarP String
"" Text
t of
  Left ParseErrorBundle Text Void
_ -> Note
forall a. Maybe a
Nothing
  Right Sugar
s -> Sugar -> Note
forall a. a -> Maybe a
Just Sugar
s
  
readSugarListFromFile :: FilePath -> IO (Maybe Sugar)
readSugarListFromFile :: String -> IO Note
readSugarListFromFile String
path = do
  Text
content <- String -> IO Text
TIO.readFile String
path
  Note -> IO Note
forall (m :: * -> *) a. Monad m => a -> m a
return (Note -> IO Note) -> Note -> IO Note
forall a b. (a -> b) -> a -> b
$ Text -> Note
parseSugarListFromText Text
content

parseSugarListFromText :: Text -> Maybe Sugar
parseSugarListFromText :: Text -> Note
parseSugarListFromText Text
t = case Parsec Void Text Sugar
-> String -> Text -> Either (ParseErrorBundle Text Void) Sugar
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
P.runParser Parsec Void Text Sugar
sugarNoBracketsListP String
"" Text
t of 
  Left ParseErrorBundle Text Void
_ -> Note
forall a. Maybe a
Nothing
  Right Sugar
s -> Sugar -> Note
forall a. a -> Maybe a
Just Sugar
s

---
---

type Parser = P.Parsec Void Text

sugarP :: Parser Sugar
sugarP :: Parsec Void Text Sugar
sugarP = [Parsec Void Text Sugar] -> Parsec Void Text Sugar
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
P.choice [Parsec Void Text Sugar -> Parsec Void Text Sugar
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try Parsec Void Text Sugar
noCurlysMapP, Parsec Void Text Sugar
sugarP']

sugarNoBracketsListP :: Parser Sugar
sugarNoBracketsListP :: Parsec Void Text Sugar
sugarNoBracketsListP = [Parsec Void Text Sugar] -> Parsec Void Text Sugar
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
P.choice [Parsec Void Text Sugar -> Parsec Void Text Sugar
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try Parsec Void Text Sugar
noBracketsListP, Parsec Void Text Sugar
sugarP']

sugarP' :: Parser Sugar
sugarP' :: Parsec Void Text Sugar
sugarP' = do
  Char
c <- ParsecT Void Text Identity Char -> ParsecT Void Text Identity Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.lookAhead ParsecT Void Text Identity Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
P.anySingle
  case Char
c of
    Char
'\"' -> Parsec Void Text Sugar
quotedTextP
    Char
'(' -> [Parsec Void Text Sugar] -> Parsec Void Text Sugar
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
P.choice [Parsec Void Text Sugar
unitP, Parsec Void Text Sugar
parenListP]
    Char
')' -> String -> Parsec Void Text Sugar
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Not valid Sugar"
    Char
'[' -> Parsec Void Text Sugar
squareListP
    Char
']' -> String -> Parsec Void Text Sugar
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Not valid Sugar"
    Char
'{' -> Parsec Void Text Sugar
mapP
    Char
'}' -> String -> Parsec Void Text Sugar
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Not valid Sugar"
    Char
'<' -> String -> Parsec Void Text Sugar
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Not valid Sugar"
    Char
'>' -> String -> Parsec Void Text Sugar
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Not valid Sugar"
    Char
_ -> Parsec Void Text Sugar
unQuotedTextP

unitP :: Parser Sugar
unitP :: Parsec Void Text Sugar
unitP = Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
P.string Tokens Text
"()" ParsecT Void Text Identity Text
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity ()
sc ParsecT Void Text Identity ()
-> Parsec Void Text Sugar -> Parsec Void Text Sugar
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Note -> Sugar
Sugar'Unit (Note -> Sugar)
-> ParsecT Void Text Identity Note -> Parsec Void Text Sugar
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Note
noteP)

parenListP, squareListP :: Parser Sugar
parenListP :: Parsec Void Text Sugar
parenListP = (\[Sugar]
xs -> [Sugar] -> Wrap -> Note -> Sugar
Sugar'List [Sugar]
xs Wrap
Wrap'Paren) ([Sugar] -> Note -> Sugar)
-> ParsecT Void Text Identity [Sugar]
-> ParsecT Void Text Identity (Note -> Sugar)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity [Sugar]
-> ParsecT Void Text Identity [Sugar]
forall a. Parser a -> Parser a
parensP (Parsec Void Text Sugar -> ParsecT Void Text Identity [Sugar]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.many Parsec Void Text Sugar
sugarP') ParsecT Void Text Identity (Note -> Sugar)
-> ParsecT Void Text Identity Note -> Parsec Void Text Sugar
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Note
noteP
squareListP :: Parsec Void Text Sugar
squareListP = (\[Sugar]
xs -> [Sugar] -> Wrap -> Note -> Sugar
Sugar'List [Sugar]
xs Wrap
Wrap'Square) ([Sugar] -> Note -> Sugar)
-> ParsecT Void Text Identity [Sugar]
-> ParsecT Void Text Identity (Note -> Sugar)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Void Text Identity [Sugar]
-> ParsecT Void Text Identity [Sugar]
forall a. Parser a -> Parser a
squareBracketsP (ParsecT Void Text Identity [Sugar]
 -> ParsecT Void Text Identity [Sugar])
-> ParsecT Void Text Identity [Sugar]
-> ParsecT Void Text Identity [Sugar]
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity ()
sc ParsecT Void Text Identity ()
-> ParsecT Void Text Identity [Sugar]
-> ParsecT Void Text Identity [Sugar]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec Void Text Sugar -> ParsecT Void Text Identity [Sugar]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.many Parsec Void Text Sugar
elementP ParsecT Void Text Identity [Sugar]
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity [Sugar]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
sc) ParsecT Void Text Identity (Note -> Sugar)
-> ParsecT Void Text Identity Note -> Parsec Void Text Sugar
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Note
noteP
  where
    elementP :: Parser Sugar
    elementP :: Parsec Void Text Sugar
elementP = ParsecT Void Text Identity ()
sc ParsecT Void Text Identity ()
-> Parsec Void Text Sugar -> Parsec Void Text Sugar
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec Void Text Sugar
sugarP' Parsec Void Text Sugar
-> ParsecT Void Text Identity () -> Parsec Void Text Sugar
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
sc

noBracketsListP :: Parser Sugar
noBracketsListP :: Parsec Void Text Sugar
noBracketsListP = (\[Sugar]
xs -> [Sugar] -> Wrap -> Note -> Sugar
Sugar'List [Sugar]
xs Wrap
Wrap'Square) ([Sugar] -> Note -> Sugar)
-> ParsecT Void Text Identity [Sugar]
-> ParsecT Void Text Identity (Note -> Sugar)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Void Text Identity ()
sc ParsecT Void Text Identity ()
-> ParsecT Void Text Identity [Sugar]
-> ParsecT Void Text Identity [Sugar]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec Void Text Sugar -> ParsecT Void Text Identity [Sugar]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.many Parsec Void Text Sugar
elementP ParsecT Void Text Identity [Sugar]
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity [Sugar]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
sc) ParsecT Void Text Identity (Note -> Sugar)
-> ParsecT Void Text Identity Note -> Parsec Void Text Sugar
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Note -> ParsecT Void Text Identity Note
forall (f :: * -> *) a. Applicative f => a -> f a
pure Note
forall a. Maybe a
Nothing
  where
    elementP :: Parser Sugar
    elementP :: Parsec Void Text Sugar
elementP = ParsecT Void Text Identity ()
sc ParsecT Void Text Identity ()
-> Parsec Void Text Sugar -> Parsec Void Text Sugar
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec Void Text Sugar
sugarP' Parsec Void Text Sugar
-> ParsecT Void Text Identity () -> Parsec Void Text Sugar
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
sc

mapP, noCurlysMapP :: Parser Sugar
mapP :: Parsec Void Text Sugar
mapP = [(Sugar, Sugar)] -> Note -> Sugar
Sugar'Map ([(Sugar, Sugar)] -> Note -> Sugar)
-> ParsecT Void Text Identity [(Sugar, Sugar)]
-> ParsecT Void Text Identity (Note -> Sugar)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Void Text Identity [(Sugar, Sugar)]
-> ParsecT Void Text Identity [(Sugar, Sugar)]
forall a. Parser a -> Parser a
curlyBracesP (ParsecT Void Text Identity [(Sugar, Sugar)]
 -> ParsecT Void Text Identity [(Sugar, Sugar)])
-> ParsecT Void Text Identity [(Sugar, Sugar)]
-> ParsecT Void Text Identity [(Sugar, Sugar)]
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity ()
sc ParsecT Void Text Identity ()
-> ParsecT Void Text Identity [(Sugar, Sugar)]
-> ParsecT Void Text Identity [(Sugar, Sugar)]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity (Sugar, Sugar)
-> ParsecT Void Text Identity [(Sugar, Sugar)]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.many ParsecT Void Text Identity (Sugar, Sugar)
mapPairP ParsecT Void Text Identity [(Sugar, Sugar)]
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity [(Sugar, Sugar)]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
sc) ParsecT Void Text Identity (Note -> Sugar)
-> ParsecT Void Text Identity Note -> Parsec Void Text Sugar
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Note
noteP
noCurlysMapP :: Parsec Void Text Sugar
noCurlysMapP = [(Sugar, Sugar)] -> Note -> Sugar
Sugar'Map ([(Sugar, Sugar)] -> Note -> Sugar)
-> ParsecT Void Text Identity [(Sugar, Sugar)]
-> ParsecT Void Text Identity (Note -> Sugar)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Void Text Identity ()
sc ParsecT Void Text Identity ()
-> ParsecT Void Text Identity [(Sugar, Sugar)]
-> ParsecT Void Text Identity [(Sugar, Sugar)]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity (Sugar, Sugar)
-> ParsecT Void Text Identity [(Sugar, Sugar)]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.many ParsecT Void Text Identity (Sugar, Sugar)
mapPairP ParsecT Void Text Identity [(Sugar, Sugar)]
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity [(Sugar, Sugar)]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
sc) ParsecT Void Text Identity (Note -> Sugar)
-> ParsecT Void Text Identity Note -> Parsec Void Text Sugar
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Note -> ParsecT Void Text Identity Note
forall (f :: * -> *) a. Applicative f => a -> f a
pure Note
forall a. Maybe a
Nothing

-- TODO: Instead of `P.space1`, use the same characters for `isSeparator`
mapPairP :: Parser (Sugar, Sugar)
mapPairP :: ParsecT Void Text Identity (Sugar, Sugar)
mapPairP = (,) (Sugar -> Sugar -> (Sugar, Sugar))
-> Parsec Void Text Sugar
-> ParsecT Void Text Identity (Sugar -> (Sugar, Sugar))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parsec Void Text Sugar
sugarP' ParsecT Void Text Identity (Sugar -> (Sugar, Sugar))
-> Parsec Void Text Sugar
-> ParsecT Void Text Identity (Sugar, Sugar)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ParsecT Void Text Identity ()
sc ParsecT Void Text Identity ()
-> Parsec Void Text Sugar -> Parsec Void Text Sugar
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec Void Text Sugar
sugarP') ParsecT Void Text Identity (Sugar, Sugar)
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity (Sugar, Sugar)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
sc

noteP :: Parser Note
noteP :: ParsecT Void Text Identity Note
noteP = Parsec Void Text Sugar -> ParsecT Void Text Identity Note
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (Parsec Void Text Sugar -> ParsecT Void Text Identity Note)
-> Parsec Void Text Sugar -> ParsecT Void Text Identity Note
forall a b. (a -> b) -> a -> b
$ Parsec Void Text Sugar -> Parsec Void Text Sugar
forall a. Parser a -> Parser a
angleBracketsP Parsec Void Text Sugar
sugarP'

parensP, angleBracketsP, squareBracketsP, curlyBracesP :: Parser a -> Parser a
parensP :: Parser a -> Parser a
parensP = ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text -> Parser a -> Parser a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
P.between (Text -> ParsecT Void Text Identity Text
symbol Text
"(") (Text -> ParsecT Void Text Identity Text
symbol Text
")")
angleBracketsP :: Parser a -> Parser a
angleBracketsP = ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text -> Parser a -> Parser a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
P.between (Text -> ParsecT Void Text Identity Text
symbol Text
"<") (Text -> ParsecT Void Text Identity Text
symbol Text
">")
squareBracketsP :: Parser a -> Parser a
squareBracketsP = ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text -> Parser a -> Parser a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
P.between (Text -> ParsecT Void Text Identity Text
symbol Text
"[") (Text -> ParsecT Void Text Identity Text
symbol Text
"]")
curlyBracesP :: Parser a -> Parser a
curlyBracesP = ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text -> Parser a -> Parser a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
P.between (Text -> ParsecT Void Text Identity Text
symbol Text
"{") (Text -> ParsecT Void Text Identity Text
symbol Text
"}")

symbol :: Text -> Parser Text
symbol :: Text -> ParsecT Void Text Identity Text
symbol = ParsecT Void Text Identity ()
-> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> Tokens s -> m (Tokens s)
L.symbol ParsecT Void Text Identity ()
sc

quotedTextP, unQuotedTextP :: Parser Sugar
quotedTextP :: Parsec Void Text Sugar
quotedTextP = Text -> Note -> Sugar
Sugar'Text (Text -> Note -> Sugar)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Note -> Sugar)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text
doubleQuotedTextP_ ParsecT Void Text Identity (Note -> Sugar)
-> ParsecT Void Text Identity Note -> Parsec Void Text Sugar
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ParsecT Void Text Identity ()
sc ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Note
-> ParsecT Void Text Identity Note
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Note
noteP)
unQuotedTextP :: Parsec Void Text Sugar
unQuotedTextP = Text -> Note -> Sugar
Sugar'Text (Text -> Note -> Sugar)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Note -> Sugar)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text
notQuotedTextP_ ParsecT Void Text Identity (Note -> Sugar)
-> ParsecT Void Text Identity Note -> Parsec Void Text Sugar
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Note
noteP

doubleQuotedTextP_, notQuotedTextP_ :: Parser Text
doubleQuotedTextP_ :: ParsecT Void Text Identity Text
doubleQuotedTextP_ = String -> Text
T.pack (String -> Text)
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity String
quotedP
  where
    quotedP :: Parser String
    quotedP :: ParsecT Void Text Identity String
quotedP = ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
P.between (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
Token Text
'\"') (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
Token Text
'\"') (ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (ParsecT Void Text Identity Char -> ParsecT Void Text Identity Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try ParsecT Void Text Identity Char
escaped ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity Char
ParsecT Void Text Identity (Token Text)
normalChar))
       where
         escaped :: ParsecT Void Text Identity Char
escaped = Char
'\"' Char
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity Char
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)
P.string Tokens Text
"\\\""
         normalChar :: ParsecT Void Text Identity (Token Text)
normalChar = (Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
P.satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'\"')
notQuotedTextP_ :: ParsecT Void Text Identity Text
notQuotedTextP_ = Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
P.takeWhileP (String -> Maybe String
forall a. a -> Maybe a
Just String
"Text char") (\Token Text
c -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Char -> Bool
isSeparator Char
Token Text
c Bool -> Bool -> Bool
|| Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' Bool -> Bool -> Bool
|| Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Char
Token Text
c String
reservedChars)

sc :: Parser ()
sc :: ParsecT Void Text Identity ()
sc = ParsecT Void Text Identity ()
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity ()
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> m () -> m () -> m ()
L.space
  ParsecT Void Text Identity ()
ws
  (Tokens Text -> ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Tokens s -> m ()
L.skipLineComment Tokens Text
";") -- TODO replace with ';' once issue 88 is fixed
  (Tokens Text -> Tokens Text -> ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Tokens s -> Tokens s -> m ()
L.skipBlockComment Tokens Text
"#|" Tokens Text
"|#")
  
ws :: Parser ()
ws :: ParsecT Void Text Identity ()
ws = (ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
P.newline ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
P.separatorChar) ParsecT Void Text Identity Char
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> () -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()