{-# 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

-- |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 :: PrefixMappings -- ^The 'PrefixMappings' to be searched for the prefix that may be a part of the URI.
            -> T.Text         -- ^The URI.
            -> 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)

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

-- |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 :: T.Text  -- ^Aliased URI.
                -> 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)