-- | Copyright: (c) 2021 The closed eye of love
-- SPDX-License-Identifier: BSD-3-Clause
-- Maintainer: Poscat <poscat@mail.poscat.moe>, berberman <berberman@yandex.com>
-- Stability: alpha
-- Portability: portable
-- Miscellaneous utilities.
module Web.Pixiv.Utils
  ( isSinglePageIllust,
    extractHighestQualityImageUrl,
    extractImageUrlsFromIllust,
    unzipArchive,
    ugoiraMetadataToFFConcat,
  )
where

import qualified Codec.Archive.Zip as Zip
import Control.Applicative ((<|>))
import Control.Lens
import Control.Monad (join)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8)
import Numeric (showFFloat)
import Web.Pixiv.Types
import Web.Pixiv.Types.Lens

-----------------------------------------------------------------------------

-- | Judges if an illustration has only one image.
isSinglePageIllust :: Illust -> Bool
isSinglePageIllust :: Illust -> Bool
isSinglePageIllust Illust
i = [MetaPage] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null ([MetaPage] -> Bool) -> [MetaPage] -> Bool
forall a b. (a -> b) -> a -> b
$ Illust
i Illust -> Getting [MetaPage] Illust [MetaPage] -> [MetaPage]
forall s a. s -> Getting a s a -> a
^. Getting [MetaPage] Illust [MetaPage]
forall s a. HasMetaPages s a => Lens' s a
metaPages

-- | Extracts the url of the highest quality image.
extractHighestQualityImageUrl :: ImageUrls -> Maybe Text
extractHighestQualityImageUrl :: ImageUrls -> Maybe Text
extractHighestQualityImageUrl ImageUrls
x =
  ImageUrls
x ImageUrls
-> Getting (Maybe Text) ImageUrls (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) ImageUrls (Maybe Text)
forall s a. HasOriginal s a => Lens' s a
original
    Maybe Text -> Maybe Text -> Maybe Text
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> ImageUrls
x ImageUrls
-> Getting (Maybe Text) ImageUrls (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) ImageUrls (Maybe Text)
forall s a. HasLarge s a => Lens' s a
large
    Maybe Text -> Maybe Text -> Maybe Text
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> ImageUrls
x ImageUrls
-> Getting (Maybe Text) ImageUrls (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) ImageUrls (Maybe Text)
forall s a. HasMedium s a => Lens' s a
medium
    Maybe Text -> Maybe Text -> Maybe Text
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> ImageUrls
x ImageUrls
-> Getting (Maybe Text) ImageUrls (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) ImageUrls (Maybe Text)
forall s a. HasSquareMedium s a => Lens' s a
squareMedium

-- | Extracts all urls from an illustration, using 'extractHighestQualityImageUrl'.
extractImageUrlsFromIllust :: Illust -> [Text]
extractImageUrlsFromIllust :: Illust -> [Text]
extractImageUrlsFromIllust Illust
i
  | Illust -> Bool
isSinglePageIllust Illust
i = (Maybe Text
single Maybe Text -> Maybe Text -> Maybe Text
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> ([Text]
multi [Text] -> Getting (First Text) [Text] Text -> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting (First Text) [Text] Text
forall s a. Cons s s a a => Traversal' s a
_head)) Maybe Text -> Getting (Endo [Text]) (Maybe Text) Text -> [Text]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Getting (Endo [Text]) (Maybe Text) Text
forall s t a b. Each s t a b => Traversal s t a b
each
  | Bool
otherwise = [Text]
multi
  where
    single :: Maybe Text
single = Maybe (Maybe Text) -> Maybe Text
forall (m :: Type -> Type) a. Monad m => m (m a) -> m a
join (Maybe (Maybe Text) -> Maybe Text)
-> Maybe (Maybe Text) -> Maybe Text
forall a b. (a -> b) -> a -> b
$ (Illust
i Illust
-> Getting (Maybe OriginalImageUrl) Illust (Maybe OriginalImageUrl)
-> Maybe OriginalImageUrl
forall s a. s -> Getting a s a -> a
^. Getting (Maybe OriginalImageUrl) Illust (Maybe OriginalImageUrl)
forall s a. HasMetaSinglePage s a => Lens' s a
metaSinglePage) Maybe OriginalImageUrl
-> (Maybe OriginalImageUrl -> Maybe (Maybe Text))
-> Maybe (Maybe Text)
forall a b. a -> (a -> b) -> b
& (OriginalImageUrl -> Identity (Maybe Text))
-> Maybe OriginalImageUrl -> Identity (Maybe (Maybe Text))
forall s t a b. Each s t a b => Traversal s t a b
each ((OriginalImageUrl -> Identity (Maybe Text))
 -> Maybe OriginalImageUrl -> Identity (Maybe (Maybe Text)))
-> (OriginalImageUrl -> Maybe Text)
-> Maybe OriginalImageUrl
-> Maybe (Maybe Text)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (OriginalImageUrl
-> Getting (Maybe Text) OriginalImageUrl (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) OriginalImageUrl (Maybe Text)
forall s a. HasOriginalImageUrl s a => Lens' s a
originalImageUrl)
    multi :: [Text]
