{-# language CPP #-}
{-# language GeneralizedNewtypeDeriving #-}

-- | This is a module of custom "Prelude" code.
-- It is for import for projects other then @HNix@.
-- For @HNix@ - this module gets reexported by "Prelude", so for @HNix@ please fix-up pass-through there.
module Nix.Utils
  ( stub
  , pass
  , dup
  , both
  , mapPair
  , iterateN
  , nestM
  , applyAll
  , traverse2
  , lifted

  , whenTrue
  , whenFalse
  , whenJust
  , whenText
  , list
  , free

  , Path(..)
  , isAbsolute
  , (</>)
  , joinPath
  , splitDirectories
  , takeDirectory
  , takeFileName
  , takeBaseName
  , takeExtension
  , takeExtensions
  , addExtension
  , dropExtensions
  , replaceExtension
  , readFile

  , Alg
  , Transform
  , TransformF
  , loebM
  , adi

  , Has(..)
  , askLocal

  , KeyMap

  , trace
  , traceM
  , module X
  )
 where

import           Relude                  hiding ( pass
                                                , force
                                                , readFile
                                                , whenJust
                                                , whenNothing
                                                , trace
                                                , traceM
                                                )

import           Data.Binary                    ( Binary )
import           Data.Data                      ( Data )
import           Codec.Serialise                ( Serialise )
import           Control.Monad.Fix              ( MonadFix(..) )
import           Control.Monad.Free             ( Free(..) )
import           Control.Monad.Trans.Control    ( MonadTransControl(..) )
import qualified Data.Aeson                    as A
import           Data.Fix                       ( Fix(..) )
import qualified Data.Text                     as Text
import qualified Data.Text.IO                 as Text
import           Lens.Family2                  as X
                                                ( view
                                                , over
                                                , LensLike'
                                                , Lens'
                                                )
import           Lens.Family2.Stock             ( _1
                                                , _2
                                                )
import qualified System.FilePath              as FilePath
import Control.Monad.List (foldM)

#if ENABLE_TRACING
import qualified Relude.Debug                 as X
#else
-- Well, since it is currently CPP intermingled with Debug.Trace, required to use String here.
trace :: String -> a -> a
trace :: String -> a -> a
trace = (a -> a) -> String -> a -> a
forall a b. a -> b -> a
const a -> a
forall a. a -> a
id
{-# inline trace #-}
traceM :: Monad m => String -> m ()
traceM :: String -> m ()
traceM = m () -> String -> m ()
forall a b. a -> b -> a
const m ()
forall (f :: * -> *) a. (Applicative f, Monoid a) => f a
stub
{-# inline traceM #-}
#endif

-- * Helpers

-- After migration from the @relude@ - @relude: pass -> stub@
-- | @pure mempty@: Short-curcuit, stub.
stub :: (Applicative f, Monoid a) => f a
stub :: f a
stub = a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Monoid a => a
mempty
{-# inline stub #-}

-- | Alias for 'stub', since "Relude" has more specialized @pure ()@.
pass :: (Applicative f) => f ()
pass :: f ()
pass = f ()
forall (f :: * -> *) a. (Applicative f, Monoid a) => f a
stub
{-# inline pass #-}

-- | Duplicates object into a tuple.
dup :: a -> (a, a)
dup :: a -> (a, a)
dup a
x = (a
x, a
x)
{-# inline dup #-}

-- | Apply a single function to both components of a pair.
--
-- > both succ (1,2) == (2,3)
--
-- Taken From package @extra@
both :: (a -> b) -> (a, a) -> (b, b)
both :: (a -> b) -> (a, a) -> (b, b)
both a -> b
f (a
x,a
y) = (a -> b
f a
x, a -> b
f a
y)
{-# inline both #-}

-- | Gives tuple laziness.
--
-- Takem from @utility-ht@.
mapPair :: (a -> c, b -> d) -> (a,b) -> (c,d)
mapPair :: (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair ~(a -> c
f,b -> d
g) ~(a
a,b
b) = (a -> c
f a
a, b -> d
g b
b)
{-# inline mapPair #-}

iterateN
  :: forall a
   . Int -- ^ Recursively apply 'Int' times
  -> (a -> a) -- ^ the function
  -> a -- ^ starting from argument
  -> a
iterateN :: Int -> (a -> a) -> a -> a
iterateN Int
n a -> a
f a
x =
  -- It is hard to read - yes. It is a non-recursive momoized action - yes.
  ((Int -> a) -> Int -> a) -> Int -> a
forall a. (a -> a) -> a
fix (((Int -> Bool -> a) -> (Int -> Bool) -> Int -> a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int
0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/=)) ((Int -> Bool -> a) -> Int -> a)
-> ((Int -> a) -> Int -> Bool -> a) -> (Int -> a) -> Int -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a -> a -> Bool -> a
forall a. a -> a -> Bool -> a
bool a
x (a -> Bool -> a) -> (a -> a) -> a -> Bool -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
f) (a -> Bool -> a) -> (Int -> a) -> Int -> Bool -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Int -> a) -> Int -> Bool -> a)
-> ((Int -> a) -> Int -> a) -> (Int -> a) -> Int -> Bool -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int -> a) -> (Int -> Int) -> Int -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Enum a => a -> a
pred)) Int
n

nestM
  :: Monad m
  => Int -- ^ Recursively apply 'Int' times
  -> (a -> m a) -- ^ function (Kleisli arrow).
  -> a -- ^ to value
  -> m a -- ^ & join layers of 'm'
nestM :: Int -> (a -> m a) -> a -> m a
nestM Int
0 a -> m a
_ a
x = a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
nestM Int
n a -> m a
f a
x =
  (a -> () -> m a) -> a -> [()] -> m a
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (m a -> () -> m a
forall a b. a -> b -> a
const (m a -> () -> m a) -> (a -> m a) -> a -> () -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m a
f) a
x ([()] -> m a) -> [()] -> m a
forall a b. (a -> b) -> a -> b
$ Int -> () -> [()]
forall a. Int -> a -> [a]
replicate @() Int
n ()
forall a. Monoid a => a
mempty -- fuses. But also, can it be fix join?
{-# inline nestM #-}

-- | In `foldr` order apply functions.
applyAll :: Foldable t => t (a -> a) -> a -> a
applyAll :: t (a -> a) -> a -> a
applyAll = (a -> t (a -> a) -> a) -> t (a -> a) -> a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (((a -> a) -> a -> a) -> a -> t (a -> a) -> a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (a -> a) -> a -> a
forall a. a -> a
id)

traverse2
  :: ( Applicative m
     , Applicative n
     , Traversable t
     )
  => ( a
     -> m (n b)
     ) -- ^ Run function that runs 2 'Applicative' actions
  -> t a -- ^ on every element in 'Traversable'
  -> m (n (t b)) -- ^ collect the results.
traverse2 :: (a -> m (n b)) -> t a -> m (n (t b))
traverse2 a -> m (n b)
f t a
x = t (n b) -> n (t b)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA (t (n b) -> n (t b)) -> m (t (n b)) -> m (n (t b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> m (n b)) -> t a -> m (t (n b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> m (n b)
f t a
x

--  2021-08-21: NOTE: Someone needs to put in normal words, what this does.
-- This function is pretty spefic & used only once, in "Nix.Normal".
lifted
  :: (MonadTransControl u, Monad (u m), Monad m)
  => ((a -> m (StT u b)) -> m (StT u b))
  -> (a -> u m b)
  -> u m b
lifted :: ((a -> m (StT u b)) -> m (StT u b)) -> (a -> u m b) -> u m b
lifted (a -> m (StT u b)) -> m (StT u b)
f a -> u m b
k =
  m (StT u b) -> u m b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT t a) -> t m a
restoreT (m (StT u b) -> u m b)
-> (StT u b -> m (StT u b)) -> StT u b -> u m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StT u b -> m (StT u b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StT u b -> u m b) -> u m (StT u b) -> u m b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Run u -> m (StT u b)) -> u m (StT u b)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith (\Run u
run -> (a -> m (StT u b)) -> m (StT u b)
f (u m b -> m (StT u b)
Run u
run (u m b -> m (StT u b)) -> (a -> u m b) -> a -> m (StT u b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> u m b
k))


-- * Eliminators

whenTrue :: (Monoid a)
  => a -> Bool -> a
whenTrue :: a -> Bool -> a
whenTrue =
  a -> a -> Bool -> a
forall a. a -> a -> Bool -> a
bool
    a
forall a. Monoid a => a
mempty
{-# inline whenTrue #-}

whenFalse :: (Monoid a)
  => a  -> Bool  -> a
whenFalse :: a -> Bool -> a
whenFalse a
f =
  a -> a -> Bool -> a
forall a. a -> a -> Bool -> a
bool
    a
f
    a
forall a. Monoid a => a
mempty
{-# inline whenFalse #-}

whenJust
  :: Monoid b
  => (a -> b)
  -> Maybe a
  -> b
whenJust :: (a -> b) -> Maybe a -> b
whenJust =
  b -> (a -> b) -> Maybe a -> b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    b
forall a. Monoid a => a
mempty
{-# inline whenJust #-}

-- | Analog for @bool@ or @maybe@, for list-like cons structures.
list
  :: Foldable t
  => b -> (t a -> b) -> t a -> b
list :: b -> (t a -> b) -> t a -> b
list b
e t a -> b
f t a
l =
  b -> b -> Bool -> b
forall a. a -> a -> Bool -> a
bool
    (t a -> b
f t a
l)
    b
e
    (t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t a
l)
{-# inline list #-}

whenText
  :: a -> (Text -> a) -> Text -> a
whenText :: a -> (Text -> a) -> Text -> a
whenText a
e Text -> a
f Text
t =
  a -> a -> Bool -> a
forall a. a -> a -> Bool -> a
bool
    (Text -> a
f Text
t)
    a
e
    (Text -> Bool
Text.null Text
t)

-- | Lambda analog of @maybe@ or @either@ for Free monad.
free :: (a -> b) -> (f (Free f a) -> b) -> Free f a -> b
free :: (a -> b) -> (f (Free f a) -> b) -> Free f a -> b
free a -> b
fP f (Free f a) -> b
fF Free f a
fr =
  case Free f a
fr of
    Pure a
a -> a -> b
fP a
a
    Free f (Free f a)
fa -> f (Free f a) -> b
fF f (Free f a)
fa
{-# inline free #-}


-- * Path

-- | Explicit type boundary between FilePath & String.
newtype Path = Path FilePath
  deriving
    ( Path -> Path -> Bool
(Path -> Path -> Bool) -> (Path -> Path -> Bool) -> Eq Path
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Path -> Path -> Bool
$c/= :: Path -> Path -> Bool
== :: Path -> Path -> Bool
$c== :: Path -> Path -> Bool
Eq, Eq Path
Eq Path
-> (Path -> Path -> Ordering)
-> (Path -> Path -> Bool)
-> (Path -> Path -> Bool)
-> (Path -> Path -> Bool)
-> (Path -> Path -> Bool)
-> (Path -> Path -> Path)
-> (Path -> Path -> Path)
-> Ord Path
Path -> Path -> Bool
Path -> Path -> Ordering
Path -> Path -> Path
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 :: Path -> Path -> Path
$cmin :: Path -> Path -> Path
max :: Path -> Path -> Path
$cmax :: Path -> Path -> Path
>= :: Path -> Path -> Bool
$c>= :: Path -> Path -> Bool
> :: Path -> Path -> Bool
$c> :: Path -> Path -> Bool
<= :: Path -> Path -> Bool
$c<= :: Path -> Path -> Bool
< :: Path -> Path -> Bool
$c< :: Path -> Path -> Bool
compare :: Path -> Path -> Ordering
$ccompare :: Path -> Path -> Ordering
$cp1Ord :: Eq Path
Ord, (forall x. Path -> Rep Path x)
-> (forall x. Rep Path x -> Path) -> Generic Path
forall x. Rep Path x -> Path
forall x. Path -> Rep Path x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Path x -> Path
$cfrom :: forall x. Path -> Rep Path x
Generic
    , Typeable, Typeable Path
DataType
Constr
Typeable Path
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Path -> c Path)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Path)
-> (Path -> Constr)
-> (Path -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Path))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Path))
-> ((forall b. Data b => b -> b) -> Path -> Path)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Path -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Path -> r)
-> (forall u. (forall d. Data d => d -> u) -> Path -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Path -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Path -> m Path)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Path -> m Path)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Path -> m Path)
-> Data Path
Path -> DataType
Path -> Constr
(forall b. Data b => b -> b) -> Path -> Path
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Path -> c Path
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Path
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Path -> u
forall u. (forall d. Data d => d -> u) -> Path -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Path -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Path -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Path -> m Path
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Path -> m Path
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Path
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Path -> c Path
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Path)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Path)
$cPath :: Constr
$tPath :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Path -> m Path
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Path -> m Path
gmapMp :: (forall d. Data d => d -> m d) -> Path -> m Path
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Path -> m Path
gmapM :: (forall d. Data d => d -> m d) -> Path -> m Path
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Path -> m Path
gmapQi :: Int -> (forall d. Data d => d -> u) -> Path -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Path -> u
gmapQ :: (forall d. Data d => d -> u) -> Path -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Path -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Path -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Path -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Path -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Path -> r
gmapT :: (forall b. Data b => b -> b) -> Path -> Path
$cgmapT :: (forall b. Data b => b -> b) -> Path -> Path
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Path)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Path)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Path)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Path)
dataTypeOf :: Path -> DataType
$cdataTypeOf :: Path -> DataType
toConstr :: Path -> Constr
$ctoConstr :: Path -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Path
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Path
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Path -> c Path
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Path -> c Path
$cp1Data :: Typeable Path
Data, Path -> ()
(Path -> ()) -> NFData Path
forall a. (a -> ()) -> NFData a
rnf :: Path -> ()
$crnf :: Path -> ()
NFData, Decoder s Path
Decoder s [Path]
[Path] -> Encoding
Path -> Encoding
(Path -> Encoding)
-> (forall s. Decoder s Path)
-> ([Path] -> Encoding)
-> (forall s. Decoder s [Path])
-> Serialise Path
forall s. Decoder s [Path]
forall s. Decoder s Path
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
decodeList :: Decoder s [Path]
$cdecodeList :: forall s. Decoder s [Path]
encodeList :: [Path] -> Encoding
$cencodeList :: [Path] -> Encoding
decode :: Decoder s Path
$cdecode :: forall s. Decoder s Path
encode :: Path -> Encoding
$cencode :: Path -> Encoding
Serialise, Get Path
[Path] -> Put
Path -> Put
(Path -> Put) -> Get Path -> ([Path] -> Put) -> Binary Path
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [Path] -> Put
$cputList :: [Path] -> Put
get :: Get Path
$cget :: Get Path
put :: Path -> Put
$cput :: Path -> Put
Binary, [Path] -> Encoding
[Path] -> Value
Path -> Encoding
Path -> Value
(Path -> Value)
-> (Path -> Encoding)
-> ([Path] -> Value)
-> ([Path] -> Encoding)
-> ToJSON Path
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Path] -> Encoding
$ctoEncodingList :: [Path] -> Encoding
toJSONList :: [Path] -> Value
$ctoJSONList :: [Path] -> Value
toEncoding :: Path -> Encoding
$ctoEncoding :: Path -> Encoding
toJSON :: Path -> Value
$ctoJSON :: Path -> Value
A.ToJSON, Value -> Parser [Path]
Value -> Parser Path
(Value -> Parser Path) -> (Value -> Parser [Path]) -> FromJSON Path
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Path]
$cparseJSONList :: Value -> Parser [Path]
parseJSON :: Value -> Parser Path
$cparseJSON :: Value -> Parser Path
A.FromJSON
    , Int -> Path -> ShowS
