    {-# 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
    (Relationship -> Relationship -> Bool)
    -> (Relationship -> Relationship -> Bool) -> Eq Relationship
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Relationship -> Relationship -> Bool
    == :: Relationship -> Relationship -> Bool
    $c/= :: Relationship -> Relationship -> Bool
    /= :: Relationship -> Relationship -> Bool
    Eq, Int -> Relationship -> ShowS
    [Relationship] -> ShowS
    Relationship -> FilePath
    (Int -> Relationship -> ShowS)
    -> (Relationship -> FilePath)
    -> ([Relationship] -> ShowS)
    -> Show Relationship
    forall a.
    (Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Relationship -> ShowS
    showsPrec :: Int -> Relationship -> ShowS
    $cshow :: Relationship -> FilePath
    show :: Relationship -> FilePath
    $cshowList :: [Relationship] -> ShowS
    showList :: [Relationship] -> ShowS
    Show, (forall x. Relationship -> Rep Relationship x)
    -> (forall x. Rep Relationship x -> Relationship)
    -> Generic Relationship
    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
    $cfrom :: forall x. Relationship -> Rep Relationship x
    from :: forall x. Relationship -> Rep Relationship x
    $cto :: forall x. Rep Relationship x -> Relationship
    to :: forall x. Rep Relationship x -> Relationship
    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
    (Relationships -> Relationships -> Bool)
    -> (Relationships -> Relationships -> Bool) -> Eq Relationships
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Relationships -> Relationships -> Bool
    == :: Relationships -> Relationships -> Bool
    $c/= :: Relationships -> Relationships -> Bool
    /= :: Relationships -> Relationships -> Bool
    Eq, Int -> Relationships -> ShowS
    [Relationships] -> ShowS
    Relationships -> FilePath
    (Int -> Relationships -> ShowS)
    -> (Relationships -> FilePath)
    -> ([Relationships] -> ShowS)
    -> Show Relationships
    forall a.
    (Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Relationships -> ShowS
    showsPrec :: Int -> Relationships -> ShowS
    $cshow :: Relationships -> FilePath
    show :: Relationships -> FilePath
    $cshowList :: [Relationships] -> ShowS
    showList :: [Relationships] -> ShowS
    Show, (forall x. Relationships -> Rep Relationships x)
    -> (forall x. Rep Relationships x -> Relationships)
    -> Generic Relationships
    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
    $cfrom :: forall x. Relationships -> Rep Relationships x
    from :: forall x. Relationships -> Rep Relationships x
    $cto :: forall x. Rep Relationships x -> Relationships
    to :: forall x. Rep Relationships x -> Relationships
    Generic)

    fromList :: [(RefId, Relationship)] -> Relationships
    fromList :: [(RefId, Relationship)] -> Relationships
    fromList = Map RefId Relationship -> Relationships
    Relationships (Map RefId Relationship -> Relationships)
    -> ([(RefId, Relationship)] -> Map RefId Relationship)
    -> [(RefId, Relationship)]
    -> Relationships
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [(RefId, Relationship)] -> Map RefId Relationship
    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 = Map RefId Relationship -> Int
    forall k a. Map k a -> Int
    Map.size (Map RefId Relationship -> Int)
    -> (Relationships -> Map RefId Relationship)
    -> Relationships
    -> Int
    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 = RefId -> Map RefId Relationship -> Maybe Relationship
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup RefId
    ref (Map RefId Relationship -> Maybe Relationship)
    -> (Relationships -> Map RefId Relationship)
    -> Relationships
    -> Maybe Relationship
    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 ((Relationship -> Relationship)
    -> Map RefId Relationship -> Map RefId Relationship
    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 = fp `joinRel` relTarget 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 ShowS
    forall a. a -> a
    id (URI
    relPath URI -> URI -> URI
    `nonStrictRelativeTo` URI
    base) FilePath
    ""
      where
        base :: URI
    base = FilePath -> Maybe URI -> URI
    forall a. Partial => FilePath -> Maybe a -> a
    fromJustNote FilePath
    "joinRel base path" (Maybe URI -> URI) -> Maybe URI -> URI
    forall a b. (a -> b) -> a -> b
    $ FilePath -> Maybe URI
    parseURIReference FilePath
    abs
        relPath :: URI
    relPath = FilePath -> Maybe URI -> URI
    forall a. Partial => FilePath -> Maybe a -> a
    fromJustNote FilePath
    "joinRel relative path" (Maybe URI -> URI) -> Maybe URI -> URI
    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 ShowS
    forall a. a -> a
    id (URI
    pathURI URI -> URI -> URI
    `relativeFrom` URI
    baseURI) FilePath
    ""
      where
        baseURI :: URI
    baseURI = FilePath -> Maybe URI -> URI
    forall a. Partial => FilePath -> Maybe a -> a
    fromJustNote FilePath
    "joinRel base path" (Maybe URI -> URI) -> Maybe URI -> URI
    forall a b. (a -> b) -> a -> b
    $ FilePath -> Maybe URI
    parseURIReference FilePath
    base
        pathURI :: URI
    pathURI = FilePath -> Maybe URI -> URI
    forall a. Partial => FilePath -> Maybe a -> a
    fromJustNote FilePath
    "joinRel relative path" (Maybe URI -> URI) -> Maybe URI -> URI
    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) = (Relationship -> Bool) -> [Relationship] -> Maybe Relationship
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
    find ((Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Text
    t) (Text -> Bool) -> (Relationship -> Text) -> Relationship -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Relationship -> Text
    relType) (Map RefId Relationship -> [Relationship]
    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) = (Relationship -> Bool) -> [Relationship] -> [Relationship]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Text
    t) (Text -> Bool) -> (Relationship -> Text) -> Relationship -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Relationship -> Text
    relType) (Map RefId Relationship -> [Relationship]
    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
                   (Element -> Document)
    -> (Relationships -> Element) -> Relationships -> Document
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> Relationships -> Element
    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 :: Relationships -> Map RefId Relationship
    relMap :: Map RefId Relationship
    ..} = Element
          { elementName :: Name
    elementName       = Name
    nm
          , elementAttributes :: Map Name Text
    elementAttributes = Map Name Text
    forall k a. Map k a
    Map.empty
          , elementNodes :: [Node]
    elementNodes      = ((RefId, Relationship) -> Node)
    -> [(RefId, Relationship)] -> [Node]
    forall a b. (a -> b) -> [a] -> [b]
    map (Element -> Node
    NodeElement (Element -> Node)
    -> ((RefId, Relationship) -> Element)
    -> (RefId, Relationship)
    -> Node
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> (RefId, Relationship) -> Element
    forall {a} {a}.
    (ToAttrVal a, ToElement a) =>
    Name -> (a, a) -> Element
    relToEl Name
    "Relationship") ([(RefId, Relationship)] -> [Node])
    -> [(RefId, Relationship)] -> [Node]
    forall a b. (a -> b) -> a -> b
    $
                                Map RefId Relationship -> [(RefId, Relationship)]
    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) = Name -> a -> Element -> Element
    forall a. ToAttrVal a => Name -> a -> Element -> Element
    setAttr Name
    "Id" a
    relId (Name -> a -> Element
    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
    relType :: Relationship -> Text
    relTarget :: Relationship -> FilePath
    relType :: Text
    relTarget :: FilePath
    ..} = Element
          { elementName :: Name
    elementName       = Name
    nm
          , elementAttributes :: Map Name Text
    elementAttributes = [(Name, Text)] -> Map Name Text
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList [ Name
    "Target" Name -> FilePath -> (Name, Text)
    forall a. ToAttrVal a => Name -> a -> (Name, Text)
    .= FilePath
    relTarget
                                             , Name
    "Type"   Name -> Text -> (Name, Text)
    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 Cursor
    -> (Cursor -> [(RefId, Relationship)]) -> [(RefId, Relationship)]
    forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
    $/ Name -> Axis
    element (Text -> Name
    prText
    "Relationship") Axis
    -> (Cursor -> [(RefId, Relationship)])
    -> Cursor
    -> [(RefId, Relationship)]
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m b) -> (b -> m c) -> a -> m c
    >=> Cursor -> [(RefId, Relationship)]
    parseRelEntry
        Relationships -> [Relationships]
    forall a. a -> [a]
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Relationships -> [Relationships])
    -> (Map RefId Relationship -> Relationships)
    -> Map RefId Relationship
    -> [Relationships]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Map RefId Relationship -> Relationships
    Relationships (Map RefId Relationship -> [Relationships])
    -> Map RefId Relationship -> [Relationships]
    forall a b. (a -> b) -> a -> b
    $ [(RefId, Relationship)] -> Map RefId Relationship
    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
      rel <- Cursor -> [Relationship]
    forall a. FromCursor a => Cursor -> [a]
    fromCursor Cursor
    cur
      rId <- attribute "Id" cur
      return (RefId rId, rel)

    instance FromCursor Relationship where
      fromCursor :: Cursor -> [Relationship]
    fromCursor Cursor
    cur =  do
        ty <- Name -> Cursor -> [Text]
    attribute Name
    "Type" Cursor
    cur
        trg <- T.unpack <$> attribute "Target" cur
        return $ Relationship ty 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 = Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    pkgRelNs
      , namePrefix :: Maybe Text
    namePrefix = Maybe Text
    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 = Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    odRelNs
      , namePrefix :: Maybe Text
    namePrefix = Maybe Text
    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 Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    t
      where
        stdPart :: Text
    stdPart = Text
    "http://schemas.openxmlformats.org/officeDocument/2006/relationships/"