{-# LANGUAGE OverloadedStrings #-}
module Test.Hls.FileSystem
( FileSystem(..)
, VirtualFileTree(..)
, FileTree
, Content
, materialise
, materialiseVFT
, readFileFS
, writeFileFS
, mkVirtualFileTree
, toNfp
, toAbsFp
, file
, copy
, directory
, text
, ref
, copyDir
, directCradle
, simpleCabalCradle
, directProject
, directProjectMulti
, simpleCabalProject
, simpleCabalProject'
) where
import Data.Foldable (traverse_)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Development.IDE (NormalizedFilePath)
import Language.LSP.Protocol.Types (toNormalizedFilePath)
import System.Directory
import System.FilePath as FP
import System.Process.Extra (readProcess)
data FileSystem =
FileSystem
{ FileSystem -> FilePath
fsRoot :: FilePath
, FileSystem -> [FileTree]
fsTree :: [FileTree]
, FileSystem -> FilePath
fsOriginalRoot :: FilePath
} deriving (FileSystem -> FileSystem -> Bool
(FileSystem -> FileSystem -> Bool)
-> (FileSystem -> FileSystem -> Bool) -> Eq FileSystem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FileSystem -> FileSystem -> Bool
== :: FileSystem -> FileSystem -> Bool
$c/= :: FileSystem -> FileSystem -> Bool
/= :: FileSystem -> FileSystem -> Bool
Eq, Eq FileSystem
Eq FileSystem =>
(FileSystem -> FileSystem -> Ordering)
-> (FileSystem -> FileSystem -> Bool)
-> (FileSystem -> FileSystem -> Bool)
-> (FileSystem -> FileSystem -> Bool)
-> (FileSystem -> FileSystem -> Bool)
-> (FileSystem -> FileSystem -> FileSystem)
-> (FileSystem -> FileSystem -> FileSystem)
-> Ord FileSystem
FileSystem -> FileSystem -> Bool
FileSystem -> FileSystem -> Ordering
FileSystem -> FileSystem -> FileSystem
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: FileSystem -> FileSystem -> Ordering
compare :: FileSystem -> FileSystem -> Ordering
$c< :: FileSystem -> FileSystem -> Bool
< :: FileSystem -> FileSystem -> Bool
$c<= :: FileSystem -> FileSystem -> Bool
<= :: FileSystem -> FileSystem -> Bool
$c> :: FileSystem -> FileSystem -> Bool
> :: FileSystem -> FileSystem -> Bool
$c>= :: FileSystem -> FileSystem -> Bool
>= :: FileSystem -> FileSystem -> Bool
$cmax :: FileSystem -> FileSystem -> FileSystem
max :: FileSystem -> FileSystem -> FileSystem
$cmin :: FileSystem -> FileSystem -> FileSystem
min :: FileSystem -> FileSystem -> FileSystem
Ord, Int -> FileSystem -> ShowS
[FileSystem] -> ShowS
FileSystem -> FilePath
(Int -> FileSystem -> ShowS)
-> (FileSystem -> FilePath)
-> ([FileSystem] -> ShowS)
-> Show FileSystem
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FileSystem -> ShowS
showsPrec :: Int -> FileSystem -> ShowS
$cshow :: FileSystem -> FilePath
show :: FileSystem -> FilePath
$cshowList :: [FileSystem] -> ShowS
showList :: [FileSystem] -> ShowS
Show)
data VirtualFileTree =
VirtualFileTree
{ VirtualFileTree -> [FileTree]
vftTree :: [FileTree]
, VirtualFileTree -> FilePath
vftOriginalRoot :: FilePath
} deriving (VirtualFileTree -> VirtualFileTree -> Bool
(VirtualFileTree -> VirtualFileTree -> Bool)
-> (VirtualFileTree -> VirtualFileTree -> Bool)
-> Eq VirtualFileTree
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VirtualFileTree -> VirtualFileTree -> Bool
== :: VirtualFileTree -> VirtualFileTree -> Bool
$c/= :: VirtualFileTree -> VirtualFileTree -> Bool
/= :: VirtualFileTree -> VirtualFileTree -> Bool
Eq, Eq VirtualFileTree
Eq VirtualFileTree =>
(VirtualFileTree -> VirtualFileTree -> Ordering)
-> (VirtualFileTree -> VirtualFileTree -> Bool)
-> (VirtualFileTree -> VirtualFileTree -> Bool)
-> (VirtualFileTree -> VirtualFileTree -> Bool)
-> (VirtualFileTree -> VirtualFileTree -> Bool)
-> (VirtualFileTree -> VirtualFileTree -> VirtualFileTree)
-> (VirtualFileTree -> VirtualFileTree -> VirtualFileTree)
-> Ord VirtualFileTree
VirtualFileTree -> VirtualFileTree -> Bool
VirtualFileTree -> VirtualFileTree -> Ordering
VirtualFileTree -> VirtualFileTree -> VirtualFileTree
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: VirtualFileTree -> VirtualFileTree -> Ordering
compare :: VirtualFileTree -> VirtualFileTree -> Ordering
$c< :: VirtualFileTree -> VirtualFileTree -> Bool
< :: VirtualFileTree -> VirtualFileTree -> Bool
$c<= :: VirtualFileTree -> VirtualFileTree -> Bool
<= :: VirtualFileTree -> VirtualFileTree -> Bool
$c> :: VirtualFileTree -> VirtualFileTree -> Bool
> :: VirtualFileTree -> VirtualFileTree -> Bool
$c>= :: VirtualFileTree -> VirtualFileTree -> Bool
>= :: VirtualFileTree -> VirtualFileTree -> Bool
$cmax :: VirtualFileTree -> VirtualFileTree -> VirtualFileTree
max :: VirtualFileTree -> VirtualFileTree -> VirtualFileTree
$cmin :: VirtualFileTree -> VirtualFileTree -> VirtualFileTree
min :: VirtualFileTree -> VirtualFileTree -> VirtualFileTree
Ord, Int -> VirtualFileTree -> ShowS
[VirtualFileTree] -> ShowS
VirtualFileTree -> FilePath
(Int -> VirtualFileTree -> ShowS)
-> (VirtualFileTree -> FilePath)
-> ([VirtualFileTree] -> ShowS)
-> Show VirtualFileTree
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VirtualFileTree -> ShowS
showsPrec :: Int -> VirtualFileTree -> ShowS
$cshow :: VirtualFileTree -> FilePath
show :: VirtualFileTree -> FilePath
$cshowList :: [VirtualFileTree] -> ShowS
showList :: [VirtualFileTree] -> ShowS
Show)
data FileTree
= File FilePath Content
| Directory FilePath [FileTree]
| CopiedDirectory FilePath
deriving (Int -> FileTree -> ShowS
[FileTree] -> ShowS
FileTree -> FilePath
(Int -> FileTree -> ShowS)
-> (FileTree -> FilePath) -> ([FileTree] -> ShowS) -> Show FileTree
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FileTree -> ShowS
showsPrec :: Int -> FileTree -> ShowS
$cshow :: FileTree -> FilePath
show :: FileTree -> FilePath
$cshowList :: [FileTree] -> ShowS
showList :: [FileTree] -> ShowS
Show, FileTree -> FileTree -> Bool
(FileTree -> FileTree -> Bool)
-> (FileTree -> FileTree -> Bool) -> Eq FileTree
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FileTree -> FileTree -> Bool
== :: FileTree -> FileTree -> Bool
$c/= :: FileTree -> FileTree -> Bool
/= :: FileTree -> FileTree -> Bool
Eq, Eq FileTree
Eq FileTree =>
(FileTree -> FileTree -> Ordering)
-> (FileTree -> FileTree -> Bool)
-> (FileTree -> FileTree -> Bool)
-> (FileTree -> FileTree -> Bool)
-> (FileTree -> FileTree -> Bool)
-> (FileTree -> FileTree -> FileTree)
-> (FileTree -> FileTree -> FileTree)
-> Ord FileTree
FileTree -> FileTree -> Bool
FileTree -> FileTree -> Ordering
FileTree -> FileTree -> FileTree
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: FileTree -> FileTree -> Ordering
compare :: FileTree -> FileTree -> Ordering
$c< :: FileTree -> FileTree -> Bool
< :: FileTree -> FileTree -> Bool
$c<= :: FileTree -> FileTree -> Bool
<= :: FileTree -> FileTree -> Bool
$c> :: FileTree -> FileTree -> Bool
> :: FileTree -> FileTree -> Bool
$c>= :: FileTree -> FileTree -> Bool
>= :: FileTree -> FileTree -> Bool
$cmax :: FileTree -> FileTree -> FileTree
max :: FileTree -> FileTree -> FileTree
$cmin :: FileTree -> FileTree -> FileTree
min :: FileTree -> FileTree -> FileTree
Ord)
data Content
= Inline T.Text
| Ref FilePath
deriving (Int -> Content -> ShowS
[Content] -> ShowS
Content -> FilePath
(Int -> Content -> ShowS)
-> (Content -> FilePath) -> ([Content] -> ShowS) -> Show Content
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Content -> ShowS
showsPrec :: Int -> Content -> ShowS
$cshow :: Content -> FilePath
show :: Content -> FilePath
$cshowList :: [Content] -> ShowS
showList :: [Content] -> ShowS
Show, Content -> Content -> Bool
(Content -> Content -> Bool)
-> (Content -> Content -> Bool) -> Eq Content
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Content -> Content -> Bool
== :: Content -> Content -> Bool
$c/= :: Content -> Content -> Bool
/= :: Content -> Content -> Bool
Eq, Eq Content
Eq Content =>
(Content -> Content -> Ordering)
-> (Content -> Content -> Bool)
-> (Content -> Content -> Bool)
-> (Content -> Content -> Bool)
-> (Content -> Content -> Bool)
-> (Content -> Content -> Content)
-> (Content -> Content -> Content)
-> Ord Content
Content -> Content -> Bool
Content -> Content -> Ordering
Content -> Content -> Content
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Content -> Content -> Ordering
compare :: Content -> Content -> Ordering
$c< :: Content -> Content -> Bool
< :: Content -> Content -> Bool
$c<= :: Content -> Content -> Bool
<= :: Content -> Content -> Bool
$c> :: Content -> Content -> Bool
> :: Content -> Content -> Bool
$c>= :: Content -> Content -> Bool
>= :: Content -> Content -> Bool
$cmax :: Content -> Content -> Content
max :: Content -> Content -> Content
$cmin :: Content -> Content -> Content
min :: Content -> Content -> Content
Ord)
readFileFS :: FileSystem -> FilePath -> IO T.Text
readFileFS :: FileSystem -> FilePath -> IO Text
readFileFS FileSystem
fs FilePath
fp = do
FilePath -> IO Text
T.readFile (FileSystem -> FilePath
fsRoot FileSystem
fs FilePath -> ShowS
</> ShowS
FP.normalise FilePath
fp)
writeFileFS :: FileSystem -> FilePath -> Content -> IO ()
writeFileFS :: FileSystem -> FilePath -> Content -> IO ()
writeFileFS FileSystem
fs FilePath
fp Content
content = do
Text
contents <- case Content
content of
Inline Text
txt -> Text -> IO Text
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
txt
Ref FilePath
path -> FilePath -> IO Text
T.readFile (FileSystem -> FilePath
fsOriginalRoot FileSystem
fs FilePath -> ShowS
</> ShowS
FP.normalise FilePath
path)
FilePath -> Text -> IO ()
T.writeFile (FileSystem -> FilePath
fsRoot FileSystem
fs FilePath -> ShowS
</> ShowS
FP.normalise FilePath
fp) Text
contents
materialise :: FilePath -> [FileTree] -> FilePath -> IO FileSystem
materialise :: FilePath -> [FileTree] -> FilePath -> IO FileSystem
materialise FilePath
rootDir' [FileTree]
fileTree FilePath
testDataDir' = do
let testDataDir :: FilePath
testDataDir = ShowS
FP.normalise FilePath
testDataDir'
rootDir :: FilePath
rootDir = ShowS
FP.normalise FilePath
rootDir'
persist :: FilePath -> FileTree -> IO ()
persist :: FilePath -> FileTree -> IO ()
persist FilePath
root (File FilePath
name Content
cts) = case Content
cts of
Inline Text
txt -> FilePath -> Text -> IO ()
T.writeFile (FilePath
root FilePath -> ShowS
</> FilePath
name) Text
txt
Ref FilePath
path -> FilePath -> FilePath -> IO ()
copyFile (FilePath
testDataDir FilePath -> ShowS
</> ShowS
FP.normalise FilePath
path) (FilePath
root FilePath -> ShowS
</> ShowS
takeFileName FilePath
name)
persist FilePath
root (Directory FilePath
name [FileTree]
nodes) = do
FilePath -> IO ()
createDirectory (FilePath
root FilePath -> ShowS
</> FilePath
name)
(FileTree -> IO ()) -> [FileTree] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (FilePath -> FileTree -> IO ()
persist (FilePath
root FilePath -> ShowS
</> FilePath
name)) [FileTree]
nodes
persist FilePath
root (CopiedDirectory FilePath
name) = do
FilePath -> FilePath -> IO ()
copyDir' FilePath
root FilePath
name
copyDir' :: FilePath -> FilePath -> IO ()
copyDir' :: FilePath -> FilePath -> IO ()
copyDir' FilePath
root FilePath
dir = do
[FilePath]
files <- ShowS -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ShowS
FP.normalise ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
lines (FilePath -> [FilePath]) -> IO FilePath -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO FilePath -> IO FilePath
forall a. FilePath -> IO a -> IO a
withCurrentDirectory (FilePath
testDataDir FilePath -> ShowS
</> FilePath
dir) (FilePath -> [FilePath] -> FilePath -> IO FilePath
readProcess FilePath
"git" [FilePath
"ls-files", FilePath
"--cached", FilePath
"--modified", FilePath
"--others"] FilePath
"")
(FilePath -> IO ()) -> [FilePath] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True (FilePath -> IO ()) -> ShowS -> FilePath -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((FilePath
root </>) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
takeDirectory)) [FilePath]
files
(FilePath -> IO ()) -> [FilePath] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\FilePath
f -> FilePath -> FilePath -> IO ()
copyFile (FilePath
testDataDir FilePath -> ShowS
</> FilePath
dir FilePath -> ShowS
</> FilePath
f) (FilePath
root FilePath -> ShowS
</> FilePath
f)) [FilePath]
files
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
(FileTree -> IO ()) -> [FileTree] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (FilePath -> FileTree -> IO ()
persist FilePath
rootDir) [FileTree]
fileTree
FileSystem -> IO FileSystem
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FileSystem -> IO FileSystem) -> FileSystem -> IO FileSystem
forall a b. (a -> b) -> a -> b
$ FilePath -> [FileTree] -> FilePath -> FileSystem
FileSystem FilePath
rootDir [FileTree]
fileTree FilePath
testDataDir
materialiseVFT :: FilePath -> VirtualFileTree -> IO FileSystem
materialiseVFT :: FilePath -> VirtualFileTree -> IO FileSystem
materialiseVFT FilePath
root VirtualFileTree
fs = FilePath -> [FileTree] -> FilePath -> IO FileSystem
materialise FilePath
root (VirtualFileTree -> [FileTree]
vftTree VirtualFileTree
fs) (VirtualFileTree -> FilePath
vftOriginalRoot VirtualFileTree
fs)
mkVirtualFileTree :: FilePath -> [FileTree] -> VirtualFileTree
mkVirtualFileTree :: FilePath -> [FileTree] -> VirtualFileTree
mkVirtualFileTree FilePath
testDataDir [FileTree]
tree =
VirtualFileTree
{ vftTree :: [FileTree]
vftTree = [FileTree]
tree
, vftOriginalRoot :: FilePath
vftOriginalRoot = FilePath
testDataDir
}
toAbsFp :: FileSystem -> FilePath -> FilePath
toAbsFp :: FileSystem -> ShowS
toAbsFp FileSystem
fs FilePath
fp = FileSystem -> FilePath
fsRoot FileSystem
fs FilePath -> ShowS
</> ShowS
FP.normalise FilePath
fp
toNfp :: FileSystem -> FilePath -> NormalizedFilePath
toNfp :: FileSystem -> FilePath -> NormalizedFilePath
toNfp FileSystem
fs FilePath
fp =
FilePath -> NormalizedFilePath
toNormalizedFilePath (FilePath -> NormalizedFilePath) -> FilePath -> NormalizedFilePath
forall a b. (a -> b) -> a -> b
$ FileSystem -> ShowS
toAbsFp FileSystem
fs FilePath
fp
file :: FilePath -> Content -> FileTree
file :: FilePath -> Content -> FileTree
file FilePath
fp Content
cts = FilePath -> Content -> FileTree
File FilePath
fp Content
cts
copy :: FilePath -> FileTree
copy :: FilePath -> FileTree
copy FilePath
fp = FilePath -> Content -> FileTree
File FilePath
fp (FilePath -> Content
Ref FilePath
fp)
copyDir :: FilePath -> FileTree
copyDir :: FilePath -> FileTree
copyDir FilePath
dir = FilePath -> FileTree
CopiedDirectory FilePath
dir
directory :: FilePath -> [FileTree] -> FileTree
directory :: FilePath -> [FileTree] -> FileTree
directory FilePath
name [FileTree]
nodes = FilePath -> [FileTree] -> FileTree
Directory FilePath
name [FileTree]
nodes
text :: T.Text -> Content
text :: Text -> Content
text = Text -> Content
Inline
ref :: FilePath -> Content
ref :: FilePath -> Content
ref = FilePath -> Content
Ref
directCradle :: [T.Text] -> FileTree
directCradle :: [Text] -> FileTree
directCradle [Text]
args =
FilePath -> Content -> FileTree
file FilePath
"hie.yaml"
( Text -> Content
Inline (Text -> Content) -> Text -> Content
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
[ Text
"cradle:"
, Text
" direct:"
, Text
" arguments:"
] [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<>
[ Text
" - " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
arg | Text
arg <- [Text]
args]
)
simpleCabalCradle :: FileTree
simpleCabalCradle :: FileTree
simpleCabalCradle =
FilePath -> Content -> FileTree
file FilePath
"hie.yaml"
(Text -> Content
Inline (Text -> Content) -> Text -> Content
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
[ Text
"cradle:"
, Text
" cabal:"
]
)
directProject :: FilePath -> [FileTree]
directProject :: FilePath -> [FileTree]
directProject FilePath
fp =
[ [Text] -> FileTree
directCradle [FilePath -> Text
T.pack FilePath
fp]
, FilePath -> Content -> FileTree
file FilePath
fp (FilePath -> Content
Ref FilePath
fp)
]
directProjectMulti :: [FilePath] -> [FileTree]
directProjectMulti :: [FilePath] -> [FileTree]
directProjectMulti [FilePath]
fps =
[ [Text] -> FileTree
directCradle ([Text] -> FileTree) -> [Text] -> FileTree
forall a b. (a -> b) -> a -> b
$ (FilePath -> Text) -> [FilePath] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> Text
T.pack [FilePath]
fps
] [FileTree] -> [FileTree] -> [FileTree]
forall a. Semigroup a => a -> a -> a
<> (FilePath -> FileTree) -> [FilePath] -> [FileTree]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> FileTree
copy [FilePath]
fps
simpleCabalProject :: [FilePath] -> [FileTree]
simpleCabalProject :: [FilePath] -> [FileTree]
simpleCabalProject [FilePath]
fps =
[ FileTree
simpleCabalCradle
] [FileTree] -> [FileTree] -> [FileTree]
forall a. Semigroup a => a -> a -> a
<> (FilePath -> FileTree) -> [FilePath] -> [FileTree]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> FileTree
copy [FilePath]
fps
simpleCabalProject' :: [FileTree] -> [FileTree]
simpleCabalProject' :: [FileTree] -> [FileTree]
simpleCabalProject' [FileTree]
fps =
[ FileTree
simpleCabalCradle
] [FileTree] -> [FileTree] -> [FileTree]
forall a. Semigroup a => a -> a -> a
<> [FileTree]
fps