{-# LANGUAGE
    FlexibleContexts
  , OverloadedStrings
  , DeriveGeneric
  , DataKinds
  #-}

module LText.Document where

import LText.Expr (Expr (..), MonadParse, MonadPrettyPrint, runParserT, runParse, ppExpr)

import           Data.Text.Lazy       (Text)
import qualified Data.Text.Lazy    as LT
import qualified Data.Text.Lazy.IO as LT

import Data.Char (isAlphaNum)
import Data.List.Extra (unsnoc)
import Control.Monad (guard, foldM)
import Control.Monad.Catch (Exception, MonadThrow, throwM)
import Control.Monad.IO.Class (liftIO)

import System.IO (stderr, hPutStrLn)
import System.Exit (exitFailure)
import GHC.Generics (Generic)

import Test.QuickCheck (Arbitrary (shrink, arbitrary), Gen, suchThat, oneof)
import Test.QuickCheck.Instances ()
import Test.QuickCheck.Combinators (Between (..))



data Document = Document
  { Document -> [Text]
documentArity :: [Text]
  , Document -> [DocumentBody]
documentBody  :: [DocumentBody]
  } deriving (Int -> Document -> ShowS
[Document] -> ShowS
Document -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Document] -> ShowS
$cshowList :: [Document] -> ShowS
show :: Document -> String
$cshow :: Document -> String
showsPrec :: Int -> Document -> ShowS
$cshowsPrec :: Int -> Document -> ShowS
Show, Document -> Document -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Document -> Document -> Bool
$c/= :: Document -> Document -> Bool
== :: Document -> Document -> Bool
$c== :: Document -> Document -> Bool
Eq)

instance Arbitrary Document where
  arbitrary :: Gen Document
arbitrary = do
    (Between [Between 1 5 [] Char]
hs)   <- forall a. Arbitrary a => Gen a
arbitrary forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isAlphaNum)
                      :: Gen (Between 1 5 [] (Between 1 5 [] Char))
    (Between [DocumentBody]
body) <- forall a. Arbitrary a => Gen a
arbitrary :: Gen (Between 1 10 [] DocumentBody)
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [Text] -> [DocumentBody] -> Document
Document (String -> Text
LT.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Nat) (m :: Nat) (t :: * -> *) a.
Between n m t a -> t a
getBetween forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Between 1 5 [] Char]
hs) [DocumentBody]
body
 -- shrink (Document hs body) =
 --   Document <$> shrink hs <*> shrink body


data DocumentBody
  = RawText [Text]
  | Expression Expr
  deriving (Int -> DocumentBody -> ShowS
[DocumentBody] -> ShowS
DocumentBody -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DocumentBody] -> ShowS
$cshowList :: [DocumentBody] -> ShowS
show :: DocumentBody -> String
$cshow :: DocumentBody -> String
showsPrec :: Int -> DocumentBody -> ShowS
$cshowsPrec :: Int -> DocumentBody -> ShowS
Show, DocumentBody -> DocumentBody -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DocumentBody -> DocumentBody -> Bool
$c/= :: DocumentBody -> DocumentBody -> Bool
== :: DocumentBody -> DocumentBody -> Bool
$c== :: DocumentBody -> DocumentBody -> Bool
Eq)

instance Arbitrary DocumentBody where
  arbitrary :: Gen DocumentBody
arbitrary = forall a. [Gen a] -> Gen a
oneof
    [ do
      (Between [Between 1 10 [] Char]
ls) <- forall a. Arbitrary a => Gen a
arbitrary forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isAlphaNum)
                      :: Gen (Between 1 10 [] (Between 1 10 [] Char))
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> DocumentBody
RawText forall a b. (a -> b) -> a -> b
$ (String -> Text
LT.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Nat) (m :: Nat) (t :: * -> *) a.
Between n m t a -> t a
getBetween) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Between 1 10 [] Char]
ls
    , Expr -> DocumentBody
Expression forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
    ]
  shrink :: DocumentBody -> [DocumentBody]
shrink (Expression Expr
e) = Expr -> DocumentBody
Expression forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => a -> [a]
shrink Expr
e
  shrink (RawText [Text]
ts)   = [Text] -> DocumentBody
RawText    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => a -> [a]
shrink [Text]
ts