multi = (Illust
i Illust -> Getting [MetaPage] Illust [MetaPage] -> [MetaPage]
forall s a. s -> Getting a s a -> a
^. Getting [MetaPage] Illust [MetaPage]
forall s a. HasMetaPages s a => Lens' s a
metaPages [MetaPage]
-> Getting (Endo [ImageUrls]) [MetaPage] ImageUrls -> [ImageUrls]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (MetaPage -> Const (Endo [ImageUrls]) MetaPage)
-> [MetaPage] -> Const (Endo [ImageUrls]) [MetaPage]
forall s t a b. Each s t a b => Traversal s t a b
each ((MetaPage -> Const (Endo [ImageUrls]) MetaPage)
 -> [MetaPage] -> Const (Endo [ImageUrls]) [MetaPage])
-> ((ImageUrls -> Const (Endo [ImageUrls]) ImageUrls)
    -> MetaPage -> Const (Endo [ImageUrls]) MetaPage)
-> Getting (Endo [ImageUrls]) [MetaPage] ImageUrls
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ImageUrls -> Const (Endo [ImageUrls]) ImageUrls)
-> MetaPage -> Const (Endo [ImageUrls]) MetaPage
forall s a. HasImageUrls s a => Lens' s a
imageUrls [ImageUrls] -> (ImageUrls -> Maybe Text) -> [Maybe Text]
forall (f :: Type -> Type) a b. Functor f => f a -> (a -> b) -> f b
<&> ImageUrls -> Maybe Text
extractHighestQualityImageUrl) [Maybe Text] -> Getting (Endo [Text]) [Maybe Text] Text -> [Text]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (Maybe Text -> Const (Endo [Text]) (Maybe Text))
-> [Maybe Text] -> Const (Endo [Text]) [Maybe Text]
forall s t a b. Each s t a b => Traversal s t a b
each ((Maybe Text -> Const (Endo [Text]) (Maybe Text))
 -> [Maybe Text] -> Const (Endo [Text]) [Maybe Text])
-> Getting (Endo [Text]) (Maybe Text) Text
-> Getting (Endo [Text]) [Maybe Text] Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Endo [Text]) (Maybe Text) Text
forall a b. Prism (Maybe a) (Maybe b) a b
_Just

-----------------------------------------------------------------------------

-- | Unzip a zip archive represented in 'LBS.ByteString' to a directory.
unzipArchive ::
  -- | destination directory
  FilePath ->
  -- | zip archive
  LBS.ByteString ->
  IO ()
unzipArchive :: FilePath -> ByteString -> IO ()
unzipArchive FilePath
dir ByteString
bs = do
  let archive :: Archive
archive = ByteString -> Archive
Zip.toArchive ByteString
bs
      option :: [ZipOption]
option = [FilePath -> ZipOption
Zip.OptDestination FilePath
dir]
  [ZipOption] -> Archive -> IO ()
Zip.extractFilesFromArchive [ZipOption]
option Archive
archive

-- | Generates ffconcat meta file of an ugoira.
ugoiraMetadataToFFConcat :: UgoiraMetadata -> BS.ByteString
ugoiraMetadataToFFConcat :: UgoiraMetadata -> ByteString
ugoiraMetadataToFFConcat UgoiraMetadata
meta =
  Text -> ByteString
encodeUtf8 (Text -> ByteString) -> ([Text] -> Text) -> [Text] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines ([Text] -> ByteString) -> [Text] -> ByteString
forall a b. (a -> b) -> a -> b
$
    Text
"ffconcat version 1.0" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:
      [ [Text] -> Text
T.unlines
          [ Text
"file " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> UgoiraFrame
frame UgoiraFrame -> Getting Text UgoiraFrame Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text UgoiraFrame Text
forall s a. HasUgoiraFile s a => Lens' s a
ugoiraFile,
            Text
"duration "
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack
                ( UgoiraFrame
frame UgoiraFrame -> Getting Int UgoiraFrame Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int UgoiraFrame Int
forall s a. HasUgoiraDelay s a => Lens' s a
ugoiraDelay
                    Int -> (Int -> Double) -> Double
forall a b. a -> (a -> b) -> b
& Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral
                    Double -> (Double -> Double) -> Double
forall a b. a -> (a -> b) -> b
& (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1000)
                    Double -> (Double -> FilePath) -> FilePath
forall a b. a -> (a -> b) -> b
& (Double -> FilePath -> FilePath) -> FilePath -> Double -> FilePath
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Maybe Int -> Double -> FilePath -> FilePath
forall a. RealFloat a => Maybe Int -> a -> FilePath -> FilePath
showFFloat @Double Maybe Int
forall a. Maybe a
Nothing) FilePath
""
                )
          ]
        | UgoiraFrame
frame <- UgoiraMetadata
meta UgoiraMetadata
-> Getting [UgoiraFrame] UgoiraMetadata [UgoiraFrame]
-> [UgoiraFrame]
forall s a. s -> Getting a s a -> a
^. Getting [UgoiraFrame] UgoiraMetadata [UgoiraFrame]
forall s a. HasFrames s a => Lens' s a
frames
      ]