{-# LANGUAGE OverloadedStrings #-}
module Clod.FileSystem.Processing
(
processFiles
, ManifestEntry(..)
, createOptimizedName
, writeManifestFile
) where
import qualified Data.List as L
import Data.List (nubBy)
import System.Directory (doesFileExist)
import System.FilePath (takeDirectory, takeFileName, (</>))
import qualified System.IO
import System.IO (stderr, hPutStrLn)
import Control.Monad (when)
import Control.Monad.Except (throwError)
import qualified System.Directory as D (copyFile)
import Clod.Types (OptimizedName(..), OriginalPath(..), ClodM, ClodConfig(..),
liftIO, FileWriteCap(..), fileWriteCap, isPathAllowed, ClodError(..))
import Clod.IgnorePatterns (matchesIgnorePattern)
import Clod.FileSystem.Detection (isTextFile)
import Clod.FileSystem.Transformations (transformFilename)
data ManifestEntry = ManifestEntry
{ ManifestEntry -> OptimizedName
entryOptimizedName :: OptimizedName
, ManifestEntry -> OriginalPath
entryOriginalPath :: OriginalPath
} deriving (Int -> ManifestEntry -> ShowS
[ManifestEntry] -> ShowS
ManifestEntry -> [Char]
(Int -> ManifestEntry -> ShowS)
-> (ManifestEntry -> [Char])
-> ([ManifestEntry] -> ShowS)
-> Show ManifestEntry
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ManifestEntry -> ShowS
showsPrec :: Int -> ManifestEntry -> ShowS
$cshow :: ManifestEntry -> [Char]
show :: ManifestEntry -> [Char]
$cshowList :: [ManifestEntry] -> ShowS
showList :: [ManifestEntry] -> ShowS
Show, ManifestEntry -> ManifestEntry -> Bool
(ManifestEntry -> ManifestEntry -> Bool)
-> (ManifestEntry -> ManifestEntry -> Bool) -> Eq ManifestEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ManifestEntry -> ManifestEntry -> Bool
== :: ManifestEntry -> ManifestEntry -> Bool
$c/= :: ManifestEntry -> ManifestEntry -> Bool
/= :: ManifestEntry -> ManifestEntry -> Bool
Eq)
readManifestEntries :: FilePath -> ClodM [ManifestEntry]
readManifestEntries :: [Char] -> ClodM [ManifestEntry]
readManifestEntries [Char]
manifestPath = do
Bool
exists <- IO Bool -> ReaderT ClodConfig (ExceptT ClodError IO) Bool
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> ReaderT ClodConfig (ExceptT ClodError IO) Bool)
-> IO Bool -> ReaderT ClodConfig (ExceptT ClodError IO) Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> IO Bool
doesFileExist [Char]
manifestPath
if Bool -> Bool
not Bool
exists
then [ManifestEntry] -> ClodM [ManifestEntry]
forall a. a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
else do
[Char]
content <- IO [Char] -> ReaderT ClodConfig (ExceptT ClodError IO) [Char]
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Char] -> ReaderT ClodConfig (ExceptT ClodError IO) [Char])
-> IO [Char] -> ReaderT ClodConfig (ExceptT ClodError IO) [Char]
forall a b. (a -> b) -> a -> b
$ do
[Char]
fileContent <- [Char] -> IO [Char]
readFile [Char]
manifestPath
[Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
fileContent Int -> IO [Char] -> IO [Char]
forall a b. a -> b -> b
`seq` [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
fileContent
let stripQuotes :: ShowS
stripQuotes [Char]
s = case [Char]
s of
Char
'"':[Char]
rest -> case ShowS
forall a. [a] -> [a]
reverse [Char]
rest of
Char
'"':[Char]
revRest -> ShowS
forall a. [a] -> [a]
reverse [Char]
revRest
[Char]
_ -> [Char]
s
[Char]
_ -> [Char]
s
stripBackticks :: ShowS
stripBackticks [Char]
s = case [Char]
s of
Char
'`':[Char]
rest -> case ShowS
forall a. [a] -> [a]
reverse [Char]
rest of
Char
'`':[Char]
revRest -> ShowS
forall a. [a] -> [a]
reverse [Char]
revRest
[Char]
_ -> [Char]
s
[Char]
_ -> [Char]
s
parseEntry :: [Char] -> Maybe ManifestEntry
parseEntry [Char]
line = do
let parts :: ([Char], [Char])
parts = (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'=') [Char]
line
case ([Char], [Char])
parts of
([Char]
keyPart, Char
'=':[Char]
valuePart) -> do
let key :: [Char]
key = ShowS
strip (ShowS
stripBackticks (ShowS
strip [Char]
keyPart))
value :: [Char]
value = ShowS
strip (ShowS
stripQuotes (ShowS
strip [Char]
valuePart))
if [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
key Bool -> Bool -> Bool
|| [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
value
then Maybe ManifestEntry
forall a. Maybe a
Nothing
else ManifestEntry -> Maybe ManifestEntry
forall a. a -> Maybe a
Just (ManifestEntry -> Maybe ManifestEntry)
-> ManifestEntry -> Maybe ManifestEntry
forall a b. (a -> b) -> a -> b
$ OptimizedName -> OriginalPath -> ManifestEntry
ManifestEntry
([Char] -> OptimizedName
OptimizedName [Char]
key)
([Char] -> OriginalPath
OriginalPath [Char]
value)
([Char], [Char])
_ -> Maybe ManifestEntry
forall a. Maybe a
Nothing
let possibleEntries :: [[Char]]
possibleEntries = ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter (\[Char]
l -> [Char]
"=" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isInfixOf` [Char]
l) ([Char] -> [[Char]]
lines [Char]
content)
entries :: [ManifestEntry]
entries = ([Char] -> Maybe ManifestEntry) -> [[Char]] -> [ManifestEntry]
forall {a} {b}. (a -> Maybe b) -> [a] -> [b]
mapMaybe [Char] -> Maybe ManifestEntry
parseEntry [[Char]]
possibleEntries
[ManifestEntry] -> ClodM [ManifestEntry]
forall a. a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return [ManifestEntry]
entries
where
mapMaybe :: (a -> Maybe b) -> [a] -> [b]
mapMaybe a -> Maybe b
f = (Maybe b -> b) -> [Maybe b] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map Maybe b -> b
forall {a}. Maybe a -> a
fromJust ([Maybe b] -> [b]) -> ([a] -> [Maybe b]) -> [a] -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe b -> Bool) -> [Maybe b] -> [Maybe b]
forall a. (a -> Bool) -> [a] -> [a]
filter Maybe b -> Bool
forall {a}. Maybe a -> Bool
isJust ([Maybe b] -> [Maybe b]) -> ([a] -> [Maybe b]) -> [a] -> [Maybe b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Maybe b) -> [a] -> [Maybe b]
forall a b. (a -> b) -> [a] -> [b]
map a -> Maybe b
f
isJust :: Maybe a -> Bool
isJust (Just a
_) = Bool
True
isJust Maybe a
Nothing = Bool
False
fromJust :: Maybe a -> a
fromJust (Just a
x) = a
x
fromJust Maybe a
Nothing = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"Impossible: fromJust Nothing"
strip :: String -> String
strip :: ShowS
strip = ShowS
forall a. [a] -> [a]
reverse ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. [a] -> [a]
reverse ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace
isSpace :: Char -> Bool
isSpace :: Char -> Bool
isSpace Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\r'
processFiles :: ClodConfig
-> FilePath
-> [FilePath]
-> Bool
-> ClodM (Int, Int)
processFiles :: ClodConfig -> [Char] -> [[Char]] -> Bool -> ClodM (Int, Int)
processFiles ClodConfig
config [Char]
manifestPath [[Char]]
files Bool
includeInManifestOnly = do
[(Maybe [ManifestEntry], Int)]
fileResults <- ([Char]
-> ReaderT
ClodConfig (ExceptT ClodError IO) (Maybe [ManifestEntry], Int))
-> [[Char]]
-> ReaderT
ClodConfig (ExceptT ClodError IO) [(Maybe [ManifestEntry], Int)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Char]
-> ReaderT
ClodConfig (ExceptT ClodError IO) (Maybe [ManifestEntry], Int)
processOneFile [[Char]]
files
let newEntries :: [ManifestEntry]
newEntries = ((Maybe [ManifestEntry], Int) -> [ManifestEntry])
-> [(Maybe [ManifestEntry], Int)] -> [ManifestEntry]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([ManifestEntry]
-> ([ManifestEntry] -> [ManifestEntry])
-> Maybe [ManifestEntry]
-> [ManifestEntry]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] [ManifestEntry] -> [ManifestEntry]
forall a. a -> a
id (Maybe [ManifestEntry] -> [ManifestEntry])
-> ((Maybe [ManifestEntry], Int) -> Maybe [ManifestEntry])
-> (Maybe [ManifestEntry], Int)
-> [ManifestEntry]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe [ManifestEntry], Int) -> Maybe [ManifestEntry]
forall a b. (a, b) -> a
fst) [(Maybe [ManifestEntry], Int)]
fileResults
processed :: Int
processed = [ManifestEntry] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ManifestEntry]
newEntries
skipped :: Int
skipped = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ((Maybe [ManifestEntry], Int) -> Int)
-> [(Maybe [ManifestEntry], Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe [ManifestEntry], Int) -> Int
forall a b. (a, b) -> b
snd [(Maybe [ManifestEntry], Int)]
fileResults
[ManifestEntry]
existingEntries <- [Char] -> ClodM [ManifestEntry]
readManifestEntries [Char]
manifestPath
let allEntries :: [ManifestEntry]
allEntries = [ManifestEntry]
existingEntries [ManifestEntry] -> [ManifestEntry] -> [ManifestEntry]
forall a. [a] -> [a] -> [a]
++ [ManifestEntry]
newEntries
uniqueEntries :: [ManifestEntry]
uniqueEntries = (ManifestEntry -> ManifestEntry -> Bool)
-> [ManifestEntry] -> [ManifestEntry]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy (\ManifestEntry
a ManifestEntry
b -> ManifestEntry -> OriginalPath
entryOriginalPath ManifestEntry
a OriginalPath -> OriginalPath -> Bool
forall a. Eq a => a -> a -> Bool
== ManifestEntry -> OriginalPath
entryOriginalPath ManifestEntry
b) [ManifestEntry]
allEntries
let writeCap :: FileWriteCap
writeCap = [[Char]] -> FileWriteCap
fileWriteCap [ShowS
takeDirectory [Char]
manifestPath]
let manifestPairs :: [(OptimizedName, OriginalPath)]
manifestPairs = (ManifestEntry -> (OptimizedName, OriginalPath))
-> [ManifestEntry] -> [(OptimizedName, OriginalPath)]
forall a b. (a -> b) -> [a] -> [b]
map (\ManifestEntry
e -> (ManifestEntry -> OptimizedName
entryOptimizedName ManifestEntry
e, ManifestEntry -> OriginalPath
entryOriginalPath ManifestEntry
e)) [ManifestEntry]
uniqueEntries
FileWriteCap
-> [Char] -> [(OptimizedName, OriginalPath)] -> ClodM ()
writeManifestFile FileWriteCap
writeCap [Char]
manifestPath [(OptimizedName, OriginalPath)]
manifestPairs
(Int, Int) -> ClodM (Int, Int)
forall a. a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
processed, Int
skipped)
where
processOneFile :: FilePath -> ClodM (Maybe [ManifestEntry], Int)
processOneFile :: [Char]
-> ReaderT
ClodConfig (ExceptT ClodError IO) (Maybe [ManifestEntry], Int)
processOneFile [Char]
file = do
let fullPath :: [Char]
fullPath = ClodConfig -> [Char]
projectPath ClodConfig
config [Char] -> ShowS
</> [Char]
file
Bool
isFile <- IO Bool -> ReaderT ClodConfig (ExceptT ClodError IO) Bool
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> ReaderT ClodConfig (ExceptT ClodError IO) Bool)
-> IO Bool -> ReaderT ClodConfig (ExceptT ClodError IO) Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> IO Bool
doesFileExist [Char]
fullPath
if Bool -> Bool
not Bool
isFile
then (Maybe [ManifestEntry], Int)
-> ReaderT
ClodConfig (ExceptT ClodError IO) (Maybe [ManifestEntry], Int)
forall a. a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [ManifestEntry]
forall a. Maybe a
Nothing, Int
0)
else do
if ClodConfig -> [Char]
stagingDir ClodConfig
config [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isInfixOf` [Char]
fullPath
then do
Bool -> ClodM () -> ClodM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ClodConfig -> Bool
verbose ClodConfig
config) (ClodM () -> ClodM ()) -> ClodM () -> ClodM ()
forall a b. (a -> b) -> a -> b
$ do
IO () -> ClodM ()
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ClodM ()) -> IO () -> ClodM ()
forall a b. (a -> b) -> a -> b
$ Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Skipping: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
fullPath [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" (in staging directory)"
(Maybe [ManifestEntry], Int)
-> ReaderT
ClodConfig (ExceptT ClodError IO) (Maybe [ManifestEntry], Int)
forall a. a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [ManifestEntry]
forall a. Maybe a
Nothing, Int
0)
else do
if Bool
includeInManifestOnly
then ClodConfig
-> [Char]
-> [Char]
-> ReaderT
ClodConfig (ExceptT ClodError IO) (Maybe [ManifestEntry], Int)
processForManifestOnly ClodConfig
config [Char]
fullPath [Char]
file
else ClodConfig
-> [Char]
-> [Char]
-> ReaderT
ClodConfig (ExceptT ClodError IO) (Maybe [ManifestEntry], Int)
processWithCopy ClodConfig
config [Char]
fullPath [Char]
file
processForManifestOnly :: ClodConfig -> FilePath -> FilePath -> ClodM (Maybe [ManifestEntry], Int)
processForManifestOnly :: ClodConfig
-> [Char]
-> [Char]
-> ReaderT
ClodConfig (ExceptT ClodError IO) (Maybe [ManifestEntry], Int)
processForManifestOnly ClodConfig
cfg [Char]
fullPath [Char]
relPath = do
let patterns :: [IgnorePattern]
patterns = ClodConfig -> [IgnorePattern]
ignorePatterns ClodConfig
cfg
if Bool -> Bool
not ([IgnorePattern] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [IgnorePattern]
patterns) Bool -> Bool -> Bool
&& [IgnorePattern] -> [Char] -> Bool
matchesIgnorePattern [IgnorePattern]
patterns [Char]
relPath
then (Maybe [ManifestEntry], Int)
-> ReaderT
ClodConfig (ExceptT ClodError IO) (Maybe [ManifestEntry], Int)
forall a. a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [ManifestEntry]
forall a. Maybe a
Nothing, Int
1)
else do
Bool
isText <- [Char] -> ReaderT ClodConfig (ExceptT ClodError IO) Bool
isTextFile [Char]
fullPath
if Bool -> Bool
not Bool
isText
then (Maybe [ManifestEntry], Int)
-> ReaderT
ClodConfig (ExceptT ClodError IO) (Maybe [ManifestEntry], Int)
forall a. a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [ManifestEntry]
forall a. Maybe a
Nothing, Int
1)
else do
let optimizedName :: OptimizedName
optimizedName = [Char] -> OptimizedName
createOptimizedName [Char]
relPath
originalPath :: OriginalPath
originalPath = [Char] -> OriginalPath
OriginalPath [Char]
relPath
entry :: ManifestEntry
entry = OptimizedName -> OriginalPath -> ManifestEntry
ManifestEntry OptimizedName
optimizedName OriginalPath
originalPath
(Maybe [ManifestEntry], Int)
-> ReaderT
ClodConfig (ExceptT ClodError IO) (Maybe [ManifestEntry], Int)
forall a. a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ManifestEntry] -> Maybe [ManifestEntry]
forall a. a -> Maybe a
Just [ManifestEntry
entry], Int
0)
processWithCopy :: ClodConfig -> FilePath -> FilePath -> ClodM (Maybe [ManifestEntry], Int)
processWithCopy :: ClodConfig
-> [Char]
-> [Char]
-> ReaderT
ClodConfig (ExceptT ClodError IO) (Maybe [ManifestEntry], Int)
processWithCopy ClodConfig
cfg [Char]
fullPath [Char]
relPath
| [Char]
relPath [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]
".gitignore", [Char]
"package-lock.json", [Char]
"yarn.lock", [Char]
".clodignore"] =
(Maybe [ManifestEntry], Int)
-> ReaderT
ClodConfig (ExceptT ClodError IO) (Maybe [ManifestEntry], Int)
forall a. a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [ManifestEntry]
forall a. Maybe a
Nothing, Int
1)
| [Char]
"node_modules" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isInfixOf` [Char]
relPath Bool -> Bool -> Bool
|| [Char]
".git/" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isPrefixOf` [Char]
relPath Bool -> Bool -> Bool
|| [Char]
".git" [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
relPath =
(Maybe [ManifestEntry], Int)
-> ReaderT
ClodConfig (ExceptT ClodError IO) (Maybe [ManifestEntry], Int)
forall a. a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [ManifestEntry]
forall a. Maybe a
Nothing, Int
1)
| Bool
otherwise = do
let patterns :: [IgnorePattern]
patterns = ClodConfig -> [IgnorePattern]
ignorePatterns ClodConfig
cfg
if Bool -> Bool
not ([IgnorePattern] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [IgnorePattern]
patterns) Bool -> Bool -> Bool
&& [IgnorePattern] -> [Char] -> Bool
matchesIgnorePattern [IgnorePattern]
patterns [Char]
relPath
then (Maybe [ManifestEntry], Int)
-> ReaderT
ClodConfig (ExceptT ClodError IO) (Maybe [ManifestEntry], Int)
forall a. a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [ManifestEntry]
forall a. Maybe a
Nothing, Int
1)
else do
Bool
isText <- [Char] -> ReaderT ClodConfig (ExceptT ClodError IO) Bool
isTextFile [Char]
fullPath
if Bool -> Bool
not Bool
isText
then (Maybe [ManifestEntry], Int)
-> ReaderT
ClodConfig (ExceptT ClodError IO) (Maybe [ManifestEntry], Int)
forall a. a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [ManifestEntry]
forall a. Maybe a
Nothing, Int
1)
else do
let optimizedName :: OptimizedName
optimizedName = [Char] -> OptimizedName
createOptimizedName [Char]
relPath
originalPath :: OriginalPath
originalPath = [Char] -> OriginalPath
OriginalPath [Char]
relPath
entry :: ManifestEntry
entry = OptimizedName -> OriginalPath -> ManifestEntry
ManifestEntry OptimizedName
optimizedName OriginalPath
originalPath
getOptimizedName :: OptimizedName -> [Char]
getOptimizedName (OptimizedName [Char]
name) = [Char]
name
IO () -> ClodM ()
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ClodM ()) -> IO () -> ClodM ()
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> IO ()
D.copyFile [Char]
fullPath (ClodConfig -> [Char]
currentStaging ClodConfig
cfg [Char] -> ShowS
</> OptimizedName -> [Char]
getOptimizedName OptimizedName
optimizedName)
Bool -> ClodM () -> ClodM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ClodConfig -> Bool
verbose ClodConfig
cfg) (ClodM () -> ClodM ()) -> ClodM () -> ClodM ()
forall a b. (a -> b) -> a -> b
$ do
IO () -> ClodM ()
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ClodM ()) -> IO () -> ClodM ()
forall a b. (a -> b) -> a -> b
$ Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Copied: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
relPath [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" → " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ OptimizedName -> [Char]
getOptimizedName OptimizedName
optimizedName
(Maybe [ManifestEntry], Int)
-> ReaderT
ClodConfig (ExceptT ClodError IO) (Maybe [ManifestEntry], Int)
forall a. a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ManifestEntry] -> Maybe [ManifestEntry]
forall a. a -> Maybe a
Just [ManifestEntry
entry], Int
0)
writeManifestFile :: FileWriteCap
-> FilePath
-> [(OptimizedName, OriginalPath)]
-> ClodM ()
writeManifestFile :: FileWriteCap
-> [Char] -> [(OptimizedName, OriginalPath)] -> ClodM ()
writeManifestFile FileWriteCap
writeCap [Char]
manifestPath [(OptimizedName, OriginalPath)]
entries = do
let manifestLines :: [[Char]]
manifestLines = [Char]
"{\n" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]]
entryLines [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
"\n}"]
entryLines :: [[Char]]
entryLines = (Int -> (OptimizedName, OriginalPath) -> [Char])
-> [Int] -> [(OptimizedName, OriginalPath)] -> [[Char]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> (OptimizedName, OriginalPath) -> [Char]
formatEntry [Int
0..] [(OptimizedName, OriginalPath)]
entries
formatEntry :: Int -> (OptimizedName, OriginalPath) -> [Char]
formatEntry Int
idx (OptimizedName
optimizedName, OriginalPath
originalPath) =
let comma :: [Char]
comma = if Int
idx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [(OptimizedName, OriginalPath)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(OptimizedName, OriginalPath)]
entries Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 then [Char]
"" else [Char]
","
dhallOptimizedName :: [Char]
dhallOptimizedName = if [Char] -> Bool
needsBackticks (OptimizedName -> [Char]
unOptimizedName OptimizedName
optimizedName)
then [Char]
"`" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ OptimizedName -> [Char]
unOptimizedName OptimizedName
optimizedName [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"`"
else OptimizedName -> [Char]
unOptimizedName OptimizedName
optimizedName
dhallOriginalPath :: [Char]
dhallOriginalPath = [Char]
"\"" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
escapeString (OriginalPath -> [Char]
unOriginalPath OriginalPath
originalPath) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"\""
in [Char]
" " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
dhallOptimizedName [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" = " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
dhallOriginalPath [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
comma
Bool
allowed <- IO Bool -> ReaderT ClodConfig (ExceptT ClodError IO) Bool
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> ReaderT ClodConfig (ExceptT ClodError IO) Bool)
-> IO Bool -> ReaderT ClodConfig (ExceptT ClodError IO) Bool
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char] -> IO Bool
isPathAllowed (FileWriteCap -> [[Char]]
allowedWriteDirs FileWriteCap
writeCap) [Char]
manifestPath
if Bool -> Bool
not Bool
allowed
then ClodError -> ClodM ()
forall a. ClodError -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ClodError -> ClodM ()) -> ClodError -> ClodM ()
forall a b. (a -> b) -> a -> b
$ [Char] -> ClodError
CapabilityError ([Char] -> ClodError) -> [Char] -> ClodError
forall a b. (a -> b) -> a -> b
$ [Char]
"Access denied: Cannot write manifest file outside allowed directories: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
manifestPath
else do
let content :: [Char]
content = [[Char]] -> [Char]
unlines [[Char]]
manifestLines
IO () -> ClodM ()
forall a. IO a -> ReaderT ClodConfig (ExceptT ClodError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ClodM ()) -> IO () -> ClodM ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. [Char] -> IOMode -> (Handle -> IO r) -> IO r
System.IO.withFile [Char]
manifestPath IOMode
System.IO.WriteMode ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Handle
h -> do
Handle -> [Char] -> IO ()
System.IO.hPutStr Handle
h [Char]
content
Handle -> IO ()
System.IO.hFlush Handle
h
needsBackticks :: String -> Bool
needsBackticks :: [Char] -> Bool
needsBackticks [Char]
s = case [Char]
s of
[] -> Bool
True
(Char
c:[Char]
cs) -> Bool -> Bool
not (Char -> Bool
isAlpha Char
c) Bool -> Bool -> Bool
|| (Char -> Bool) -> [Char] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
notAllowedInIdentifier [Char]
cs
where
isAlpha :: Char -> Bool
isAlpha Char
c = (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'a' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'z') Bool -> Bool -> Bool
|| (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'A' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'Z')
notAllowedInIdentifier :: Char -> Bool
notAllowedInIdentifier Char
c = Bool -> Bool
not (Char -> Bool
isAlpha Char
c Bool -> Bool -> Bool
|| Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-')
isDigit :: Char -> Bool
isDigit Char
c = Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9'
escapeString :: String -> String
escapeString :: ShowS
escapeString = (Char -> [Char]) -> ShowS
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> [Char]
escapeChar
where
escapeChar :: Char -> [Char]
escapeChar Char
'"' = [Char]
"\\\""
escapeChar Char
'\\' = [Char]
"\\\\"
escapeChar Char
c = [Char
c]
createOptimizedName :: FilePath -> OptimizedName
createOptimizedName :: [Char] -> OptimizedName
createOptimizedName [Char]
relPath = [Char] -> OptimizedName
OptimizedName [Char]
finalOptimizedName
where
dirPart :: [Char]
dirPart = ShowS
takeDirectory [Char]
relPath
fileName :: [Char]
fileName = ShowS
takeFileName [Char]
relPath
finalOptimizedName :: [Char]
finalOptimizedName = case [Char]
dirPart of
[Char]
"." -> [Char] -> ShowS
transformFilename [Char]
fileName [Char]
fileName
[Char]
_ ->
let dirParts :: [[Char]]
dirParts = [Char] -> [[Char]]
splitPath [Char]
dirPart
transformedDirParts :: [[Char]]
transformedDirParts = ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
transformDirPart [[Char]]
dirParts
transformedDirPath :: [Char]
transformedDirPath = [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
L.intersperse [Char]
"-" [[Char]]
transformedDirParts
transformedFileName :: [Char]
transformedFileName = [Char] -> ShowS
transformFilename [Char]
fileName [Char]
fileName
in [Char]
transformedDirPath [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"-" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
transformedFileName
transformDirPart :: String -> String
transformDirPart :: ShowS
transformDirPart [Char]
dir =
let cleanDir :: [Char]
cleanDir = if [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
L.isSuffixOf [Char]
"/" [Char]
dir then ShowS
forall a. HasCallStack => [a] -> [a]
init [Char]
dir else [Char]
dir
in if Bool -> Bool
not ([Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
cleanDir) Bool -> Bool -> Bool
&& [Char] -> Char
forall a. HasCallStack => [a] -> a
head [Char]
cleanDir Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.'
then [Char]
"dot--" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. HasCallStack => [a] -> [a]
tail [Char]
cleanDir
else [Char]
cleanDir
splitPath :: FilePath -> [String]
splitPath :: [Char] -> [[Char]]
splitPath [Char]
path = ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([Char] -> Bool) -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
getSegment ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ (Char -> Char -> Bool) -> [Char] -> [[Char]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
L.groupBy Char -> Char -> Bool
sameGroup [Char]
path
where
sameGroup :: Char -> Char -> Bool
sameGroup Char
c1 Char
c2 = Char
c1 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'/' Bool -> Bool -> Bool
&& Char
c2 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'/'
getSegment :: ShowS
getSegment [Char]
seg = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'/') [Char]
seg