{-# LANGUAGE OverloadedStrings, TemplateHaskell #-}
module Data.Library.IRI
( IRI(Relative, Absolute)
, toIRI
, fromIRI
, isRelative
, isAbsolute
, extension
, domain
, protocol
, dirs
)
where

import Data.Text (Text, breakOn, split, splitOn)
import qualified Data.Text as T 
import Data.Maybe
import Data.Aeson (ToJSON(toJSON), FromJSON(parseJSON), Value(String))
import Control.Monad (mzero)
import Control.Applicative ((<$>))
import Data.SafeCopy (deriveSafeCopy, base)

data IRI = Relative Text
         | Absolute Text
         deriving(Show)
deriveSafeCopy 0 'base ''IRI -- from Data.SafeCopy

instance ToJSON IRI where
    toJSON = toJSON . fromIRI
instance FromJSON IRI where
    parseJSON (String s) = toIRI <$> return s
    parseJSON _ = mzero

toIRI :: Text -> IRI
toIRI t = if isTxtRelative then Relative t
                           else Absolute t
    where isTxtRelative = T.null . snd $ breakOn "://" t

fromIRI :: IRI -> Text
fromIRI (Relative t) = t
fromIRI (Absolute t) = t

isRelative :: IRI -> Bool
isRelative (Relative _) = True
isRelative _ = False

isAbsolute :: IRI -> Bool
isAbsolute (Absolute _) = True
isAbsolute _ = False

extension :: IRI -> Maybe Text
extension = isDir . listToMaybe . reverse . split (== '.') . fromIRI
    where
        isDir = maybe Nothing (\t -> if T.last t == '/' then Nothing else Just t)

domain :: IRI -> Maybe Text
domain (Relative _) = Nothing
domain (Absolute t) = listToMaybe . drop 2 . splitOn "/" $ t

protocol :: IRI -> Maybe Text
protocol (Relative _) = Nothing
protocol (Absolute t) = listToMaybe $ splitOn "://" $ t

dirs :: IRI -> [Text]
dirs (Relative t) = split (== '/') t
dirs (Absolute t) = drop 3 $ split (== '/') t