{-|
Description: Assorted utilities.

* Assorted utilities.
* Relative directories and file paths.
-}
module Parser.Utilities (
  Back (..),
  Directory (..),
  File_path (..),
  (<->),
  (<//>),
  all_equal,
  between,
  check,
  check_ext,
  construct_map,
  construct_set,
  drop_file_name,
  element_at,
  lcm_all,
  read_file,
  swap_either,
  write_file_path) where
  import Control.Monad.Except
  import Data.Foldable as Foldable
  import Data.List as List
  import Data.Map as Map
  import Data.Set as Set
  import System.Directory
  -- | Parent directory.
  data Back = Back
  -- | Relative directory.
  data Directory = Directory [Back] [String]
  -- | Relative file path.
  data File_path = File_path Directory String String
  -- | Concatenate strings with a whitespace in between.
  infixr 5 <->
  (<->) :: String -> String -> String
  [Char]
s <-> :: [Char] -> [Char] -> [Char]
<-> [Char]
t = [Char]
s [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
t
  -- | Prepend a directory to file path.
  infixr 6 <//>
  (<//>) :: Directory -> File_path -> File_path
  Directory
directory_0 <//> :: Directory -> File_path -> File_path
<//> File_path Directory
directory_1 [Char]
file_name [Char]
ext = Directory -> [Char] -> [Char] -> File_path
File_path (Directory
directory_0 Directory -> Directory -> Directory
forall a. Semigroup a => a -> a -> a
<> Directory
directory_1) [Char]
file_name [Char]
ext
  deriving instance Eq Back
  deriving instance Eq Directory
  deriving instance Eq File_path
  instance Monoid Directory where
    mempty :: Directory
mempty = [Back] -> [[Char]] -> Directory
Directory [] []
  deriving instance Ord Back
  deriving instance Ord Directory
  deriving instance Ord File_path
  instance Semigroup Directory where
    Directory [Back]
back_0 [[Char]]
directories_0 <> :: Directory -> Directory -> Directory
<> Directory [Back]
back_1 [[Char]]
directories_1 =
      case ([[Char]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Foldable.length [[Char]]
directories_0, [Back] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Foldable.length [Back]
back_1) of
        (Int
0, Int
0) -> [Back] -> [[Char]] -> Directory
Directory [Back]
back_0 [[Char]]
directories_1
        (Int
0, Int
_) -> [Back] -> [[Char]] -> Directory
Directory ([Back]
back_0 [Back] -> [Back] -> [Back]
forall a. Semigroup a => a -> a -> a
<> [Back]
back_1) [[Char]]
directories_1
        (Int
_, Int
0) -> [Back] -> [[Char]] -> Directory
Directory [Back]
back_0 ([[Char]]
directories_0 [[Char]] -> [[Char]] -> [[Char]]
forall a. Semigroup a => a -> a -> a
<> [[Char]]
directories_1)
        (Int
_, Int
_) -> [Back] -> [[Char]] -> Directory
Directory [Back]
back_0 ([[Char]] -> [[Char]]
forall a. HasCallStack => [a] -> [a]
init [[Char]]
directories_0) Directory -> Directory -> Directory
forall a. Semigroup a => a -> a -> a
<> [Back] -> [[Char]] -> Directory
Directory (Int -> [Back] -> [Back]
forall a. Int -> [a] -> [a]
List.drop Int
1 [Back]
back_1) [[Char]]
directories_1
  deriving instance Show Back
  deriving instance Show Directory
  deriving instance Show File_path
  -- | Checks if all elements of a list are equal. Returns @Nothing@ if all elements aren't equal, @Just Nothing@ if the list is
  -- empty and @Just (Just x)@ if all elements are equal to @x@.
  all_equal :: Eq t => [t] -> Maybe (Maybe t)
  all_equal :: forall t. Eq t => [t] -> Maybe (Maybe t)
all_equal [t]
x =
    case [t]
x of
      [] -> Maybe t -> Maybe (Maybe t)
forall a. a -> Maybe a
Just Maybe t
forall a. Maybe a
Nothing
      t
y : [t]
x' ->
        do
          () -> Bool -> Maybe ()
forall error (f :: * -> *).
MonadError error f =>
error -> Bool -> f ()
check () ((t -> Bool) -> [t] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (t -> t -> Bool
forall a. Eq a => a -> a -> Bool
(==) t
y) [t]
x')
          Maybe t -> Maybe (Maybe t)
forall a. a -> Maybe a
Just (t -> Maybe t
forall a. a -> Maybe a
Just t
y)
  -- | Check if the value is in bounds.
  between :: Ord t => t -> t -> t -> Bool
  between :: forall t. Ord t => t -> t -> t -> Bool
between t
lowest t
highest t
x = t
lowest t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
x Bool -> Bool -> Bool
&& t
highest t -> t -> Bool
forall a. Ord a => a -> a -> Bool
>= t
x
  -- | Throw an error if the condition is not satisfied.
  check :: MonadError error f => error -> Bool -> f ()
  check :: forall error (f :: * -> *).
MonadError error f =>
error -> Bool -> f ()
check error
err Bool
condition =
    case Bool
condition of
      Bool
False -> error -> f ()
forall a. error -> f a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError error
err
      Bool
True -> () -> f ()
forall a. a -> f a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  -- | Check file path extension.
  check_ext :: String -> File_path -> Bool
  check_ext :: [Char] -> File_path -> Bool
check_ext [Char]
ext (File_path Directory
_ [Char]
_ [Char]
ext') = [Char]
ext [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
ext'
  -- | Construct a map if all keys are different. Otherwise return @Nothing@.
  construct_map :: Ord t => [(t, u)] -> Maybe (Map t u)
  construct_map :: forall t u. Ord t => [(t, u)] -> Maybe (Map t u)
construct_map [(t, u)]
x =
    do
      let y :: Map t u
y = [(t, u)] -> Map t u
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(t, u)]
x
      () -> Bool -> Maybe ()
forall error (f :: * -> *).
MonadError error f =>
error -> Bool -> f ()
check () ([(t, u)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Foldable.length [(t, u)]
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Map t u -> Int
forall k a. Map k a -> Int
Map.size Map t u
y)
      Map t u -> Maybe (Map t u)
forall a. a -> Maybe a
Just Map t u
y
  -- | Construct a set if all elements are different. Otherwise return @Nothing@.
  construct_set :: Ord t => [t] -> Maybe (Set t)
  construct_set :: forall t. Ord t => [t] -> Maybe (Set t)
construct_set [t]
x =
    do
      let y :: Set t
y = [t] -> Set t
forall a. Ord a => [a] -> Set a
Set.fromList [t]
x
      () -> Bool -> Maybe ()
forall error (f :: * -> *).
MonadError error f =>
error -> Bool -> f ()
check () ([t] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Foldable.length [t]
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Set t -> Int
forall a. Set a -> Int
Set.size Set t
y)
      Set t -> Maybe (Set t)
forall a. a -> Maybe a
Just Set t
y
  -- | Get the directory part of a file path.
  drop_file_name :: File_path -> Directory
  drop_file_name :: File_path -> Directory
drop_file_name (File_path Directory
directory [Char]
_ [Char]
_) = Directory
directory
  -- | Safe list indexation.
  element_at :: Int -> [t] -> Maybe t
  element_at :: forall t. Int -> [t] -> Maybe t
element_at Int
j [t]
x =
    do
      () -> Bool -> Maybe ()
forall error (f :: * -> *).
MonadError error f =>
error -> Bool -> f ()
check () (Int -> Int -> Int -> Bool
forall t. Ord t => t -> t -> t -> Bool
between Int
0 ([t] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Foldable.length [t]
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
j)
      t -> Maybe t
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ([t]
x [t] -> Int -> t
forall a. HasCallStack => [a] -> Int -> a
!! Int
j)
  -- | Aggregate least common denominator.
  lcm_all :: (Foldable f, Integral t) => f t -> t
  lcm_all :: forall (f :: * -> *) t. (Foldable f, Integral t) => f t -> t
lcm_all = (t -> t -> t) -> t -> f t -> t
forall a b. (a -> b -> b) -> b -> f a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Foldable.foldr t -> t -> t
forall a. Integral a => a -> a -> a
lcm t
1
  -- | Read a file.
  read_file :: File_path -> IO (Maybe String)
  read_file :: File_path -> IO (Maybe [Char])
read_file File_path
file_path =
    do
      let file_path' :: [Char]
file_path' = File_path -> [Char]
write_file_path File_path
file_path
      Bool
pathExists <- [Char] -> IO Bool
doesPathExist [Char]
file_path'
      case Bool
pathExists of
        Bool
False -> Maybe [Char] -> IO (Maybe [Char])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Char]
forall a. Maybe a
Nothing
        Bool
True -> [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char]) -> IO [Char] -> IO (Maybe [Char])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO [Char]
readFile [Char]
file_path'
  -- | Swap Left and Right.
  swap_either :: Either t u -> Either u t
  swap_either :: forall t u. Either t u -> Either u t
swap_either Either t u
x =
    case Either t u
x of
      Left t
y -> t -> Either u t
forall a b. b -> Either a b
Right t
y
      Right u
y -> u -> Either u t
forall a b. a -> Either a b
Left u
y
  write_back :: Back -> String
  write_back :: Back -> [Char]
write_back Back
Back = [Char]
".."
  -- | Convert a file path to text.
  write_file_path :: File_path -> FilePath
  write_file_path :: File_path -> [Char]
write_file_path (File_path (Directory [Back]
back [[Char]]
directories) [Char]
file_name [Char]
ext) =
    [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"/" ((Back -> [Char]
write_back (Back -> [Char]) -> [Back] -> [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Back]
back) [[Char]] -> [[Char]] -> [[Char]]
forall a. Semigroup a => a -> a -> a
<> [[Char]]
directories [[Char]] -> [[Char]] -> [[Char]]
forall a. Semigroup a => a -> a -> a
<> [[Char]
file_name [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"." [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
ext])