repackDocument :: [DocumentBody] -> [DocumentBody]
repackDocument :: [DocumentBody] -> [DocumentBody]
repackDocument [DocumentBody]
ds =
  forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl [DocumentBody] -> DocumentBody -> [DocumentBody]
go [] [DocumentBody]
ds
  where
    go :: [DocumentBody] -> DocumentBody -> [DocumentBody]
    go :: [DocumentBody] -> DocumentBody -> [DocumentBody]
go [DocumentBody]
acc DocumentBody
l =
      case forall a. [a] -> Maybe ([a], a)
unsnoc [DocumentBody]
acc of
        Just ([DocumentBody]
acc', RawText [Text]
t) ->
          case DocumentBody
l of
            RawText [Text]
t' -> [DocumentBody]
acc' forall a. [a] -> [a] -> [a]
++ [[Text] -> DocumentBody
RawText forall a b. (a -> b) -> a -> b
$! [Text]
t forall a. [a] -> [a] -> [a]
++ [Text]
t']
            DocumentBody
_          -> [DocumentBody]
acc  forall a. [a] -> [a] -> [a]
++ [DocumentBody
l]
        Maybe ([DocumentBody], DocumentBody)
_ -> [DocumentBody]
acc forall a. [a] -> [a] -> [a]
++ [DocumentBody
l]


parseDocument :: MonadParse m => LT.Text -> m (Document, Maybe (Text, Text))
parseDocument :: forall (m :: * -> *).
MonadParse m =>
Text -> m (Document, Maybe (Text, Text))
parseDocument Text
ts =
  case Text -> [Text]
LT.lines Text
ts of
    [] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Text] -> [DocumentBody] -> Document
Document [] [], forall a. Maybe a
Nothing)
    (Text
head':[Text]
body) ->
      case Text -> Maybe (Text, Text, [Text])
parseHead Text
head' of
        Maybe (Text, Text, [Text])
Nothing       -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Text] -> [DocumentBody] -> Document
Document [] [[Text] -> DocumentBody
RawText forall a b. (a -> b) -> a -> b
$! Text
head'forall a. a -> [a] -> [a]
:[Text]
body], forall a. Maybe a
Nothing)
        Just (Text
l,Text
r,[Text]
hs) ->
          let go :: MonadParse m => [DocumentBody] -> Text -> m [DocumentBody]
              go :: forall (m :: * -> *).
MonadParse m =>
[DocumentBody] -> Text -> m [DocumentBody]
go [DocumentBody]
acc Text
b =
                case Text -> Text -> Text -> Maybe Text
findExpression Text
l Text
r Text
b of
                  Just Text
ts' -> do
                    Expr
e <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> IO Expr
runParse forall a b. (a -> b) -> a -> b
$ Text -> Text
LT.toStrict Text
ts'
                    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [DocumentBody]
acc forall a. [a] -> [a] -> [a]
++ [Expr -> DocumentBody
Expression Expr
e]

                  Maybe Text
Nothing ->
                    case forall a. [a] -> Maybe ([a], a)
