-- | Notebook location
module Emanote.Source.Loc (
  -- * Type
  Loc (..),

  -- * Making a `Loc`
  defaultLayer,
  userLayers,

  -- * Using a `Loc`
  locResolve,
  locPath,

  -- * Dealing with layers of locs
  LocLayers,
  primaryLayer,
) where

import Data.Set qualified as Set
import Relude
import System.FilePath ((</>))

{- | Location of the notebook

 The order here matters. Top = higher precedence.
-}
data Loc
  = -- | The Int argument specifies the precedence (lower value = higher precedence)
    LocUser Int FilePath
  | -- | The default location (ie., emanote default layer)
    LocDefault FilePath
  deriving stock (Loc -> Loc -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Loc -> Loc -> Bool
$c/= :: Loc -> Loc -> Bool
== :: Loc -> Loc -> Bool
$c== :: Loc -> Loc -> Bool
Eq, Eq Loc
Loc -> Loc -> Bool
Loc -> Loc -> Ordering
Loc -> Loc -> Loc
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
min :: Loc -> Loc -> Loc
$cmin :: Loc -> Loc -> Loc
max :: Loc -> Loc -> Loc
$cmax :: Loc -> Loc -> Loc
>= :: Loc -> Loc -> Bool
$c>= :: Loc -> Loc -> Bool
> :: Loc -> Loc -> Bool
$c> :: Loc -> Loc -> Bool
<= :: Loc -> Loc -> Bool
$c<= :: Loc -> Loc -> Bool
< :: Loc -> Loc -> Bool
$c< :: Loc -> Loc -> Bool
compare :: Loc -> Loc -> Ordering
$ccompare :: Loc -> Loc -> Ordering
Ord, Int -> Loc -> ShowS
[Loc] -> ShowS
Loc -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Loc] -> ShowS
$cshowList :: [Loc] -> ShowS
show :: Loc -> FilePath
$cshow :: Loc -> FilePath
showsPrec :: Int -> Loc -> ShowS
$cshowsPrec :: Int -> Loc -> ShowS
Show)

type LocLayers = Set Loc

{- | Return the "primary" `LocUser` layer (that which are not overrides).

 Assumes that the user has put it always by last; i.e, `-L foo;primary/layer`.
-}
primaryLayer :: HasCallStack => LocLayers -> Loc
primaryLayer :: HasCallStack => Set Loc -> Loc
primaryLayer =
  forall a. Set a -> a
Set.findMax forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> Set a -> Set a
Set.filter Loc -> Bool
isUserLayer
  where
    isUserLayer :: Loc -> Bool
isUserLayer = \case
      LocUser Int
_ FilePath
_ -> Bool
True
      Loc
_ -> Bool
False

defaultLayer :: FilePath -> Loc
defaultLayer :: FilePath -> Loc
defaultLayer = FilePath -> Loc
LocDefault

userLayers :: NonEmpty FilePath -> Set Loc
userLayers :: NonEmpty FilePath -> Set Loc
userLayers NonEmpty FilePath
paths =
  forall l. IsList l => [Item l] -> l
fromList forall a b. (a -> b) -> a -> b
$
    forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1 ..] (forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList NonEmpty FilePath
paths) forall (f :: Type -> Type) a b. Functor f => f a -> (a -> b) -> f b
<&> forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> FilePath -> Loc
LocUser

-- | Return the effective path of a file.
locResolve :: (Loc, FilePath) -> FilePath
locResolve :: (Loc, FilePath) -> FilePath
locResolve (Loc
loc, FilePath
fp) = Loc -> FilePath
locPath Loc
loc FilePath -> ShowS
</> FilePath
fp

locPath :: Loc -> FilePath
locPath :: Loc -> FilePath
locPath = \case
  LocUser Int
_ FilePath
fp -> FilePath
fp
  LocDefault FilePath
fp -> FilePath
fp