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

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

import Data.ByteString.Lazy.Char8 (ByteString)
import qualified Data.ByteString.Lazy.Char8 as L
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 :: forall name. ToString name => name -> IO Text
readSource = FilePath -> IO Text
T.readFile forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToString a => a -> FilePath
toString

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

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

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

readJSON :: ReadSource t => String -> FileUrl -> IO t
readJSON :: forall t. ReadSource t => FilePath -> FileUrl -> IO t
readJSON FilePath
x = 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 -> ShowS
[FileUrl] -> ShowS
FileUrl -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [FileUrl] -> ShowS
$cshowList :: [FileUrl] -> ShowS
show :: FileUrl -> FilePath
$cshow :: FileUrl -> FilePath
showsPrec :: Int -> FileUrl -> ShowS
$cshowsPrec :: Int -> FileUrl -> ShowS
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
..} = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\FilePath
y FilePath
x -> FilePath
x forall a. Semigroup a => a -> a -> a
<> 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]
filePath = FilePath
fileName 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 (forall a. ToString a => a -> FilePath
toString FileUrl
url)
  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
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Bool
doesDirectoryExist
          (forall a. ToString a => a -> FilePath
toString FileUrl
url forall a. Semigroup a => a -> a -> a
<> FilePath
"/" forall a. Semigroup a => a -> a -> a
<> FilePath
name)

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

mkUrl :: FilePath -> FileUrl
mkUrl :: FilePath -> FileUrl
mkUrl FilePath
fileName =
  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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. (a -> Bool) -> [a] -> [a]
filter FileUrl -> Bool
isDir) forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileUrl -> IO [FileUrl]
ls

searchAppFiles :: FileUrl -> IO [FilePath]
searchAppFiles :: FileUrl -> IO [FilePath]
searchAppFiles = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Eq a => [a] -> [a]
nub forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe FileUrl -> Maybe FilePath
isAppFile) 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-"
          forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` FilePath
fileName =
          forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
/= Char
'.') FilePath
fileName
      | Bool
otherwise = forall a. Maybe a
Nothing