unsnoc [DocumentBody]
acc of
                      Just ([DocumentBody]
acc', RawText [Text]
b') ->
                        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [DocumentBody]
acc' forall a. [a] -> [a] -> [a]
++ [[Text] -> DocumentBody
RawText forall a b. (a -> b) -> a -> b
$! [Text]
b' forall a. [a] -> [a] -> [a]
++ [Text
b]]
                      Maybe ([DocumentBody], DocumentBody)
_ ->
                        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [DocumentBody]
acc  forall a. [a] -> [a] -> [a]
++ [[Text] -> DocumentBody
RawText [Text
b]]
          in  do Document
d <- [Text] -> [DocumentBody] -> Document
Document [Text]
hs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM forall (m :: * -> *).
MonadParse m =>
[DocumentBody] -> Text -> m [DocumentBody]
go [] [Text]
body
                 forall (f :: * -> *) a. Applicative f => a -> f a
pure (Document
d, forall a. a -> Maybe a
Just (Text
l,Text
r))
  where
    findExpression :: Text -> Text -> Text -> Maybe Text
    findExpression :: Text -> Text -> Text -> Maybe Text
findExpression Text
l Text
r Text
ts' =
      case Text -> [Text]
LT.words Text
ts' of
        []    -> forall a. Maybe a
Nothing
        [Text
_]   -> forall a. Maybe a
Nothing
        [Text
_,Text
_] -> forall a. Maybe a
Nothing
        (Text
l':[Text]
ts'')
          | Text
l' forall a. Eq a => a -> a -> Bool
/= Text
l -> forall a. Maybe a
Nothing
          | Bool
otherwise -> do
            ([Text]
ts''',Text
r') <- forall a. [a] -> Maybe ([a], a)
unsnoc [Text]
ts''
            forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Text
r' forall a. Eq a => a -> a -> Bool
== Text
r
            forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [Text] -> Text
LT.unwords [Text]
ts'''

    parseHead :: LT.Text -> Maybe (Text, Text, [Text])
    parseHead :: Text -> Maybe (Text, Text, [Text])
parseHead Text
h =
      case Text -> [Text]
LT.words Text
h of
        []    -> forall a. Maybe a
Nothing
        [Text
_]   -> forall a. Maybe a
Nothing
        [Text
_,Text
_] -> forall a. Maybe a
Nothing
        (Text
l:[Text]
hs) -> case forall a. [a] -> Maybe ([a], a)
unsnoc [Text]
hs of
          Maybe ([Text], Text)
Nothing      -> forall a. HasCallStack => String -> a
error String
"impossible state"
          Just ([Text]
hs',Text
r) -> forall a. a -> Maybe a
Just (Text
l, Text
r, [Text]
hs')



printDocument :: MonadPrettyPrint m => Maybe (Text, Text) -> Document -> m Text
printDocument :: forall (m :: * -> *).
MonadPrettyPrint m =>
Maybe (Text, Text) -> Document -> m Text
printDocument Maybe (Text, Text)
mds (Document [Text]
head' [DocumentBody]
body) = do
  [Text]
bs <- forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *).
MonadPrettyPrint m =>
DocumentBody -> m [Text]
go [DocumentBody]
body
  case [Text]
head' of
    [] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [Text] -> Text
LT.unlines [Text]
bs
    [Text]
_ ->
      case Maybe (Text, Text)
mds of
        Maybe (Text, Text)
Nothing      -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM PrintError
NoExplicitDelimiters
        Just (Text
ld,Text
rd) ->
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
LT.unlines forall a b. (a -> b) -> a -> b
$
              [Text] -> Text
LT.unwords (Text
ld forall a. a -> [a] -> [a]
: ([Text]
head' forall a. [a] -> [a] -> [a]
++ [Text
rd]))
            forall a. a -> [a] -> [a]
: [Text]
bs
  where
    go :: MonadPrettyPrint m => DocumentBody -> m [Text]
    go :: forall (m :: * -> *).
MonadPrettyPrint m =>
DocumentBody -> m [Text]
go (RawText [Text]
t)    = forall (f :: * -> *) a. Applicative f => a -> f a
pure [Text]
t
    go (Expression Expr
e) =
      case Maybe (Text, Text)
mds of
        Maybe (Text, Text)
Nothing      -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM PrintError
NoExplicitDelimiters
        Just (Text
ld,Text
rd) -> do
          Text
e' <- String -> Text
LT.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadPrettyPrint m => Expr -> m String
ppExpr Expr
e
          forall (f :: * -> *) a. Applicative f => a -> f a
pure [Text
ld forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> Text
e' forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> Text
rd]



fromDocument :: Document -> Expr
fromDocument :: Document -> Expr
fromDocument (Document [Text]
head' [DocumentBody]
body) =
  forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (String -> Expr -> Expr
Abs forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
LT.unpack) ([DocumentBody] -> Expr
go [DocumentBody]
body) [Text]
head'
  where
    -- WARNING: partial; however, every text file is guaranteed to have at least
    -- one line.
    go :: [DocumentBody] -> Expr
go (RawText [Text]
t:[])    = [Text] -> Expr
Lit [Text]
t
    go (RawText [Text]
t:[DocumentBody]
ts)    = Expr -> Expr -> Expr
Concat ([Text] -> Expr
Lit [Text]
t) ([DocumentBody] -> Expr
go [DocumentBody]
ts)
    go (Expression Expr
e:[]) = Expr
e
    go (Expression Expr
e:[DocumentBody]
ts) = Expr -> Expr -> Expr
Concat Expr
e ([DocumentBody] -> Expr
go [DocumentBody]
ts)
    go [DocumentBody]
_                 = forall a. HasCallStack => String -> a
error String
"Text file without any text"


data PrintError
  = ConcatExprText Expr
  | NoExplicitDelimiters
  deriving (Int -> PrintError -> ShowS
[PrintError] -> ShowS
PrintError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PrintError] -> ShowS
$cshowList :: [PrintError] -> ShowS
show :: PrintError -> String
$cshow :: PrintError -> String
showsPrec :: Int -> PrintError -> ShowS
$cshowsPrec :: Int -> PrintError -> ShowS
Show, PrintError -> PrintError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PrintError -> PrintError -> Bool
$c/= :: PrintError -> PrintError -> Bool
== :: PrintError -> PrintError -> Bool
$c== :: PrintError -> PrintError -> Bool
Eq, forall x. Rep PrintError x -> PrintError
forall x. PrintError -> Rep PrintError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PrintError x -> PrintError
$cfrom :: forall x. PrintError -> Rep PrintError x
Generic)

instance Exception PrintError

handlePrintError :: PrintError -> IO a
handlePrintError :: forall a. PrintError -> IO a
handlePrintError PrintError
e = do
  Handle -> String -> IO ()
hPutStrLn Handle
stderr forall a b. (a -> b) -> a -> b
$
    case PrintError
e of
      ConcatExprText Expr
ex ->
        String
"[Print Error] Can't print textual data while residually inside an expression: "
        forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Expr -> Expr
subLit Expr
ex) --FIXME: Need backtracing; Lit annotated with source location?
                            -- Backtracing monad?
      PrintError
