-----------------------------------------------------------------------------
--
-- Module      :  $Headers
-- Copyright   :  (c) 2021 Brian W Bush
-- License     :  MIT
--
-- Maintainer  :  Brian W Bush <code@functionally.io>
-- Stability   :  Experimental
-- Portability :  Portable
--
-- | IPFS pinning for pig images.
--
-----------------------------------------------------------------------------


module Pigy.Ipfs (
-- * IPFS
  pinImage
) where


import Control.Monad.IO.Class    (MonadIO)
import Development.Shake.Command (Exit(..), Stderr(..), Stdout(..), cmd)
import Mantis.Types              (MantisM, foistMantisEitherIO)
import Pigy.Image                (Genotype, toChromosome, writeImage)
import Pigy.Image.Types          (Chromosome, Phenable(..))
import System.FilePath.Posix     ((</>), (<.>))
import System.Exit               (ExitCode(..))


-- | Pin an image to IPFS.
pinImage :: MonadFail m
         => MonadIO m
         => FilePath                       -- ^ The IPFS shell script.
         -> FilePath                       -- ^ The folder for images.
         -> Genotype                       -- ^ The genotype of the image.
         -> MantisM m (Chromosome, String) -- ^ Action for pinning the image and returning its chromosome and IPFS CID.
pinImage :: FilePath -> FilePath -> Genotype -> MantisM m (FilePath, FilePath)
pinImage FilePath
script FilePath
folder Genotype
genotype =
  IO (Either FilePath (FilePath, FilePath))
-> MantisM m (FilePath, FilePath)
forall (m :: * -> *) e a.
(MonadIO m, Show e) =>
IO (Either e a) -> MantisM m a
foistMantisEitherIO
    (IO (Either FilePath (FilePath, FilePath))
 -> MantisM m (FilePath, FilePath))
-> IO (Either FilePath (FilePath, FilePath))
-> MantisM m (FilePath, FilePath)
forall a b. (a -> b) -> a -> b
$ do
      let
        chromosome :: FilePath
chromosome = Genotype -> FilePath
toChromosome Genotype
genotype
        filename :: FilePath
filename = FilePath
folder FilePath -> FilePath -> FilePath
</> FilePath
"PIG@" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
chromosome FilePath -> FilePath -> FilePath
<.> FilePath
"png"
      FilePath -> Phenotype -> IO ()
forall (m :: * -> *). MonadIO m => FilePath -> Phenotype -> m ()
writeImage FilePath
filename (Phenotype -> IO ()) -> Phenotype -> IO ()
forall a b. (a -> b) -> a -> b
$ Genotype -> Phenotype
forall g. Phenable g => g -> Phenotype
toPhenotype Genotype
genotype
      (Exit ExitCode
code, Stdout FilePath
result, Stderr FilePath
msg) <-
        (FilePath
 -> [FilePath] -> IO (Exit, Stdout FilePath, Stderr FilePath))
:-> Action Any
forall args r. (Partial, CmdArguments args) => args
cmd
          FilePath
script
          [FilePath
"PIG@" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
chromosome, FilePath
filename]
      let
        FilePath
cid : [FilePath]
message = FilePath -> [FilePath]
lines FilePath
result
      case ExitCode
code of
        ExitFailure Int
_ -> Either FilePath (FilePath, FilePath)
-> IO (Either FilePath (FilePath, FilePath))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath (FilePath, FilePath)
 -> IO (Either FilePath (FilePath, FilePath)))
-> Either FilePath (FilePath, FilePath)
-> IO (Either FilePath (FilePath, FilePath))
forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath (FilePath, FilePath)
forall a b. a -> Either a b
Left (FilePath
msg :: String)
        ExitCode
ExitSuccess   -> do
                           [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
                             [
                               FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"  " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
line
                             |
                               FilePath
line <- [FilePath]
message
                             ]
                           Either FilePath (FilePath, FilePath)
-> IO (Either FilePath (FilePath, FilePath))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath (FilePath, FilePath)
 -> IO (Either FilePath (FilePath, FilePath)))
-> Either FilePath (FilePath, FilePath)
-> IO (Either FilePath (FilePath, FilePath))
forall a b. (a -> b) -> a -> b
$ (FilePath, FilePath) -> Either FilePath (FilePath, FilePath)
forall a b. b -> Either a b
Right (FilePath
chromosome, FilePath
cid)