[Path] -> ShowS
Path -> String
(Int -> Path -> ShowS)
-> (Path -> String) -> ([Path] -> ShowS) -> Show Path
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Path] -> ShowS
$cshowList :: [Path] -> ShowS
show :: Path -> String
$cshow :: Path -> String
showsPrec :: Int -> Path -> ShowS
$cshowsPrec :: Int -> Path -> ShowS
Show, ReadPrec [Path]
ReadPrec Path
Int -> ReadS Path
ReadS [Path]
(Int -> ReadS Path)
-> ReadS [Path] -> ReadPrec Path -> ReadPrec [Path] -> Read Path
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Path]
$creadListPrec :: ReadPrec [Path]
readPrec :: ReadPrec Path
$creadPrec :: ReadPrec Path
readList :: ReadS [Path]
$creadList :: ReadS [Path]
readsPrec :: Int -> ReadS Path
$creadsPrec :: Int -> ReadS Path
Read, Int -> Path -> Int
Path -> Int
(Int -> Path -> Int) -> (Path -> Int) -> Hashable Path
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Path -> Int
$chash :: Path -> Int
hashWithSalt :: Int -> Path -> Int
$chashWithSalt :: Int -> Path -> Int
Hashable
    , b -> Path -> Path
NonEmpty Path -> Path
Path -> Path -> Path
(Path -> Path -> Path)
-> (NonEmpty Path -> Path)
-> (forall b. Integral b => b -> Path -> Path)
-> Semigroup Path
forall b. Integral b => b -> Path -> Path
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> Path -> Path
$cstimes :: forall b. Integral b => b -> Path -> Path
sconcat :: NonEmpty Path -> Path
$csconcat :: NonEmpty Path -> Path
<> :: Path -> Path -> Path
$c<> :: Path -> Path -> Path
Semigroup, Semigroup Path
Path
Semigroup Path
-> Path
-> (Path -> Path -> Path)
-> ([Path] -> Path)
-> Monoid Path
[Path] -> Path
Path -> Path -> Path
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Path] -> Path
$cmconcat :: [Path] -> Path
mappend :: Path -> Path -> Path
$cmappend :: Path -> Path -> Path
mempty :: Path
$cmempty :: Path
$cp1Monoid :: Semigroup Path
Monoid
    )

