-- |Compilers for compiling and compressing typescript resources.
-- There are various helper compilers for common compilation cases.
-- In particular, 'compressJtsCompiler' will compile both typescript
-- and javascript files, then compress them.
--
-- There are other variations that may be useful as well. 'compressTsCompiler'
-- is similar to 'compressJtsCompiler', but is more strict and will not accept
-- arbitrary javascript. 'compressTsCompilerWith' is the most general combinator,
-- using this you can pass arbitrary arguments to the typescript compiler prior
-- to compilation. These results are then minified as well.
--
-- Finally, if you just want to compile typescript without minification, perhaps
-- for readability, use any of the functions that are not prefixed with "compress".
-- Again, here 'tsCompilerWith' is the most general, allowing additional compiler
-- arguments to be passed prior to compilation. 'jtsCompiler' is provided for
-- convenience to support flexibly compiling javascript and typescript without
-- compression.
module Hakyll.Typescript.TS
  (
    compressJtsCompiler,
    compressJtsCompilerWith,
    compressTsCompiler,
    compressTsCompilerWith,
    jtsCompiler,
    jtsCompilerWith,
    tsCompiler,
    tsCompilerWith,
    TSArgs
  )
  where

import           Data.ByteString.Lazy.Char8 (ByteString)
import           Hakyll.Core.Item
import           Hakyll.Core.Compiler
import           Hakyll.Process             (execName, execCompilerWith, ExecutableArg(..), CompilerOut(CStdOut))

import           Hakyll.Typescript.Internal

-- |Arguments to pass to the typescript compiler.
type TSArgs = [String]

-- |Compiles the typescript or javascript 'Hakyll.Core.Item.Item' to javascript.
compressJtsCompiler :: Compiler (Item ByteString)
compressJtsCompiler :: Compiler (Item ByteString)
compressJtsCompiler = TSArgs -> Compiler (Item ByteString)
compressJtsCompilerWith TSArgs
forall a. Monoid a => a
mempty

-- |Compiles the typescript 'Hakyll.Core.Item.Item' to javascript, then
-- minifies the result.
compressTsCompiler :: Compiler (Item ByteString)
compressTsCompiler :: Compiler (Item ByteString)
compressTsCompiler = TSArgs -> Compiler (Item ByteString)
compressTsCompilerWith TSArgs
forall a. Monoid a => a
mempty

-- |Compiles the typescript or javascript 'Hakyll.Core.Item.Item' to javascript,
-- then minifies the result
compressJtsCompilerWith :: TSArgs -> Compiler (Item ByteString)
compressJtsCompilerWith :: TSArgs -> Compiler (Item ByteString)
compressJtsCompilerWith TSArgs
args = Compiler (Item ByteString) -> Compiler (Item ByteString)
withMinifyJs (Compiler (Item ByteString) -> Compiler (Item ByteString))
-> Compiler (Item ByteString) -> Compiler (Item ByteString)
forall a b. (a -> b) -> a -> b
$ TSArgs -> Compiler (Item ByteString)
jtsCompilerWith TSArgs
args

-- |Compiles the typescript 'Hakyll.Core.Item.Item' to javascript, then
-- minifies the result. Passes all typescript arguments to the typescript
-- compiler for compilation.
compressTsCompilerWith :: TSArgs -> Compiler (Item ByteString)
compressTsCompilerWith :: TSArgs -> Compiler (Item ByteString)
compressTsCompilerWith TSArgs
args = Compiler (Item ByteString) -> Compiler (Item ByteString)
withMinifyJs (Compiler (Item ByteString) -> Compiler (Item ByteString))
-> Compiler (Item ByteString) -> Compiler (Item ByteString)
forall a b. (a -> b) -> a -> b
$ TSArgs -> Compiler (Item ByteString)
tsCompilerWith TSArgs
args

-- |Compiles the typescript or javascript 'Hakyll.Core.Item.Item' to javascript.
jtsCompiler :: Compiler (Item ByteString)
jtsCompiler :: Compiler (Item ByteString)
jtsCompiler = TSArgs -> Compiler (Item ByteString)
jtsCompilerWith TSArgs
forall a. Monoid a => a
mempty

-- |Compiles the typescript 'Hakyll.Core.Item.Item' to javascript.
tsCompiler :: Compiler (Item ByteString)
tsCompiler :: Compiler (Item ByteString)
tsCompiler = TSArgs -> Compiler (Item ByteString)
tsCompilerWith TSArgs
forall a. Monoid a => a
mempty

-- |Compiles the typescript or javascript 'Hakyll.Core.Item.Item' to javascript.
-- Passes the provided 'TSArgs' to the typescript compiler.
jtsCompilerWith :: TSArgs -> Compiler (Item ByteString)
jtsCompilerWith :: TSArgs -> Compiler (Item ByteString)
jtsCompilerWith TSArgs
args = TSArgs -> Compiler (Item ByteString)
tsCompilerWith (TSArgs -> Compiler (Item ByteString))
-> TSArgs -> Compiler (Item ByteString)
forall a b. (a -> b) -> a -> b
$ [[Char]
"--allowJs", [Char]
"true"] TSArgs -> TSArgs -> TSArgs
forall a. Semigroup a => a -> a -> a
<> TSArgs
args

-- |Compiles the typescript 'Hakyll.Core.Item.Item' to javascript.
-- Passes the provided 'TSArgs' to the typescript compiler.
tsCompilerWith :: TSArgs -> Compiler (Item ByteString)
tsCompilerWith :: TSArgs -> Compiler (Item ByteString)
tsCompilerWith TSArgs
args = ExecutableName
-> ExecutableArgs -> CompilerOut -> Compiler (Item ByteString)
execCompilerWith ([Char] -> ExecutableName
execName [Char]
"tsc") ExecutableArgs
allArgs CompilerOut
CStdOut
  where
  -- this won't work on Windows, but that's probably fine
  defaultArgs :: ExecutableArgs
defaultArgs = [[Char] -> ExecutableArg
ProcArg [Char]
"--outFile", [Char] -> ExecutableArg
ProcArg [Char]
"/dev/stdout"]
  allArgs :: ExecutableArgs
allArgs     = ExecutableArgs
defaultArgs ExecutableArgs -> ExecutableArgs -> ExecutableArgs
forall a. Semigroup a => a -> a -> a
<> ([Char] -> ExecutableArg) -> TSArgs -> ExecutableArgs
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Char] -> ExecutableArg
ProcArg TSArgs
args ExecutableArgs -> ExecutableArgs -> ExecutableArgs
forall a. Semigroup a => a -> a -> a
<> [ExecutableArg
HakFilePath]