{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Test.Morpheus.File
  ( withSource,
    ReadSource,
    cd,
    file,
    readJSON,
    readGQL,
    FileUrl (..),
    ls,
    mkUrl,
    isDirectory,
    scanDirectories,
    searchAppFiles,
  )
where

import qualified Data.ByteString.Lazy.Char8 as L
import Data.ByteString.Lazy.Char8 (ByteString)
import Data.List
import qualified Data.Text.IO as T
import Relude hiding (ByteString)
import System.Directory (doesDirectoryExist, listDirectory)

class ReadSource t where
  readSource :: ToString name => name -> IO t

instance ReadSource Text where
  readSource :: name -> IO Text
readSource = FilePath -> IO Text
T.readFile (FilePath -> IO Text) -> (name -> FilePath) -> name -> IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. name -> FilePath
forall a. ToString a => a -> FilePath
toString

instance ReadSource ByteString where
  readSource :: name -> IO ByteString
readSource = FilePath -> IO ByteString
L.readFile (FilePath -> IO ByteString)
-> (name -> FilePath) -> name -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. name -> FilePath
forall a. ToString a => a -> FilePath
toString

withSource :: ReadSource t => (String, String) -> FileUrl -> IO t
withSource :: (FilePath, FilePath) -> FileUrl -> IO t
withSource (FilePath
name, FilePath
format) FileUrl
url
  | FileUrl -> Bool
isDir FileUrl
url = FilePath -> IO t
forall t name. (ReadSource t, ToString name) => name -> IO t
readSource (FilePath -> IO t) -> FilePath -> IO t
forall a b. (a -> b) -> a -> b
$ FileUrl -> FilePath
forall a. ToString a => a -> FilePath
toString FileUrl
url FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"/" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
name FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"." FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
format
  | Bool
otherwise = FilePath -> IO t
forall t name. (ReadSource t, ToString name) => name -> IO t
readSource (FilePath -> IO t) -> FilePath -> IO t
forall a b. (a -> b) -> a -> b
$ FileUrl -> FilePath
forall a. ToString a => a -> FilePath
toString FileUrl
url FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"." FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
format

readGQL :: ReadSource t => String -> FileUrl -> IO t
readGQL :: FilePath -> FileUrl -> IO t
readGQL FilePath
x = (FilePath, FilePath) -> FileUrl -> IO t
forall t. ReadSource t => (FilePath, FilePath) -> FileUrl -> IO t
withSource (FilePath
x, FilePath
"gql")

readJSON :: ReadSource t => String -> FileUrl -> IO t
readJSON :: FilePath -> FileUrl -> IO t
readJSON FilePath
x = (FilePath, FilePath) -> FileUrl -> IO t
forall t. ReadSource t => (FilePath, FilePath) -> FileUrl -> IO t
withSource (FilePath
x, FilePath
"json")

data FileUrl = FileUrl
  { FileUrl -> [FilePath]
filePath :: [FilePath],
    FileUrl -> FilePath
fileName :: FilePath,
    FileUrl -> Bool
isDir :: Bool
  }
  deriving (Int -> FileUrl -> FilePath -> FilePath
[FileUrl] -> FilePath -> FilePath
FileUrl -> FilePath
(Int -> FileUrl -> FilePath -> FilePath)
-> (FileUrl -> FilePath)
-> ([FileUrl] -> FilePath -> FilePath)
-> Show FileUrl
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [FileUrl] -> FilePath -> FilePath
$cshowList :: [FileUrl] -> FilePath -> FilePath
show :: FileUrl -> FilePath
$cshow :: FileUrl -> FilePath
showsPrec :: Int -> FileUrl -> FilePath -> FilePath
$cshowsPrec :: Int -> FileUrl -> FilePath -> FilePath
Show)

instance ToString FileUrl where
  toString :: FileUrl -> FilePath
toString FileUrl {Bool
FilePath
[FilePath]
isDir :: Bool
fileName :: FilePath
filePath :: [FilePath]
fileName :: FileUrl -> FilePath
filePath :: FileUrl -> [FilePath]
isDir :: FileUrl -> Bool
..} = (FilePath -> FilePath -> FilePath)
-> FilePath -> [FilePath] -> FilePath
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\FilePath
y FilePath
x -> FilePath
x FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"/" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
y) FilePath
fileName [FilePath]
filePath

