{-# LANGUAGE CPP #-}

-- | An RDF serializer for Turtle
--  <http://www.w3.org/TeamSubmission/turtle/>.
module Text.RDF.RDF4H.TurtleSerializer
  (TurtleSerializer (TurtleSerializer))
where

#if MIN_VERSION_base(4,9,0)
#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup ((<>))
#else
#endif
#else
#endif

import Control.Monad
import Data.List (groupBy, sort)
import qualified Data.Map as Map
import Data.RDF.Namespace hiding (rdf)
import Data.RDF.Query
import Data.RDF.Types
import qualified Data.Text as T
import qualified Data.Text.IO as T
import System.IO
import Text.RDF.RDF4H.TurtleSerializer.Internal

data TurtleSerializer = TurtleSerializer (Maybe T.Text) PrefixMappings

instance RdfSerializer TurtleSerializer where
  hWriteRdf :: TurtleSerializer -> Handle -> RDF a -> IO ()
hWriteRdf (TurtleSerializer Maybe Text
docUrl PrefixMappings
pms) Handle
h RDF a
rdf = Handle -> Maybe Text -> RDF a -> IO ()
forall a. Rdf a => Handle -> Maybe Text -> RDF a -> IO ()
_writeRdf Handle
h Maybe Text
docUrl (RDF a -> PrefixMappings -> Bool -> RDF a
forall rdfImpl.
Rdf rdfImpl =>
RDF rdfImpl -> PrefixMappings -> Bool -> RDF rdfImpl
addPrefixMappings RDF a
rdf PrefixMappings
pms Bool
False)
  writeRdf :: TurtleSerializer -> RDF a -> IO ()
writeRdf TurtleSerializer
s = TurtleSerializer -> Handle -> RDF a -> IO ()
forall s a.
(RdfSerializer s, Rdf a) =>
s -> Handle -> RDF a -> IO ()
hWriteRdf TurtleSerializer
s Handle
stdout
  hWriteH :: TurtleSerializer -> Handle -> RDF a -> IO ()
hWriteH (TurtleSerializer Maybe Text
_ PrefixMappings
pms) Handle
h RDF a
rdf = Handle -> Maybe BaseUrl -> PrefixMappings -> IO ()
writeHeader Handle
h (RDF a -> Maybe BaseUrl
forall rdfImpl. Rdf rdfImpl => RDF rdfImpl -> Maybe BaseUrl
baseUrl RDF a
rdf) (RDF a -> PrefixMappings
forall rdfImpl. Rdf rdfImpl => RDF rdfImpl -> PrefixMappings
prefixMappings RDF a
rdf PrefixMappings -> PrefixMappings -> PrefixMappings
forall a. Semigroup a => a -> a -> a
<> PrefixMappings
pms)
  writeH :: TurtleSerializer -> RDF a -> IO ()
writeH TurtleSerializer
s = TurtleSerializer -> Handle -> RDF a -> IO ()
forall s a.
(RdfSerializer s, Rdf a) =>
s -> Handle -> RDF a -> IO ()
hWriteRdf TurtleSerializer
s Handle
stdout

  -- TODO: should use mdUrl to render <> where appropriate
  hWriteTs :: TurtleSerializer -> Handle -> Triples -> IO ()
hWriteTs (TurtleSerializer Maybe Text
docUrl PrefixMappings
pms) Handle
h = Handle -> Maybe Text -> PrefixMappings -> Triples -> IO ()
writeTriples Handle
h Maybe Text
docUrl PrefixMappings
pms
  writeTs :: TurtleSerializer -> Triples -> IO ()
writeTs TurtleSerializer
s = TurtleSerializer -> Handle -> Triples -> IO ()
forall s. RdfSerializer s => s -> Handle -> Triples -> IO ()
hWriteTs TurtleSerializer
s Handle
stdout
  hWriteT :: TurtleSerializer -> Handle -> Triple -> IO ()
hWriteT (TurtleSerializer Maybe Text
docUrl PrefixMappings
pms) Handle
h = Handle -> Maybe Text -> PrefixMappings -> Triple -> IO ()
writeTriple Handle
h Maybe Text
docUrl PrefixMappings
pms
  writeT :: TurtleSerializer -> Triple -> IO ()
writeT TurtleSerializer
s = TurtleSerializer -> Handle -> Triple -> IO ()
forall s. RdfSerializer s => s -> Handle -> Triple -> IO ()
hWriteT TurtleSerializer
s Handle
stdout
  hWriteN :: TurtleSerializer -> Handle -> Node -> IO ()
hWriteN (TurtleSerializer Maybe Text
docUrl PrefixMappings
pms) Handle
h Node
n = Handle -> Maybe Text -> Node -> PrefixMappings -> IO ()
writeNode Handle
h Maybe Text
docUrl Node
n PrefixMappings
pms
  writeN :: TurtleSerializer -> Node -> IO ()
writeN TurtleSerializer
s = TurtleSerializer -> Handle -> Node -> IO ()
forall s. RdfSerializer s => s -> Handle -> Node -> IO ()
hWriteN TurtleSerializer
s Handle
stdout

-- TODO: writeRdf currently merges standard namespace prefix mappings with
-- the ones that the RDF already contains, so that if the RDF has none
-- (e.g., was parsed from ntriples RDF) the output still uses prefix for
-- common mappings like rdf, owl, and the like. This behavior should be
-- configurable somehow, so that if the user really doesn't want any extra
-- prefix declarations added, that is possible.

_writeRdf :: Rdf a => Handle -> Maybe T.Text -> RDF a -> IO ()
_writeRdf :: Handle -> Maybe Text -> RDF a -> IO ()
_writeRdf Handle
h Maybe Text
mdUrl RDF a
rdf =
  Handle -> Maybe BaseUrl -> PrefixMappings -> IO ()
writeHeader Handle
h Maybe BaseUrl
bUrl PrefixMappings
pms' IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> Maybe Text -> PrefixMappings -> Triples -> IO ()
writeTriples Handle
h Maybe Text
mdUrl PrefixMappings
pms' Triples
ts IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> Char -> IO ()
hPutChar Handle
h Char
'\n'
  where
    bUrl :: Maybe BaseUrl
bUrl = RDF a -> Maybe BaseUrl
forall rdfImpl. Rdf rdfImpl => RDF rdfImpl -> Maybe BaseUrl
baseUrl RDF a
rdf
    -- a merged set of prefix mappings using those from the standard_ns_mappings
    -- that are not defined already (union is left-biased).
    pms' :: PrefixMappings
pms' = Map Text Text -> PrefixMappings
PrefixMappings (Map Text Text -> PrefixMappings)
-> Map Text Text -> PrefixMappings
forall a b. (a -> b) -> a -> b
$ (PrefixMappings -> Map Text Text
asMap (PrefixMappings -> Map Text Text)
-> PrefixMappings -> Map Text Text
forall a b. (a -> b) -> a -> b
$ RDF a -> PrefixMappings
forall rdfImpl. Rdf rdfImpl => RDF rdfImpl -> PrefixMappings
prefixMappings RDF a
rdf)
    asMap :: PrefixMappings -> Map Text Text
asMap (PrefixMappings Map Text Text
x) = Map Text Text
x
    ts :: Triples
ts = RDF a -> Triples
forall rdfImpl. Rdf rdfImpl => RDF rdfImpl -> Triples
triplesOf RDF a
rdf

writeHeader :: Handle -> Maybe BaseUrl -> PrefixMappings -> IO ()
writeHeader :: Handle -> Maybe BaseUrl -> PrefixMappings -> IO ()
writeHeader Handle
h Maybe BaseUrl
bUrl PrefixMappings
pms = Handle -> Maybe BaseUrl -> IO ()
writeBase Handle
h Maybe BaseUrl
bUrl IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> PrefixMappings -> IO ()
writePrefixes Handle
h PrefixMappings
pms

writeBase :: Handle -> Maybe BaseUrl -> IO ()
writeBase :: Handle -> Maybe BaseUrl -> IO ()
writeBase Handle
_ Maybe BaseUrl
Nothing =
  () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
writeBase Handle
h (Just (BaseUrl Text
bUrl)) =
  Handle -> String -> IO ()
hPutStr Handle
h String
"@base " IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> Char -> IO ()
hPutChar Handle
h Char
'<' IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> Text -> IO ()
T.hPutStr Handle
h Text
bUrl IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> String -> IO ()
hPutStr Handle
h String
"> ." IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> Char -> IO ()
hPutChar Handle
h Char
'\n'

writePrefixes :: Handle -> PrefixMappings -> IO ()
writePrefixes :: Handle -> PrefixMappings -> IO ()
writePrefixes Handle
h PrefixMappings
pms = ((Text, Text) -> IO ()) -> [(Text, Text)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> (Text, Text) -> IO ()
writePrefix Handle
h) (PrefixMappings -> [(Text, Text)]
toPMList PrefixMappings
pms) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> Char -> IO ()
hPutChar Handle
h Char
'\n'

writePrefix :: Handle -> (T.Text, T.Text) -> IO ()
writePrefix :: Handle -> (Text, Text) -> IO ()
writePrefix Handle
h (Text
pre, Text
uri) =
  Handle -> String -> IO ()
hPutStr Handle
h String
"@prefix " IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> Text -> IO ()
T.hPutStr Handle
h Text
pre IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> String -> IO ()
hPutStr Handle
h String
": "
    IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> Char -> IO ()
hPutChar Handle
h Char
'<'
    IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> Text -> IO ()
T.hPutStr Handle
h Text
uri
    IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> String -> IO ()
hPutStr Handle
h String
"> ."
    IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> Char -> IO ()
hPutChar Handle
h Char
'\n'

writeTriples :: Handle -> Maybe T.Text -> PrefixMappings -> Triples -> IO ()
writeTriples :: Handle -> Maybe Text -> PrefixMappings -> Triples -> IO ()
writeTriples Handle
h Maybe Text
mdUrl (PrefixMappings Map Text Text
pms) Triples
ts =
  (Triples -> IO ()) -> [Triples] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> Maybe Text -> PrefixMappings -> Triples -> IO ()
writeSubjGroup Handle
h Maybe Text
mdUrl PrefixMappings
revPms) ((Triple -> Triple -> Bool) -> Triples -> [Triples]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy Triple -> Triple -> Bool
equalSubjects (Triples -> Triples
forall a. Ord a => [a] -> [a]
sort Triples
ts))
  where
    revPms :: PrefixMappings
