{-|
Relative directories and file paths.
-}
module Parser.Files (
Back (..),
Directory (..),
Ext,
File_error (..),
File_path (..),
File_path_and_location (..),
(<//>),
drop_file_name,
parse_file_path',
read_file,
write_file,
write_file_path,
write_file_path_and_location) where
import Control.Monad
import Control.Monad.Except
import Control.Monad.IO.Class
import Data.Bifunctor
import Data.Char
import Data.Maybe
import Parser.Locations
import Parser.Parser
import Parser.Utilities
import System.Directory
-- | Parent directory.
data Back = Back
data Char_class = Delimiter_char Token | Invalid_char | Name_char Char
-- | Relative directory.
data Directory = Directory [Back] [String]
-- | Errors.
data File_error = Failed_to_find_the_file FilePath | Invalid_file_path | Unexpected_extension Ext
-- | File extensions.
type Ext = String
-- | Relative file path.
data File_path = File_path Directory String Ext
-- | Locations with a file path.
data File_path_and_location = File_path_and_location File_path Location
type Parser = Parser' Token File_error
data Token = Dot_token | Name_token String | Slash_token
type Tokeniser = Tokeniser' Char_class Token File_error
-- | Prepend a directory to file path.
infixr 6 <//>
(<//>) :: Directory -> File_path -> File_path
directory_0 <//> File_path directory_1 file_name ext = File_path (directory_0 <> directory_1) file_name ext
deriving instance Eq Back
deriving instance Eq Char_class
deriving instance Eq Directory
deriving instance Eq File_path
deriving instance Eq Token
instance Monoid Directory where
mempty = Directory [] []
deriving instance Ord Back
deriving instance Ord Directory
deriving instance Ord File_path
instance Semigroup Directory where
Directory back_0 directories_0 <> Directory back_1 directories_1 =
case (directories_0, back_1) of
([], _) -> Directory (back_0 <> back_1) directories_1
(_, []) -> Directory back_0 (directories_0 <> directories_1)
(_ : _, Back : _) -> Directory back_0 (init directories_0) <> Directory (tail back_1) directories_1
deriving instance Show Back
deriving instance Show Char_class
deriving instance Show Directory
deriving instance Show File_error
deriving instance Show File_path
deriving instance Show File_path_and_location
deriving instance Show Token
check_ext :: (MonadError File_error f) => Ext -> File_path -> f ()
check_ext expected_ext (File_path _ _ actual_ext) = check (Unexpected_extension actual_ext) (expected_ext == actual_ext)
check_file_path :: (MonadError File_error f) => Ext -> File_path -> f ()
check_file_path ext file_path =
do
check Invalid_file_path (valid_file_path file_path)
check_ext ext file_path
classify_char :: Char -> Char_class
classify_char c =
case c of
_ | valid_name_char c -> Name_char c
'.' -> Delimiter_char Dot_token
'/' -> Delimiter_char Slash_token
_ -> Invalid_char
delimiter_char :: Char_class -> Maybe Token
delimiter_char char_class =
case char_class of
Delimiter_char token -> Just token
_ -> Nothing
-- | Get the directory part of a file path.
drop_file_name :: File_path -> Directory
drop_file_name (File_path directory _ _) = directory
name_char :: Char_class -> Maybe Char
name_char char_class =
case char_class of
Name_char c -> Just c
_ -> Nothing
name_token :: Token -> Maybe String
name_token token =
case token of
Name_token name -> Just name
_ -> Nothing
parse_back :: Parser Back
parse_back =
do
replicateM_ 2 parse_dot
return Back
parse_directory :: Parser Directory
parse_directory = Directory <$> parse_many (parse_with_slash parse_back) <*> parse_many (parse_with_slash parse_name)
parse_dot :: Parser ()
parse_dot = parse_token Dot_token
parse_file_path :: Parser File_path
parse_file_path =
do
directory <- parse_directory
file_name <- parse_name
parse_dot
actual_ext <- parse_name
return (File_path directory file_name actual_ext)
-- | Parse a file path and check the extension.
parse_file_path' :: (File_error -> error) -> Ext -> String -> Either error File_path
parse_file_path' transform_error expected_ext file_path =
first
transform_error
(do
file_path' <- fromJust (parse' classify_char (\ _ -> id) tokenise parse_file_path (\ _ -> Invalid_file_path) file_path)
check_ext expected_ext file_path'
return file_path')
parse_name :: Parser String
parse_name = parse_token' name_token
parse_with_slash :: Parser t -> Parser t
parse_with_slash parse_t =
do
x <- parse_t
parse_token Slash_token
return x
-- | Check the extension and read the file.
read_file :: Ext -> (FilePath -> IO file) -> (File_error -> error) -> File_path -> ExceptT error IO file
read_file ext read_file' transform_error file_path =
withExceptT
transform_error
(do
check_file_path ext file_path
let file_path' = write_file_path file_path
file_exits <- liftIO (doesPathExist file_path')
case file_exits of
False -> throwError (Failed_to_find_the_file file_path')
True -> liftIO (read_file' file_path'))
tokenise :: Tokeniser ()
tokenise = void (parse_many tokenise_1)
tokenise_1 :: Tokeniser ()
tokenise_1 = tokenise_delimiter <+> tokenise_name
tokenise_delimiter :: Tokeniser ()
tokenise_delimiter = add_token (parse_token' delimiter_char)
tokenise_name :: Tokeniser ()
tokenise_name = add_token (Name_token <$> parse_some (parse_token' name_char))
valid_directory :: Directory -> Bool
valid_directory (Directory _ directories) = all valid_name directories
valid_file_path :: File_path -> Bool
valid_file_path (File_path directory file_name ext) =
valid_directory directory && valid_name file_name && valid_name ext
valid_name :: String -> Bool
valid_name = all valid_name_char
valid_name_char :: Char -> Bool
valid_name_char c = elem c "'_" || isLetter c || isDigit c
write_back :: Back -> String
write_back Back = ".."
write_directory :: Directory -> FilePath
write_directory (Directory back directories) = join (write_with_slash <$> ((write_back <$> back) <> directories))
-- | Check the extension and write to the file.
write_file :: Ext -> (FilePath -> file -> IO ()) -> (File_error -> error) -> File_path -> file -> ExceptT error IO ()
write_file ext write_file' transform_error file_path file =
withExceptT
transform_error
(do
check_file_path ext file_path
liftIO (write_file' (write_file_path file_path) file))
-- | Write file path.
write_file_path :: File_path -> FilePath
write_file_path (File_path directory file_name ext) = write_directory directory <> file_name <> "." <> ext
-- | Write file path and location.
write_file_path_and_location :: File_path -> Location -> String
write_file_path_and_location file_path location = write_file_path file_path <> ":" <> write_location location
write_with_slash :: String -> String
write_with_slash text = text <> "/"