instance ToText Path where
  toText :: Path -> Text
toText = ToText String => String -> Text
forall a. ToText a => a -> Text
toText @String (String -> Text) -> (Path -> String) -> Path -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> String
coerce

instance IsString Path where
  fromString :: String -> Path
fromString = String -> Path
coerce

-- ** Path functions

-- | This set of @Path@ funcs is to control system filepath types & typesafety and to easily migrate from FilePath to anything suitable (like @path@ or so).

-- | 'Path's 'FilePath.isAbsolute'.
isAbsolute :: Path -> Bool
isAbsolute :: Path -> Bool
isAbsolute = (String -> Bool) -> Path -> Bool
coerce String -> Bool
FilePath.isAbsolute

-- | 'Path's 'FilePath.(</>)'.
(</>) :: Path -> Path -> Path
</> :: Path -> Path -> Path
(</>) = (String -> ShowS) -> Path -> Path -> Path
coerce String -> ShowS
(FilePath.</>)
infixr 5 </>

-- | 'Path's 'FilePath.joinPath'.
joinPath :: [Path] -> Path
joinPath :: [Path] -> Path
joinPath = ([String] -> String) -> [Path] -> Path
coerce [String] -> String
FilePath.joinPath

-- | 'Path's 'FilePath.splitDirectories'.
splitDirectories :: Path -> [Path]
splitDirectories :: Path -> [Path]
splitDirectories = (String -> [String]) -> Path -> [Path]
coerce String -> [String]
FilePath.splitDirectories

