{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE DeriveGeneric #-}
module Codec.Xlsx.Types.Internal.Relationships where

import Data.List (find)
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Monoid ((<>))
import Data.Text (Text)
import qualified Data.Text as T
import GHC.Generics (Generic)
import Network.URI hiding (path)
import Prelude hiding (abs, lookup)
import Safe
import Text.XML
import Text.XML.Cursor

import Codec.Xlsx.Parser.Internal
import Codec.Xlsx.Types.Internal
import Codec.Xlsx.Writer.Internal

data Relationship = Relationship
    { Relationship -> Text
relType   :: Text
    , Relationship -> FilePath
relTarget :: FilePath
    } deriving (Relationship -> Relationship -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Relationship -> Relationship -> Bool
$c/= :: Relationship -> Relationship -> Bool
== :: Relationship -> Relationship -> Bool
$c== :: Relationship -> Relationship -> Bool
Eq, Int -> Relationship -> ShowS
[Relationship] -> ShowS
Relationship -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Relationship] -> ShowS
$cshowList :: [Relationship] -> ShowS
show :: Relationship -> FilePath
$cshow :: Relationship -> FilePath
showsPrec :: Int -> Relationship -> ShowS
$cshowsPrec :: Int -> Relationship -> ShowS
Show, forall x. Rep Relationship x -> Relationship
forall x. Relationship -> Rep Relationship x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Relationship x -> Relationship
$cfrom :: forall x. Relationship -> Rep Relationship x
Generic)

-- | Describes relationships according to Open Packaging Convention
--
-- See ECMA-376, 4th Edition Office Open XML File Formats — Open Packaging
-- Conventions
newtype Relationships = Relationships
    { Relationships -> Map RefId Relationship
relMap :: Map RefId Relationship
    } deriving (Relationships -> Relationships -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Relationships -> Relationships -> Bool
$c/= :: Relationships -> Relationships -> Bool
== :: Relationships -> Relationships -> Bool
$c== :: Relationships -> Relationships -> Bool
Eq, Int -> Relationships -> ShowS
[Relationships] -> ShowS
Relationships -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Relationships] -> ShowS
$cshowList :: [Relationships] -> ShowS
show :: Relationships -> FilePath
$cshow :: Relationships -> FilePath
showsPrec :: Int -> Relationships -> ShowS
$cshowsPrec :: Int -> Relationships -> ShowS
Show, forall x. Rep Relationships x -> Relationships
forall x. Relationships -> Rep Relationships x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Relationships x -> Relationships
$cfrom :: forall x. Relationships -> Rep Relationships x
Generic)

fromList :: [(RefId, Relationship)] -> Relationships
fromList :: [(RefId, Relationship)] -> Relationships
fromList = Map RefId Relationship -> Relationships
Relationships forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList

empty :: Relationships
empty :: Relationships
empty = [(RefId, Relationship)] -> Relationships
fromList []

size :: Relationships -> Int
size :: Relationships -> Int
size = forall k a. Map k a -> Int
Map.size forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relationships -> Map RefId Relationship
relMap

relEntry :: RefId -> Text -> FilePath -> (RefId, Relationship)
relEntry :: RefId -> Text -> FilePath -> (RefId, Relationship)
relEntry RefId
rId Text
typ FilePath
trg = (RefId
rId, Text -> FilePath -> Relationship
Relationship (Text -> Text
stdRelType Text
typ) FilePath
trg)

lookup :: RefId -> Relationships -> Maybe Relationship
lookup :: RefId -> Relationships -> Maybe Relationship
lookup RefId
ref = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup RefId
ref forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relationships -> Map RefId Relationship
relMap

setTargetsFrom :: FilePath -> Relationships -> Relationships
setTargetsFrom :: FilePath -> Relationships -> Relationships
setTargetsFrom FilePath
fp (Relationships Map RefId Relationship
m) = Map RefId Relationship -> Relationships
Relationships (forall a b k. (a -> b) -> Map k a -> Map k b
Map.map Relationship -> Relationship
fixPath Map RefId Relationship
m)
    where
        fixPath :: Relationship -> Relationship
fixPath Relationship
rel = Relationship
rel{ relTarget :: FilePath
relTarget = FilePath
fp FilePath -> ShowS
`joinRel` Relationship -> FilePath
relTarget Relationship
rel}

-- | joins relative URI (actually a file path as an internal relation target)
joinRel :: FilePath -> FilePath -> FilePath
joinRel :: FilePath -> ShowS
joinRel FilePath
abs FilePath
rel = ShowS -> URI -> ShowS
uriToString forall a. a -> a
id (URI
relPath URI -> URI -> URI
`nonStrictRelativeTo` URI
base) FilePath
""
  where
    base :: URI
base = forall a. Partial => FilePath -> Maybe a -> a
fromJustNote FilePath
"joinRel base path" forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe URI
parseURIReference FilePath
abs
    relPath :: URI
relPath = forall a. Partial => FilePath -> Maybe a -> a
fromJustNote FilePath
"joinRel relative path" forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe URI
parseURIReference FilePath
rel

relFrom :: FilePath -> FilePath -> FilePath
relFrom :: FilePath -> ShowS
relFrom FilePath
path FilePath
base = ShowS -> URI -> ShowS
uriToString forall a. a -> a
id (URI
pathURI URI -> URI -> URI
`relativeFrom` URI
baseURI) FilePath
""
  where
    baseURI :: URI
baseURI = forall a. Partial => FilePath -> Maybe a -> a
fromJustNote FilePath
"joinRel base path" forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe URI
parseURIReference FilePath
base
    pathURI :: URI
pathURI = forall a. Partial => FilePath -> Maybe a -> a
fromJustNote FilePath
"joinRel relative path" forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe URI
parseURIReference FilePath
path

