{-# LANGUAGE OverloadedStrings
           , StandaloneDeriving
           , FlexibleInstances
           , MultiParamTypeClasses
           , FunctionalDependencies #-}

module System.Posix.ARX.Programs where

import Control.Applicative
import Control.Monad
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as Bytes
import qualified Data.ByteString.Lazy as LazyB
import Data.Monoid
import Data.Word

import qualified Blaze.ByteString.Builder as Blaze

import System.Posix.ARX.HEREDat
import qualified System.Posix.ARX.Sh as Sh
import qualified System.Posix.ARX.TMPXTools as TMPXTools
import System.Posix.ARX.Tar


{-| ARX subprograms process some input to produce a script.
 -}
class ARX program input | program -> input where
  interpret                 ::  program -> input -> Blaze.Builder


{-| An 'SHDAT' program processes byte streams with the specified chunking to
    produce a script.
 -}
newtype SHDAT                =  SHDAT Word  -- Chunk size.
instance ARX SHDAT LazyB.ByteString where
  interpret :: SHDAT -> ByteString -> Builder
interpret (SHDAT Word
w)        =  Builder -> Builder
forall {a}. (Monoid a, IsString a) => a -> a
localeC (Builder -> Builder)
-> (ByteString -> Builder) -> ByteString -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder)
-> (ByteString -> [Builder]) -> ByteString -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Builder]
chunked
   where
    localeC :: a -> a
localeC a
b                =  a
"( export LC_ALL=C\n" a -> a -> a
forall a. Monoid a => a -> a -> a
`mappend` a
b a -> a -> a
forall a. Monoid a => a -> a -> a
`mappend` a
")"
    chunkSize :: Int64
chunkSize                =  Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
min (Word -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
w) Int64
forall a. Bounded a => a
maxBound
    chunked :: ByteString -> [Builder]
chunked ByteString
input            =  case Int64 -> ByteString -> (ByteString, ByteString)
LazyB.splitAt Int64
chunkSize ByteString
input of
      (ByteString
"", ByteString
"")              ->  []
      (ByteString
a , ByteString
"")              ->  [ByteString -> Builder
chunkIt ByteString
a]
      (ByteString
a ,  ByteString
b)              ->  ByteString -> Builder
chunkIt ByteString
a Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: ByteString -> [Builder]
chunked ByteString
b
     where
      chunkIt :: ByteString -> Builder
chunkIt                =  Chunk -> Builder
script (Chunk -> Builder)
-> (ByteString -> Chunk) -> ByteString -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Chunk
chunk (ByteString -> Chunk)
-> (ByteString -> ByteString) -> ByteString -> Chunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
LazyB.toChunks


{-| A 'TMPX' program archives streams to produce a script that unpacks the
    file data in a temporary location and runs the command with the attached
    environment information in that location. The command may be any
    executable file contents, modulo architectural compatibility. It is
    written along side the temporary work location, to ensure it does not
    collide with any files in the archive. The two boolean flags determine
    when to delete the temporary directory. The first flag determines whether
    or not to delete successful (exit code zero) runs; the second determines
    whether or not to delete failed (exit code non-zero) runs.
 -}
data TMPX = TMPX SHDAT LazyB.ByteString -- Code of task to run.
                       [(Sh.Var, Sh.Val)] -- Environment mapping.
                       ByteString -- Place to put tmp dir.
                       Bool -- Destroy tmp if task runs successfully.
                       Bool -- Destroy tmp if task exits with an error code.
                       Bool -- Reuse tmp dir if available.
instance ARX TMPX [(Tar, LazyB.ByteString)] where
  interpret :: TMPX -> [(Tar, ByteString)] -> Builder
interpret (TMPX SHDAT
encoder ByteString
run [(Var, Val)]
env ByteString
tmpdir Bool
rm0 Bool
rm1 Bool
rm2) [(Tar, ByteString)]
stuff = Template -> Builder
TMPXTools.render
    (Bool
-> Bool
-> Bool
-> ByteString
-> Builder
-> Builder
-> Builder
-> Template
TMPXTools.Template Bool
rm0 Bool
rm1 Bool
rm2 ByteString
tmpdir Builder
env' Builder
run' Builder
archives)
   where
    archives :: Builder
archives                 =  [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ((Tar -> ByteString -> Builder) -> (Tar, ByteString) -> Builder
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Tar -> ByteString -> Builder
archive ((Tar, ByteString) -> Builder) -> [(Tar, ByteString)] -> [Builder]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Tar, ByteString)]
stuff)
    archive :: Tar -> ByteString -> Builder
archive Tar
tar ByteString
bytes        =  [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
      [ByteString -> Builder
shdat ByteString
bytes, Builder
" | tar ", Tar -> Builder
forall {a}. IsString a => Tar -> a
flags Tar
tar, Builder
"\n"]
    flags :: Tar -> a
flags Tar
TAR                =  a
"-x"
    flags Tar
TGZ                =  a
"-x -z"
    flags Tar
TBZ                =  a
"-x -j"
    flags Tar
TXZ                =  a
"-x -J"
    run' :: Builder
run' = case ByteString
run of ByteString
""   ->  Builder
""
                       ByteString
_    ->  ByteString -> Builder
shdat ByteString
run
    env' :: Builder
env' = case [(Var, Val)]
env of (Var, Val)
_:[(Var, Val)]
_  ->  (ByteString -> Builder
shdat (ByteString -> Builder)
-> ([(Var, Val)] -> ByteString) -> [(Var, Val)] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
unblz (Builder -> ByteString)
-> ([(Var, Val)] -> Builder) -> [(Var, Val)] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Var, Val)] -> Builder
forall t. Render t => t -> Builder
Sh.render) [(Var, Val)]
env
                       [ ]  ->  Builder
""
    shdat :: ByteString -> Builder
shdat                    =  SHDAT -> ByteString -> Builder
forall program input.
ARX program input =>
program -> input -> Builder
interpret SHDAT
encoder
    unblz :: Builder -> ByteString
unblz                    =  Builder -> ByteString
Blaze.toLazyByteString