-- | 'Path's 'FilePath.takeDirectory'.
takeDirectory :: Path -> Path
takeDirectory :: Path -> Path
takeDirectory = ShowS -> Path -> Path
coerce ShowS
FilePath.takeDirectory

-- | 'Path's 'FilePath.takeFileName'.
takeFileName :: Path -> Path
takeFileName :: Path -> Path
takeFileName = ShowS -> Path -> Path
coerce ShowS
FilePath.takeFileName

-- | 'Path's 'FilePath.takeBaseName'.
takeBaseName :: Path -> String
takeBaseName :: Path -> String
takeBaseName = ShowS -> Path -> String
coerce ShowS
FilePath.takeBaseName

-- | 'Path's 'FilePath.takeExtension'.
takeExtension :: Path -> String
takeExtension :: Path -> String
takeExtension = ShowS -> Path -> String
coerce ShowS
FilePath.takeExtensions

-- | 'Path's 'FilePath.takeExtensions'.
takeExtensions :: Path -> String
takeExtensions :: Path -> String
takeExtensions = ShowS -> Path -> String
coerce ShowS
FilePath.takeExtensions

-- | 'Path's 'FilePath.addExtensions'.
addExtension :: Path -> String -> Path
addExtension :: Path -> String -> Path
addExtension = (String -> ShowS) -> Path -> String -> Path
coerce String -> ShowS
FilePath.addExtension