revPms = Map Text Text -> PrefixMappings
PrefixMappings (Map Text Text -> PrefixMappings)
-> ([(Text, Text)] -> Map Text Text)
-> [(Text, Text)]
-> PrefixMappings
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Text)] -> Map Text Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, Text)] -> PrefixMappings)
-> [(Text, Text)] -> PrefixMappings
forall a b. (a -> b) -> a -> b
$ (\(Text
k, Text
v) -> (Text
v, Text
k)) ((Text, Text) -> (Text, Text)) -> [(Text, Text)] -> [(Text, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text Text
pms

writeTriple :: Handle -> Maybe T.Text -> PrefixMappings -> Triple -> IO ()
writeTriple :: Handle -> Maybe Text -> PrefixMappings -> Triple -> IO ()
writeTriple Handle
h Maybe Text
mdUrl PrefixMappings
pms Triple
t =
  (Triple -> Node) -> IO ()
w Triple -> Node
subjectOf IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
space IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Triple -> Node) -> IO ()
w Triple -> Node
predicateOf IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
space IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Triple -> Node) -> IO ()
w Triple -> Node
objectOf
  where
    w :: (Triple -> Node) -> IO ()
    w :: (Triple -> Node) -> IO ()
w Triple -> Node
f = Handle -> Maybe Text -> Node -> PrefixMappings -> IO ()
writeNode Handle
h Maybe Text
mdUrl (Triple -> Node
f Triple
t) PrefixMappings
pms
    space :: IO ()
