{-# LANGUAGE OverloadedStrings #-}
module Text.RDF.RDF4H.TurtleSerializer.Internal
( findMapping
, writeUNodeUri
)
where
import Data.Foldable (fold)
import Data.List (elemIndex)
import qualified Data.Map as Map
import Data.Monoid (Any(..), getAny)
import Data.RDF.Namespace hiding (rdf)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import System.IO
findMapping :: PrefixMappings
-> T.Text
-> Maybe (T.Text, T.Text)
findMapping :: PrefixMappings -> Text -> Maybe (Text, Text)
findMapping (PrefixMappings Map Text Text
pms) Text
aliasedURI = do
(Text
prefix, Text
target) <- Text -> Maybe (Text, Text)
splitAliasedURI Text
aliasedURI
Text
uri <- Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
prefix Map Text Text
pms
(Text, Text) -> Maybe (Text, Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
uri, Text
target)
writeUNodeUri :: Handle
-> T.Text
-> PrefixMappings
-> IO ()
writeUNodeUri :: Handle -> Text -> PrefixMappings -> IO ()
writeUNodeUri Handle
h Text
uri PrefixMappings
_ =
if (Text -> Bool
isQName Text
uri)
then Handle -> Text -> IO ()
T.hPutStr Handle
h Text
uri
else 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 -> Char -> IO ()
hPutChar Handle
h Char
'>'
isQName :: T.Text -> Bool
isQName :: Text -> Bool
isQName = Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
isFullURI
where isFullURI :: T.Text -> Bool
isFullURI :: Text -> Bool
isFullURI = Any -> Bool
getAny (Any -> Bool) -> (Text -> Any) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text -> Bool) -> Text -> Any) -> [Text -> Bool] -> Text -> Any
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Bool -> Any
Any (Bool -> Any) -> (Text -> Bool) -> Text -> Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) [ (Text
"http://" Text -> Text -> Bool
`T.isPrefixOf`)
, (Text
"https://" Text -> Text -> Bool
`T.isPrefixOf`)
, (Text
"file://" Text -> Text -> Bool
`T.isPrefixOf`)
]
splitAliasedURI :: T.Text
-> Maybe (T.Text, T.Text)
splitAliasedURI :: Text -> Maybe (Text, Text)
splitAliasedURI Text
uri = do
let uriStr :: String
uriStr = Text -> String
T.unpack Text
uri
Int
i <- Char -> String -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex Char
':' String
uriStr
let (String
prefix, String
target) = Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
i String
uriStr
(Text, Text) -> Maybe (Text, Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Text
T.pack String
prefix, String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. [a] -> [a]
tail String
target)