-- | 'Path's 'FilePath.dropExtensions'.
dropExtensions :: Path -> Path
dropExtensions :: Path -> Path
dropExtensions = ShowS -> Path -> Path
coerce ShowS
FilePath.dropExtensions

-- | 'Path's 'FilePath.replaceExtension'.
replaceExtension :: Path -> String -> Path
replaceExtension :: Path -> String -> Path
replaceExtension = (String -> ShowS) -> Path -> String -> Path
coerce String -> ShowS
FilePath.replaceExtension

-- | 'Path's 'FilePath.readFile'.
readFile :: Path -> IO Text
readFile :: Path -> IO Text
readFile = String -> IO Text
Text.readFile (String -> IO Text) -> (Path -> String) -> Path -> IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> String
coerce


-- * Recursion scheme

-- | F-algebra defines how to reduce the fixed-point of a functor to a value.
-- > type Alg f a = f a -> a
type Alg f a = f a -> a

-- | Do according transformation.
--
-- It is a transformation of a recursion scheme.
-- See @TransformF@.
type Transform f a = TransformF (Fix f) a
-- | Do according transformation.
--
-- It is a transformation between functors.
type TransformF f a = (f -> a) -> f -> a

loebM :: (MonadFix m, Traversable t) => t (t a -> m a) -> m (t a)
loebM :: t (t a -> m a) -> m (t a)
loebM t (t a -> m a)
f = (t a -> m (t a)) -> m (t a)
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix ((t a -> m (t a)) -> m (t a)) -> (t a -> m (t a)) -> m (t a)
forall a b. (a -> b) -> a -> b
$ \t a
a -> (((t a -> m a) -> m a) -> t (t a -> m a) -> m (t a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
`traverse` t (t a -> m a)
f) ((t a -> m a) -> t a -> m a
forall a b. (a -> b) -> a -> b
$ t a
a)
{-# inline loebM #-}

-- | adi is Abstracting Definitional Interpreters:
--
--     https://arxiv.org/abs/1707.04755
--
--   All ADI does is interleaves every layer of evaluation by inserting intermitten layers between them, in that way the evaluation can be extended/embelished in any way wanted. Look at its use to see great examples.
--
--   Essentially, it does for evaluation what recursion schemes do for
--   representation: allows threading layers through existing structure, only
--   in this case through behavior.
adi
  :: Functor f
  => Transform f a
  -> Alg f a
  -> Fix f
  -> a
adi :: Transform f a -> Alg f a -> Fix f -> a
adi Transform f a
g Alg f a
f = Transform f a
g Transform f a -> Transform f a
forall a b. (a -> b) -> a -> b
$ Alg f a
f Alg f a -> (Fix f -> f a) -> Fix f -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Transform f a -> Alg f a -> Fix f -> a
forall (f :: * -> *) a.
Functor f =>
Transform f a -> Alg f a -> Fix f -> a
adi Transform f a
g Alg f a
f (Fix f -> a) -> f (Fix f) -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (f (Fix f) -> f a) -> (Fix f -> f (Fix f)) -> Fix f -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fix f -> f (Fix f)
forall (f :: * -> *). Fix f -> f (Fix f)
unFix


-- * Has lens

class Has a b where
  hasLens :: Lens' a b

instance Has a a where
  hasLens :: LensLike' f a a
hasLens a -> f a
f = a -> f a
f

instance Has (a, b) a where
  hasLens :: LensLike' f (a, b) a
hasLens = LensLike' f (a, b) a
forall a r b. Lens (a, r) (b, r) a b
_1

instance Has (a, b) b where
  hasLens :: LensLike' f (a, b) b
hasLens = LensLike' f (a, b) b
forall r a b. Lens (r, a) (r, b) a b
_2

-- | Retrive monad state by 'Lens''.
askLocal :: (MonadReader t m, Has t a) => m a
askLocal :: m a
askLocal = (t -> a) -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((t -> a) -> m a) -> (t -> a) -> m a
forall a b. (a -> b) -> a -> b
$ FoldLike a t t a a -> t -> a
forall a s t b. FoldLike a s t a b -> s -> a
view FoldLike a t t a a
forall a b. Has a b => Lens' a b
hasLens

-- * Other

-- | > Hashmap Text -- type synonym
type KeyMap = HashMap Text