space = Handle -> Char -> IO ()
hPutChar Handle
h Char
' '

-- Write a group of triples that all have the same subject, with the subject only
-- being output once, and comma or semi-colon used as appropriate.
writeSubjGroup :: Handle -> Maybe T.Text -> PrefixMappings -> Triples -> IO ()
writeSubjGroup :: Handle -> Maybe Text -> PrefixMappings -> Triples -> IO ()
writeSubjGroup Handle
_ Maybe Text
_ PrefixMappings
_ [] = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
writeSubjGroup Handle
h Maybe Text
dUrl PrefixMappings
pms ts :: Triples
ts@(Triple
t : Triples
_) =
  Handle -> Maybe Text -> Node -> PrefixMappings -> IO ()
writeNode Handle
h Maybe Text
dUrl (Triple -> Node
subjectOf Triple
t) PrefixMappings
pms IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> Char -> IO ()
hPutChar Handle
h Char
' '
    IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> Maybe Text -> PrefixMappings -> Triples -> IO ()
writePredGroup Handle
h Maybe Text
dUrl PrefixMappings
pms ([Triples] -> Triples
forall a. [a] -> a
head [Triples]
ts')
    IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Triples -> IO ()) -> [Triples] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Triples
t' -> Handle -> String -> IO ()
hPutStr Handle
h String
";\n\t" IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> Maybe Text -> PrefixMappings -> Triples -> IO ()
writePredGroup Handle
h Maybe Text
dUrl PrefixMappings
pms Triples
t') ([Triples] -> [Triples]
forall a. [a] -> [a]
tail [Triples]
ts')
    IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> String -> IO ()