findRelByType :: Text -> Relationships -> Maybe Relationship
findRelByType :: Text -> Relationships -> Maybe Relationship
findRelByType Text
t (Relationships Map RefId Relationship
m) = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((forall a. Eq a => a -> a -> Bool
==Text
t) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relationship -> Text
relType) (forall k a. Map k a -> [a]
Map.elems Map RefId Relationship
m)

allByType :: Text -> Relationships -> [Relationship]
allByType :: Text -> Relationships -> [Relationship]
allByType Text
t (Relationships Map RefId Relationship
m) = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
==Text
t) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relationship -> Text
relType) (forall k a. Map k a -> [a]
Map.elems Map RefId Relationship
m)

{-------------------------------------------------------------------------------
  Rendering
-------------------------------------------------------------------------------}

instance ToDocument Relationships where
  toDocument :: Relationships -> Document
toDocument = Text -> Text -> Element -> Document
documentFromNsElement Text
"Relationships generated by xlsx" Text
pkgRelNs
               forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToElement a => Name -> a -> Element
toElement Name
"Relationships"

instance ToElement Relationships where
  toElement :: Name -> Relationships -> Element
toElement Name
nm Relationships{Map RefId Relationship
relMap :: Map RefId Relationship
relMap :: Relationships -> Map RefId Relationship
..} = Element
      { elementName :: Name
elementName       = Name
nm
      , elementAttributes :: Map Name Text
elementAttributes = forall k a. Map k a
Map.empty
      , elementNodes :: [Node]
elementNodes      = forall a b. (a -> b) -> [a] -> [b]
map (Element -> Node
NodeElement forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a} {a}.
(ToAttrVal a, ToElement a) =>
Name -> (a, a) -> Element
relToEl Name
"Relationship") forall a b. (a -> b) -> a -> b
$
                            forall k a. Map k a -> [(k, a)]
Map.toList Map RefId Relationship
relMap
      }
    where
      relToEl :: Name -> (a, a) -> Element
relToEl Name
nm' (a
relId, a
rel) = forall a. ToAttrVal a => Name -> a -> Element -> Element
setAttr Name
"Id" a
relId (forall a. ToElement a => Name -> a -> Element
toElement Name
nm' a
rel)

instance ToElement Relationship where
  toElement :: Name -> Relationship -> Element
toElement Name
nm Relationship{FilePath
Text
relTarget :: FilePath
relType :: Text
relTarget :: Relationship -> FilePath
relType :: Relationship -> Text
..} = Element
      { elementName :: Name
elementName       = Name
nm
      , elementAttributes :: Map Name Text
elementAttributes = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ Name
"Target" forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= FilePath
relTarget
                                         , Name
"Type"   forall a. ToAttrVal a => Name -> a -> (Name, Text)
.= Text
relType ]
      , elementNodes :: [Node]
elementNodes      = []
      }

{-------------------------------------------------------------------------------
  Parsing
-------------------------------------------------------------------------------}
instance FromCursor Relationships where
  fromCursor :: Cursor -> [Relationships]
fromCursor Cursor
cur = do
    let items :: [(RefId, Relationship)]
items = Cursor
cur forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
prText
"Relationship") forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Cursor -> [(RefId, Relationship)]
parseRelEntry
    forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map RefId Relationship -> Relationships
Relationships forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(RefId, Relationship)]
items

parseRelEntry :: Cursor -> [(RefId, Relationship)]
parseRelEntry :: Cursor -> [(RefId, Relationship)]
parseRelEntry Cursor
cur = do
  Relationship
rel <- forall a. FromCursor a => Cursor -> [a]
fromCursor Cursor
cur
  Text
rId <- Name -> Cursor -> [Text]
attribute Name
"Id" Cursor
cur
  forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> RefId
RefId Text
rId, Relationship
rel)

instance FromCursor Relationship where
  fromCursor :: Cursor -> [Relationship]
fromCursor Cursor
cur =  do
    Text
ty <- Name -> Cursor -> [Text]
attribute Name
"Type" Cursor
cur
    FilePath
trg <- Text -> FilePath
T.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> Cursor -> [Text]
attribute Name
"Target" Cursor
cur
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> FilePath -> Relationship
Relationship Text
ty FilePath
trg

-- | Add package relationship namespace to name
pr :: Text -> Name
pr :: Text -> Name
pr Text
x = Name
  { nameLocalName :: Text
nameLocalName = Text
x
  , nameNamespace :: Maybe Text
nameNamespace = forall a. a -> Maybe a
Just Text
pkgRelNs
  , namePrefix :: Maybe Text
namePrefix = forall a. Maybe a
Nothing
  }

-- | Add office document relationship namespace to name
odr :: Text -> Name
odr :: Text -> Name
odr Text
x = Name
  { nameLocalName :: Text
nameLocalName = Text
x
  , nameNamespace :: Maybe Text
nameNamespace = forall a. a -> Maybe a
Just Text
odRelNs
  , namePrefix :: Maybe Text
namePrefix = forall a. Maybe a
Nothing
  }

odRelNs :: Text
odRelNs :: Text
odRelNs = Text
"http://schemas.openxmlformats.org/officeDocument/2006/relationships"

pkgRelNs :: Text
pkgRelNs :: Text
pkgRelNs = Text
"http://schemas.openxmlformats.org/package/2006/relationships"

stdRelType :: Text -> Text
stdRelType :: Text -> Text
stdRelType Text
t = Text
stdPart forall a. Semigroup a => a -> a -> a
<> Text
t
  where
    stdPart :: Text
stdPart = Text
"http://schemas.openxmlformats.org/officeDocument/2006/relationships/"