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

    import Control.Arrow
    import Data.Foldable (asum)
    import Data.Map (Map)
    import qualified Data.Map as M
    import Data.Text (Text)
    import qualified Data.Text as T
    import GHC.Generics (Generic)
    import System.FilePath.Posix (takeExtension)
    import Text.XML
    import Text.XML.Cursor

    import Codec.Xlsx.Parser.Internal

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

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

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

    lookup :: FilePath -> ContentTypes -> Maybe Text
    lookup :: FilePath -> ContentTypes -> Maybe Text
    lookup FilePath
    path ContentTypes{Map FilePath Text
    ctDefaults :: ContentTypes -> Map FilePath Text
    ctTypes :: ContentTypes -> Map FilePath Text
    ctDefaults :: Map FilePath Text
    ctTypes :: Map FilePath Text
    ..} =
        [Maybe Text] -> Maybe Text
    forall (t :: * -> *) (f :: * -> *) a.
    (Foldable t, Alternative f) =>
    t (f a) -> f a
    asum [ (FilePath -> Map FilePath Text -> Maybe Text)
    -> Map FilePath Text -> FilePath -> Maybe Text
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip FilePath -> Map FilePath Text -> Maybe Text
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup Map FilePath Text
    ctDefaults (FilePath -> Maybe Text) -> Maybe FilePath -> Maybe Text
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Maybe FilePath
    ext, FilePath -> Map FilePath Text -> Maybe Text
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup FilePath
    path Map FilePath Text
    ctTypes ]
      where
        ext :: Maybe FilePath
    ext = case ShowS
    takeExtension FilePath
    path of
            Char
    '.':FilePath
    e -> FilePath -> Maybe FilePath
    forall a. a -> Maybe a
    Just FilePath
    e
            FilePath
    _     -> Maybe FilePath
    forall a. Maybe a
    Nothing

    {-------------------------------------------------------------------------------
      Parsing
    -------------------------------------------------------------------------------}
    instance FromCursor ContentTypes where
        fromCursor :: Cursor -> [ContentTypes]
    fromCursor Cursor
    cur = do
            let ds :: Map FilePath Text
    ds = [(FilePath, Text)] -> Map FilePath Text
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList ([(FilePath, Text)] -> Map FilePath Text)
    -> ([CtDefault] -> [(FilePath, Text)])
    -> [CtDefault]
    -> Map FilePath Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (CtDefault -> (FilePath, Text))
    -> [CtDefault] -> [(FilePath, Text)]
    forall a b. (a -> b) -> [a] -> [b]
    map (CtDefault -> FilePath
    dfltExtension (CtDefault -> FilePath)
    -> (CtDefault -> Text) -> CtDefault -> (FilePath, Text)
    forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
    forall (a :: * -> * -> *) b c c'.
    Arrow a =>
    a b c -> a b c' -> a b (c, c')
    &&& CtDefault -> Text
    dfltContentType) ([CtDefault] -> Map FilePath Text)
    -> [CtDefault] -> Map FilePath Text
    forall a b. (a -> b) -> a -> b
    $
                     Cursor
    cur Cursor -> (Cursor -> [CtDefault]) -> [CtDefault]
    forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
    $/ Name -> Axis
    element (Text -> Name
    ctText
    "Default") Axis -> (Cursor -> [CtDefault]) -> Cursor -> [CtDefault]
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m b) -> (b -> m c) -> a -> m c
    >=> Cursor -> [CtDefault]
    forall a. FromCursor a => Cursor -> [a]
    fromCursor
                ts :: Map FilePath Text
    ts = [(FilePath, Text)] -> Map FilePath Text
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList ([(FilePath, Text)] -> Map FilePath Text)
    -> ([Override] -> [(FilePath, Text)])
    -> [Override]
    -> Map FilePath Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Override -> (FilePath, Text)) -> [Override] -> [(FilePath, Text)]
    forall a b. (a -> b) -> [a] -> [b]
    map (Override -> FilePath
    ovrPartName (Override -> FilePath)
    -> (Override -> Text) -> Override -> (FilePath, Text)
    forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
    forall (a :: * -> * -> *) b c c'.
    Arrow a =>
    a b c -> a b c' -> a b (c, c')
    &&& Override -> Text
    ovrContentType) ([Override] -> Map FilePath Text)
    -> [Override] -> Map FilePath Text
    forall a b. (a -> b) -> a -> b
    $
                     Cursor
    cur Cursor -> (Cursor -> [Override]) -> [Override]
    forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
    $/ Name -> Axis
    element (Text -> Name
    ctText
    "Override") Axis -> (Cursor -> [Override]) -> Cursor -> [Override]
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m b) -> (b -> m c) -> a -> m c
    >=> Cursor -> [Override]
    forall a. FromCursor a => Cursor -> [a]
    fromCursor
            ContentTypes -> [ContentTypes]
    forall a. a -> [a]
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Map FilePath Text -> Map FilePath Text -> ContentTypes
    ContentTypes Map FilePath Text
    ds Map FilePath Text
    ts)

    instance FromCursor CtDefault where
       fromCursor :: Cursor -> [CtDefault]
    fromCursor Cursor
    cur = do
           dfltExtension <- Text -> FilePath
    T.unpack (Text -> FilePath) -> [Text] -> [FilePath]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Name -> Cursor -> [Text]
    attribute Name
    "Extension" Cursor
    cur
           dfltContentType <- attribute "ContentType" cur
           return CtDefault{..}

    instance FromCursor Override where
       fromCursor :: Cursor -> [Override]
    fromCursor Cursor
    cur = do
           ovrPartName <- Text -> FilePath
    T.unpack (Text -> FilePath) -> [Text] -> [FilePath]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Name -> Cursor -> [Text]
    attribute Name
    "PartName" Cursor
    cur
           ovrContentType <- attribute "ContentType" cur
           return Override{..}

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

    contentTypesNs :: Text
    contentTypesNs :: Text
    contentTypesNs = Text
    "http://schemas.openxmlformats.org/package/2006/content-types"