-- | 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
(Loc -> Loc -> Bool) -> (Loc -> Loc -> Bool) -> Eq Loc
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
Eq Loc
-> (Loc -> Loc -> Ordering)
-> (Loc -> Loc -> Bool)
-> (Loc -> Loc -> Bool)
-> (Loc -> Loc -> Bool)
-> (Loc -> Loc -> Bool)
-> (Loc -> Loc -> Loc)
-> (Loc -> Loc -> Loc)
-> Ord 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
(Int -> Loc -> ShowS)
-> (Loc -> FilePath) -> ([Loc] -> ShowS) -> Show Loc
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 =
  Set Loc -> Loc
forall a. Set a -> a
Set.findMax (Set Loc -> Loc) -> (Set Loc -> Set Loc) -> Set Loc -> Loc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Loc -> Bool) -> Set Loc -> Set Loc
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 =
  [Item (Set Loc)] -> Set Loc
forall l. IsList l => [Item l] -> l
fromList ([Item (Set Loc)] -> Set Loc) -> [Item (Set Loc)] -> Set Loc
forall a b. (a -> b) -> a -> b
$
    [Int] -> [FilePath] -> [(Int, FilePath)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1 ..] (NonEmpty FilePath -> [FilePath]
forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList NonEmpty FilePath
paths) [(Int, FilePath)] -> ((Int, FilePath) -> Loc) -> [Loc]
forall (f :: Type -> Type) a b. Functor f => f a -> (a -> b) -> f b
<&> (Int -> FilePath -> Loc) -> (Int, FilePath) -> Loc
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