NoExplicitDelimiters ->
        String
"[Print Error] Can't render a document with residual arity without explicit\
        \ --left and --right delimiters"
  forall a. IO a
exitFailure
  where
    subLit :: Expr -> Expr
    subLit :: Expr -> Expr
subLit (Lit [Text]
_)        = [Text] -> Expr
Lit [Text
"###"]
    subLit (App Expr
e1 Expr
e2)    = Expr -> Expr -> Expr
App (Expr -> Expr
subLit Expr
e1) (Expr -> Expr
subLit Expr
e2)
    subLit (Concat Expr
e1 Expr
e2) = Expr -> Expr -> Expr
Concat (Expr -> Expr
subLit Expr
e1) (Expr -> Expr
subLit Expr
e2)
    subLit (Var String
n)        = String -> Expr
Var String
n
    subLit (Abs String
n Expr
e')     = String -> Expr -> Expr
Abs String
n (Expr -> Expr
subLit Expr
e')



toDocument :: MonadThrow m => Expr -> m Document
toDocument :: forall (m :: * -> *). MonadThrow m => Expr -> m Document
toDocument Expr
e =
  if Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Expr -> Bool
isPrintable Expr
e
  then forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ Expr -> PrintError
ConcatExprText Expr
e
  else case Expr -> ([Text], Expr)
getInitArity Expr
e of
    ([Text]
hs,Expr
e') -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [DocumentBody] -> Document
Document [Text]
hs forall a b. (a -> b) -> a -> b
$ Expr -> [DocumentBody]
getBody Expr
e'
  where
    getBody :: Expr -> [DocumentBody]
    getBody :: Expr -> [DocumentBody]
getBody Expr
e' =
      case Expr
e' of
        Lit [Text]
t        -> [[Text] -> DocumentBody
RawText [Text]
t]
        Concat Expr
e1 Expr
e2 -> Expr -> [DocumentBody]
getBody Expr
e1 forall a. [a] -> [a] -> [a]
++ Expr -> [DocumentBody]
getBody Expr
e2
        Expr
e''          -> [Expr -> DocumentBody
Expression Expr
e'']

    getInitArity :: Expr -> ([Text], Expr)
    getInitArity :: Expr -> ([Text], Expr)
getInitArity Expr
e' =
      case Expr
e' of
        Abs String
n Expr
e'' -> let ([Text]
hs          , Expr
e''') = Expr -> ([Text], Expr)
getInitArity Expr
e''
                     in  (String -> Text
LT.pack String
nforall a. a -> [a] -> [a]
:[Text]
hs, Expr
e''')
        Expr
e''       -> ([], Expr
e'')

    isPrintable :: Expr -> Bool
    isPrintable :: Expr -> Bool
isPrintable = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> Bool
hasConcatAbsLit

hasConcatAbsLit :: Expr -> Bool
hasConcatAbsLit :: Expr -> Bool
hasConcatAbsLit = Maybe PrintabilityMode -> Expr -> Bool
go forall a. Maybe a
Nothing
  where
    go :: Maybe PrintabilityMode -> Expr -> Bool
    go :: Maybe PrintabilityMode -> Expr -> Bool
go Maybe PrintabilityMode
Nothing Expr
e =
      case Expr
e of
        Var String
_        -> Bool
False
        Lit [Text]
_        -> Bool
False
        Abs String
_ Expr
e'     -> Maybe PrintabilityMode -> Expr -> Bool
go forall a. Maybe a
Nothing Expr
e'
        App Expr
e1 Expr
e2    -> Maybe PrintabilityMode -> Expr -> Bool
go forall a. Maybe a
Nothing Expr
e1 Bool -> Bool -> Bool
|| Maybe PrintabilityMode -> Expr -> Bool
go forall a. Maybe a
Nothing Expr
e2
        Concat Expr
e1 Expr
e2 -> Maybe PrintabilityMode -> Expr -> Bool
go (forall a. a -> Maybe a
Just PrintabilityMode
InsideConcat) Expr
e1
                     Bool -> Bool -> Bool
|| Maybe PrintabilityMode -> Expr -> Bool
go (forall a. a -> Maybe a
Just PrintabilityMode
InsideConcat) Expr
e2
    go (Just PrintabilityMode
InsideConcat) Expr
e =
      case Expr
e of
        Lit [Text]
_        -> Bool
False
        Var String
_        -> Bool
False
        Abs String
_ Expr
e'     -> Maybe PrintabilityMode -> Expr -> Bool
go (forall a. a -> Maybe a
Just PrintabilityMode
InsideExpr) Expr
e'
        App Expr
e1 Expr
e2    -> Maybe PrintabilityMode -> Expr -> Bool
go (forall a. a -> Maybe a
Just PrintabilityMode
InsideExpr) Expr
e1
                     Bool -> Bool -> Bool
|| Maybe PrintabilityMode -> Expr -> Bool
go (forall a. a -> Maybe a
Just PrintabilityMode
InsideExpr) Expr
e2
        Concat Expr
e1 Expr
e2 -> Maybe PrintabilityMode -> Expr -> Bool
go (forall a. a -> Maybe a
Just PrintabilityMode
InsideConcat) Expr
e1
                     Bool -> Bool -> Bool
|| Maybe PrintabilityMode -> Expr -> Bool
go (forall a. a -> Maybe a
Just PrintabilityMode
InsideConcat) Expr
e2
    go (Just PrintabilityMode
InsideExpr) Expr
e =
      case Expr
e of
        Lit [Text]
_        -> Bool
True
        Concat Expr
_ Expr
_   -> Bool
True
        Var String
_        -> Bool
False
        Abs String
_ Expr
e'     -> Maybe PrintabilityMode -> Expr -> Bool
go (forall a. a -> Maybe a
Just PrintabilityMode
InsideExpr) Expr
e'
        App Expr
e1 Expr
e2    -> Maybe PrintabilityMode -> Expr -> Bool
go (forall a. a -> Maybe a
Just PrintabilityMode
InsideExpr) Expr
e1
                     Bool -> Bool -> Bool
|| Maybe PrintabilityMode -> Expr -> Bool
go (forall a. a -> Maybe a
Just PrintabilityMode
InsideExpr) Expr
e2

data PrintabilityMode
  = InsideConcat
  | InsideExpr



fetchDocument :: FilePath -> IO Expr
fetchDocument :: String -> IO Expr
fetchDocument String
f = do
  Text
txt   <- String -> IO Text
LT.readFile String
f
  (Document
d,Maybe (Text, Text)
_) <- forall a. StateT ParseState IO a -> IO a
runParserT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadParse m =>
Text -> m (Document, Maybe (Text, Text))
parseDocument Text
txt
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Document -> Expr
fromDocument Document
d

rawDocument :: FilePath -> IO Expr
rawDocument :: String -> IO Expr
rawDocument String
f = do
  [Text]
txts <- Text -> [Text]
LT.lines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Text
LT.readFile String
f
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [Text] -> Expr
Lit [Text]
txts