goTo :: FileUrl -> FilePath -> Bool -> FileUrl
goTo :: FileUrl -> FilePath -> Bool -> FileUrl
goTo FileUrl {FilePath
fileName :: FilePath
fileName :: FileUrl -> FilePath
fileName, [FilePath]
filePath :: [FilePath]
filePath :: FileUrl -> [FilePath]
filePath} FilePath
name Bool
isDir =
  FileUrl :: [FilePath] -> FilePath -> Bool -> FileUrl
FileUrl
    { filePath :: [FilePath]
filePath = FilePath
fileName FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
filePath,
      fileName :: FilePath
fileName = FilePath
name,
      Bool
isDir :: Bool
isDir :: Bool
..
    }

cd :: FileUrl -> FilePath -> FileUrl
cd :: FileUrl -> FilePath -> FileUrl
cd FileUrl
url FilePath
name = FileUrl -> FilePath -> Bool -> FileUrl
goTo FileUrl
url FilePath
name Bool
True

file :: FileUrl -> FilePath -> FileUrl
file :: FileUrl -> FilePath -> FileUrl
file FileUrl
url FilePath
name = FileUrl -> FilePath -> Bool -> FileUrl
goTo FileUrl
url FilePath
name Bool
False

ls :: FileUrl -> IO [FileUrl]
ls :: FileUrl -> IO [FileUrl]
ls FileUrl
url = do
  [FilePath]
files <- FilePath -> IO [FilePath]
listDirectory (FileUrl -> FilePath
forall a. ToString a => a -> FilePath
toString FileUrl
url)
  (FilePath -> IO FileUrl) -> [FilePath] -> IO [FileUrl]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse FilePath -> IO FileUrl
mkFile [FilePath]
files
  where
    mkFile :: FilePath -> IO FileUrl
mkFile FilePath
name =
      FileUrl -> FilePath -> Bool -> FileUrl
goTo FileUrl
url FilePath
name
        (Bool -> FileUrl) -> IO Bool -> IO FileUrl
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Bool
doesDirectoryExist
          (FileUrl -> FilePath
forall a. ToString a => a -> FilePath
toString FileUrl
url FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"/" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
name)

isDirectory :: FileUrl -> IO Bool
isDirectory :: FileUrl -> IO Bool
isDirectory = FilePath -> IO Bool
doesDirectoryExist (FilePath -> IO Bool)
-> (FileUrl -> FilePath) -> FileUrl -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileUrl -> FilePath
forall a. ToString a => a -> FilePath
toString

mkUrl :: FilePath -> FileUrl
mkUrl :: FilePath -> FileUrl
mkUrl FilePath
fileName =
  FileUrl :: [FilePath] -> FilePath -> Bool -> FileUrl
FileUrl
    { filePath :: [FilePath]
filePath = [FilePath
"test"],
      FilePath
fileName :: FilePath
fileName :: FilePath
fileName,
      isDir :: Bool
isDir = Bool
True
    }

scanDirectories :: FileUrl -> IO [FileUrl]
scanDirectories :: FileUrl -> IO [FileUrl]
scanDirectories = ([FileUrl] -> [FileUrl]) -> IO [FileUrl] -> IO [FileUrl]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((FileUrl -> Bool) -> [FileUrl] -> [FileUrl]
forall a. (a -> Bool) -> [a] -> [a]
filter FileUrl -> Bool
isDir) (IO [FileUrl] -> IO [FileUrl])
-> (FileUrl -> IO [FileUrl]) -> FileUrl -> IO [FileUrl]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileUrl -> IO [FileUrl]
ls

searchAppFiles :: FileUrl -> IO [FilePath]
searchAppFiles :: FileUrl -> IO [FilePath]
searchAppFiles = ([FileUrl] -> [FilePath]) -> IO [FileUrl] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a]
nub ([FilePath] -> [FilePath])
-> ([FileUrl] -> [FilePath]) -> [FileUrl] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FileUrl -> Maybe FilePath) -> [FileUrl] -> [FilePath]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe FileUrl -> Maybe FilePath
isAppFile) (IO [FileUrl] -> IO [FilePath])
-> (FileUrl -> IO [FileUrl]) -> FileUrl -> IO [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileUrl -> IO [FileUrl]
ls
  where
    isAppFile :: FileUrl -> Maybe FilePath
isAppFile FileUrl {FilePath
fileName :: FilePath
fileName :: FileUrl -> FilePath
fileName, Bool
isDir :: Bool
isDir :: FileUrl -> Bool
isDir}
      | Bool -> Bool
not Bool
isDir
          Bool -> Bool -> Bool
&& FilePath
"app-" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` FilePath
fileName =
        FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'.') FilePath
fileName
      | Bool
otherwise = Maybe FilePath
forall a. Maybe a
Nothing