{-# LANGUAGE
FlexibleContexts
, OverloadedStrings
, DeriveGeneric
, DataKinds
, NamedFieldPuns
, RecordWildCards
, LambdaCase
#-}
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), suchThat, oneof, listOf1)
import Test.QuickCheck.Instances ()
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
[Text]
documentArity <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
LT.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall a. Gen a -> Gen [a]
listOf1 (forall a. Gen a -> Gen [a]
listOf1 (forall a. Arbitrary a => Gen a
arbitrary forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` Char -> Bool
isAlphaNum))
[DocumentBody]
documentBody <- forall a. Gen a -> Gen [a]
listOf1 forall a. Arbitrary a => Gen a
arbitrary
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Document {[Text]
documentArity :: [Text]
documentArity :: [Text]
documentArity, [DocumentBody]
documentBody :: [DocumentBody]
documentBody :: [DocumentBody]
documentBody}
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
[String]
ls <- forall a. Gen a -> Gen [a]
listOf1 (forall a. Gen a -> Gen [a]
listOf1 (forall a. Arbitrary a => Gen a
arbitrary forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` Char -> Bool
isAlphaNum))
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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
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, DocumentBody
l) of
(Just ([DocumentBody]
acc', RawText [Text]
t), 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']
(Maybe ([DocumentBody], 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 (Document {documentArity :: [Text]
documentArity = [], documentBody :: [DocumentBody]
documentBody = []}, forall a. Maybe a
Nothing)
bodyWithHead :: [Text]
bodyWithHead@(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 (Document {documentArity :: [Text]
documentArity = [], documentBody :: [DocumentBody]
documentBody = [[Text] -> DocumentBody
RawText [Text]
bodyWithHead]}, forall a. Maybe a
Nothing)
Just (Text
l, Text
r, [Text]
documentArity) ->
let go :: MonadParse m => [DocumentBody] -> Text -> m [DocumentBody]
go :: forall (m :: * -> *).
MonadParse m =>
[DocumentBody] -> Text -> m [DocumentBody]
go [DocumentBody]
acc Text
b =
case Text -> Maybe Text
findExpression 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]]
where
findExpression :: Text -> Maybe Text
findExpression :: Text -> Maybe Text
findExpression 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'') -> 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 Bool -> Bool -> Bool
&& Text
l' forall a. Eq a => a -> a -> Bool
== Text
l
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [Text] -> Text
LT.unwords [Text]
ts'''
in do [DocumentBody]
documentBody <- 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 {[Text]
documentArity :: [Text]
documentArity :: [Text]
documentArity, [DocumentBody]
documentBody :: [DocumentBody]
documentBody :: [DocumentBody]
documentBody}, forall a. a -> Maybe a
Just (Text
l,Text
r))
where
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]
[DocumentBody]
documentBody :: [DocumentBody]
documentArity :: [Text]
documentBody :: Document -> [DocumentBody]
documentArity :: Document -> [Text]
..} = 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]
documentBody
case [Text]
documentArity 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]
documentArity 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 :: FilePath
-> Document
-> Expr
fromDocument :: String -> Document -> Expr
fromDocument String
source Document{[Text]
[DocumentBody]
documentBody :: [DocumentBody]
documentArity :: [Text]
documentBody :: Document -> [DocumentBody]
documentArity :: Document -> [Text]
..} =
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]
documentBody) [Text]
documentArity
where
go :: [DocumentBody] -> Expr
go (RawText [Text]
t:[DocumentBody]
ts) = Expr -> Expr -> String -> Bool -> Expr
Concat ([Text] -> String -> Bool -> Expr
Lit [Text]
t String
source Bool
False) ([DocumentBody] -> Expr
go [DocumentBody]
ts) String
source Bool
False
go (Expression Expr
e:[DocumentBody]
ts) = Expr -> Expr -> String -> Bool -> Expr
Concat Expr
e ([DocumentBody] -> Expr
go [DocumentBody]
ts) String
source Bool
False
go [RawText [Text]
t] = [Text] -> String -> Bool -> Expr
Lit [Text]
t String
source Bool
False
go [Expression Expr
e] = Expr
e
go [] = [Text] -> String -> Bool -> Expr
Lit [] String
source Bool
False
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
data PrintabilityMode
= InsideConcat
| InsideExpr
decorateUnprintable :: Expr -> Expr
decorateUnprintable :: Expr -> Expr
decorateUnprintable = Maybe PrintabilityMode -> Expr -> Expr
go forall a. Maybe a
Nothing
where
go :: Maybe PrintabilityMode -> Expr -> Expr
go Maybe PrintabilityMode
Nothing = \case
Concat Expr
e1 Expr
e2 String
s Bool
_ ->
Expr -> Expr -> String -> Bool -> Expr
Concat (Maybe PrintabilityMode -> Expr -> Expr
go (forall a. a -> Maybe a
Just PrintabilityMode
InsideConcat) Expr
e1) (Maybe PrintabilityMode -> Expr -> Expr
go (forall a. a -> Maybe a
Just PrintabilityMode
InsideConcat) Expr
e2) String
s Bool
False
Abs String
n Expr
e ->
String -> Expr -> Expr
Abs String
n (Maybe PrintabilityMode -> Expr -> Expr
go forall a. Maybe a
Nothing Expr
e)
App Expr
e1 Expr
e2 ->
Expr -> Expr -> Expr
App (Maybe PrintabilityMode -> Expr -> Expr
go forall a. Maybe a
Nothing Expr
e1) (Maybe PrintabilityMode -> Expr -> Expr
go forall a. Maybe a
Nothing Expr
e2)
Expr
e -> Expr
e
go (Just PrintabilityMode
InsideConcat) = \case
Concat Expr
e1 Expr
e2 String
s Bool
_ ->
Expr -> Expr -> String -> Bool -> Expr
Concat (Maybe PrintabilityMode -> Expr -> Expr
go (forall a. a -> Maybe a
Just PrintabilityMode
InsideConcat) Expr
e1) (Maybe PrintabilityMode -> Expr -> Expr
go (forall a. a -> Maybe a
Just PrintabilityMode
InsideConcat) Expr
e2) String
s Bool
False
Abs String
n Expr
e ->
String -> Expr -> Expr
Abs String
n (Maybe PrintabilityMode -> Expr -> Expr
go (forall a. a -> Maybe a
Just PrintabilityMode
InsideExpr) Expr
e)
App Expr
e1 Expr
e2 ->
Expr -> Expr -> Expr
App (Maybe PrintabilityMode -> Expr -> Expr
go (forall a. a -> Maybe a
Just PrintabilityMode
InsideExpr) Expr
e1) (Maybe PrintabilityMode -> Expr -> Expr
go (forall a. a -> Maybe a
Just PrintabilityMode
InsideExpr) Expr
e2)
Expr
e -> Expr
e
go (Just PrintabilityMode
InsideExpr) = \case
Concat Expr
l Expr
r String
s Bool
_ -> Expr -> Expr -> String -> Bool -> Expr
Concat Expr
l Expr
r String
s Bool
True
Lit [Text]
t String
s Bool
_ -> [Text] -> String -> Bool -> Expr
Lit [Text]
t String
s Bool
True
Abs String
n Expr
e -> String -> Expr -> Expr
Abs String
n (Maybe PrintabilityMode -> Expr -> Expr
go (forall a. a -> Maybe a
Just PrintabilityMode
InsideExpr) Expr
e)
App Expr
e1 Expr
e2 -> Expr -> Expr -> Expr
App (Maybe PrintabilityMode -> Expr -> Expr
go (forall a. a -> Maybe a
Just PrintabilityMode
InsideExpr) Expr
e1) (Maybe PrintabilityMode -> Expr -> Expr
go (forall a. a -> Maybe a
Just PrintabilityMode
InsideExpr) Expr
e2)
Expr
e -> Expr
e
isAnyUnprintable :: Expr -> Bool
isAnyUnprintable :: Expr -> Bool
isAnyUnprintable = \case
Concat Expr
_ Expr
_ String
_ Bool
True -> Bool
True
Lit [Text]
_ String
_ Bool
True -> Bool
True
Concat Expr
e1 Expr
e2 String
_ Bool
_ -> Expr -> Bool
isAnyUnprintable Expr
e1 Bool -> Bool -> Bool
|| Expr -> Bool
isAnyUnprintable Expr
e2
Abs String
_ Expr
e -> Expr -> Bool
isAnyUnprintable Expr
e
App Expr
e1 Expr
e2 -> Expr -> Bool
isAnyUnprintable Expr
e1 Bool -> Bool -> Bool
|| Expr -> Bool
isAnyUnprintable Expr
e2
Expr
_ -> Bool
False
handlePrintError :: PrintError -> IO a
handlePrintError :: forall a. PrintError -> IO a
handlePrintError PrintError
e = do
case PrintError
e of
ConcatExprText Expr
ex -> do
String
err <- forall (m :: * -> *). MonadPrettyPrint m => Expr -> m String
ppExpr (Expr -> Expr
decorateUnprintable Expr
ex)
Handle -> String -> IO ()
hPutStrLn Handle
stderr forall a b. (a -> b) -> a -> b
$ String
"[Print Error] Can't print textual data while inside an expression: \n\n"
forall a. [a] -> [a] -> [a]
++ String
err forall a. [a] -> [a] -> [a]
++ String
"\n\n...cannot be rendered to a file."
PrintError
NoExplicitDelimiters ->
Handle -> String -> IO ()
hPutStrLn Handle
stderr String
"[Print Error] Can't render a document with arity without explicit --left and --right delimiters"
forall a. IO a
exitFailure
toDocument :: MonadThrow m => Expr -> m Document
toDocument :: forall (m :: * -> *). MonadThrow m => Expr -> m Document
toDocument Expr
e =
if Expr -> Bool
isAnyUnprintable (Expr -> Expr
decorateUnprintable 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]
documentArity, Expr
e') -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Document {[Text]
documentArity :: [Text]
documentArity :: [Text]
documentArity, documentBody :: [DocumentBody]
documentBody = Expr -> [DocumentBody]
getBody Expr
e'}
where
getBody :: Expr -> [DocumentBody]
getBody :: Expr -> [DocumentBody]
getBody =
\case
Lit [Text]
t String
_ Bool
_ -> [[Text] -> DocumentBody
RawText [Text]
t]
Concat Expr
e1 Expr
e2 String
_ Bool
_ -> 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 =
\case
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')
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
$ String -> Document -> Expr
fromDocument String
f 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] -> String -> Bool -> Expr
Lit [Text]
txts String
f Bool
False