hPutStrLn Handle
h String
" ."
  where
    ts' :: [Triples]
ts' = (Triple -> Triple -> Bool) -> Triples -> [Triples]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy Triple -> Triple -> Bool
equalPredicates Triples
ts

-- Write a group of triples that all have the same subject and the same predicate,
-- assuming the subject has already been output and only the predicate and objects
-- need to be written.
writePredGroup :: Handle -> Maybe T.Text -> PrefixMappings -> Triples -> IO ()
writePredGroup :: Handle -> Maybe Text -> PrefixMappings -> Triples -> IO ()
writePredGroup Handle
_ Maybe Text
_ PrefixMappings
_ [] = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
writePredGroup Handle
h Maybe Text
docUrl PrefixMappings
pms (Triple
t : Triples
ts) =
  -- The doesn't rule out <> in either the predicate or object (as well as subject),
  -- so we pass the docUrl through to writeNode in all cases.
  Handle -> Maybe Text -> Node -> PrefixMappings -> IO ()
writeNode Handle
h Maybe Text
docUrl (Triple -> Node
predicateOf Triple
t) PrefixMappings
pms IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> Char -> IO ()
hPutChar Handle
h Char
' '
    IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> Maybe Text -> Node -> PrefixMappings -> IO ()
writeNode Handle
h Maybe Text
docUrl (Triple -> Node
objectOf Triple
t) PrefixMappings
pms
    IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Triple -> IO ()) -> Triples -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Triple
t' -> Handle -> String -> IO ()
hPutStr Handle
h String
", " IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> Maybe Text -> Node -> PrefixMappings -> IO ()
writeNode Handle
h Maybe Text
docUrl (Triple -> Node
objectOf Triple
t') PrefixMappings
pms) Triples
ts

writeNode :: Handle -> Maybe T.Text -> Node -> PrefixMappings -> IO ()
writeNode :: Handle -> Maybe Text -> Node -> PrefixMappings -> IO ()
writeNode Handle
h Maybe Text
mdUrl Node
node PrefixMappings
pms =
  case Node
node of
    (UNode Text
bs) ->
      let currUri :: Text
currUri = Text
bs
       in case Maybe Text
mdUrl of
            Maybe Text
Nothing -> Handle -> Text -> PrefixMappings -> IO ()
writeUNodeUri Handle
h Text
currUri PrefixMappings
pms
            Just Text
url -> if Text
url Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
currUri then Handle -> String -> IO ()
hPutStr Handle
h String
"<>" else Handle -> Text -> PrefixMappings -> IO ()
writeUNodeUri Handle
h Text
currUri PrefixMappings
pms
    (BNode Text
gId) -> Handle -> Text -> IO ()
T.hPutStr Handle
h Text
gId
    (BNodeGen Int
i) -> String -> IO ()
putStr String
"_:genid" IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> String -> IO ()
hPutStr Handle
h (Int -> String
forall a. Show a => a -> String
show Int
i)
    (LNode LValue
n) -> Handle -> LValue -> PrefixMappings -> IO ()
writeLValue Handle
h LValue
n PrefixMappings
pms

