{-# LANGUAGE OverloadedStrings #-}

module Text.RDF.RDF4H.TurtleSerializer.Internal
  ( findMapping,
    writeUNodeUri,
  )
where

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

-- | Converts an aliased URI (e.g., 'rdf:subject') to a tuple whose first element
--  is the full (non-aliased) URI and whose second element is the target/path
--  portion (the part after the colon in the aliased URI).
findMapping ::
  -- | The 'PrefixMappings' to be searched for the prefix that may be a part of the URI.
  PrefixMappings ->
  -- | The URI.
  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 a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
uri, Text
target)

-- | Writes the given 'UNode' to the given 'Handle'.
writeUNodeUri ::
  -- | The Handle to write to
  Handle ->
  -- | The text from a UNode
  T.Text ->
  -- | The 'PrefixMappings' which should contain a mapping for any prefix found in the URI.
  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 a b. IO a -> IO b -> IO b
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 a b. IO a -> IO b -> IO b
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 m a. Monoid m => (a -> m) -> [a] -> m
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`)
          ]

-- | Given an aliased URI (e.g., 'rdf:subject') return a tuple whose first
--  element is the alias ('rdf') and whose second part is the path or fragment
--  ('subject').
splitAliasedURI ::
  -- | Aliased URI.
  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 a. a -> Maybe a
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. HasCallStack => [a] -> [a]
tail String
target)