-- Print prefix mappings to stdout for debugging.
_debugPMs :: PrefixMappings -> IO ()
_debugPMs :: PrefixMappings -> IO ()
_debugPMs (PrefixMappings Map Text Text
pms) = ((Text, Text) -> IO ()) -> [(Text, Text)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Text
k, Text
v) -> Text -> IO ()
T.putStr Text
k IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> IO ()
putStr String
"__" IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> IO ()
T.putStrLn Text
v) (Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text Text
pms)

writeLValue :: Handle -> LValue -> PrefixMappings -> IO ()
writeLValue :: Handle -> LValue -> PrefixMappings -> IO ()
writeLValue Handle
h LValue
lv PrefixMappings
pms =
  case LValue
lv of
    (PlainL Text
lit) -> Handle -> Text -> IO ()
writeLiteralString Handle
h Text
lit
    (PlainLL Text
lit Text
lang) ->
      Handle -> Text -> IO ()
writeLiteralString Handle
h Text
lit
        IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> String -> IO ()
hPutStr Handle
h String
"@"
        IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> Text -> IO ()
T.hPutStr Handle
h Text
lang
    (TypedL Text
lit Text
dtype) ->
      Handle -> Text -> IO ()
writeLiteralString Handle
h Text
lit
        IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> String -> IO ()
hPutStr Handle
h String
"^^"
        IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> Text -> PrefixMappings -> IO ()
writeUNodeUri Handle
h Text
dtype PrefixMappings
pms

-- writeUNodeUri h (T.reverse dtype) pms

writeLiteralString :: Handle -> T.Text -> IO ()
writeLiteralString :: Handle -> Text -> IO ()
writeLiteralString Handle
h Text
bs =
  do
    Handle -> Char -> IO ()
hPutChar Handle
h Char
'"'
    IO Bool -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ((IO Bool -> Char -> IO Bool) -> IO Bool -> Text -> IO Bool
forall a. (a -> Char -> a) -> a -> Text -> a
T.foldl' IO Bool -> Char -> IO Bool
writeChar (Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True) Text
bs)
    Handle -> Char -> IO ()
hPutChar Handle
h Char
'"'
  where
    writeChar :: IO Bool -> Char -> IO Bool
    writeChar :: IO Bool -> Char -> IO Bool
writeChar IO Bool
b Char
c =
      case Char
c of
        Char
'\n' -> IO Bool
b IO Bool -> (Bool -> IO Bool) -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
b' -> Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
b' (Handle -> Char -> IO ()
hPutChar Handle
h Char
'\\' IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> Char -> IO ()
hPutChar Handle
h Char
'n') IO () -> IO Bool -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
        Char
'\t' -> IO Bool
b IO Bool -> (Bool -> IO Bool) -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
b' -> Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
b' (Handle -> Char -> IO ()
hPutChar Handle
h Char
'\\' IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> Char -> IO ()
hPutChar Handle
h Char
't') IO () -> IO Bool -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
        Char
'\r' -> IO Bool
b IO Bool -> (Bool -> IO Bool) -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
b' -> Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
b' (Handle -> Char -> IO ()
hPutChar Handle
h Char
'\\' IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> Char -> IO ()
hPutChar Handle
h Char
'r') IO () -> IO Bool -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
        Char
'"' -> IO Bool
b IO Bool -> (Bool -> IO Bool) -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
b' -> Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
b' (Handle -> Char -> IO ()
hPutChar Handle
h Char
'\\' IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> Char -> IO ()
hPutChar Handle
h Char
'"') IO () -> IO Bool -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
        Char
'\\' -> IO Bool
b IO Bool -> (Bool -> IO Bool) -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
b' -> Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
b' (Handle -> Char -> IO ()
hPutChar Handle
h Char
'\\' IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> Char -> IO ()
hPutChar Handle
h Char
'\\') IO () -> IO Bool -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
        Char
_ -> IO Bool
b IO Bool -> (Bool -> IO Bool) -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
b' -> Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
b' (Handle -> Char -> IO ()
hPutChar Handle
h Char
c) IO () -> IO Bool -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True