{-# 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
  , isPresent
  , handlePresence
  , whenText
  , 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                  ( foldM )
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           Lens.Family2                  as X
                                                ( view
                                                , over
                                                , LensLike'
                                                , Lens'
                                                )
import           Lens.Family2.Stock             ( _1
                                                , _2
                                                )
import qualified System.FilePath              as FilePath

#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 :: forall a. FilePath -> a -> a
trace = forall a b. a -> b -> a
const forall a. a -> a
id
{-# inline trace #-}
traceM :: Monad m => String -> m ()
traceM :: forall (m :: * -> *). Monad m => FilePath -> m ()
traceM = forall a b. a -> b -> a
const 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 :: forall (f :: * -> *) a. (Applicative f, Monoid a) => f a
stub = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
{-# inline stub #-}

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

-- | Duplicates object into a tuple.
dup :: a -> (a, a)
dup :: forall a. 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 :: forall a b. (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 :: forall a c b d. (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 :: forall a. 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.
  forall a. (a -> a) -> a
fix ((forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int
0 forall a. Eq a => a -> a -> Bool
/=)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((forall a. a -> a -> Bool -> a
bool a
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall (m :: * -> *) a. Monad m => Int -> (a -> m a) -> a -> m a
nestM Int
0 a -> m a
_ a
x = forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
nestM Int
n a -> m a
f a
x =
  forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m a
f) a
x forall a b. (a -> b) -> a -> b
$ 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 :: forall (t :: * -> *) a. Foldable t => t (a -> a) -> a -> a
applyAll = forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr 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 :: forall (m :: * -> *) (n :: * -> *) (t :: * -> *) a b.
(Applicative m, Applicative n, Traversable t) =>
(a -> m (n b)) -> t a -> m (n (t b))
traverse2 a -> m (n b)
f t a
x = forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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 :: forall (u :: (* -> *) -> * -> *) (m :: * -> *) a b.
(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)
f a -> u m b
k =
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT t a) -> t m a
restoreT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m 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 (Run u
run forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> u m b
k))


-- * Eliminators

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

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

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

isPresent :: Foldable t => t a -> Bool
isPresent :: forall (t :: * -> *) a. Foldable t => t a -> Bool
isPresent = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null
{-# inline isPresent #-}


-- | 'maybe'-like eliminator, for foldable empty/inhabited structures.
handlePresence :: Foldable t => b -> (t a -> b) -> t a -> b
handlePresence :: forall (t :: * -> *) b a. Foldable t => b -> (t a -> b) -> t a -> b
handlePresence b
d t a -> b
f t a
t =
  forall a. a -> a -> Bool -> a
bool
    b
d
    (t a -> b
f t a
t)
    (forall (t :: * -> *) a. Foldable t => t a -> Bool
isPresent t a
t)
{-# inline handlePresence #-}

whenText
  :: a -> (Text -> a) -> Text -> a
whenText :: forall a. a -> (Text -> a) -> Text -> a
whenText a
e Text -> a
f Text
t =
  forall a. a -> a -> Bool -> a
bool
    a
e
    (Text -> a
f Text
t)
    (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ 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 :: forall a b (f :: * -> *).
(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
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
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
Ord, 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
Path -> DataType
Path -> Constr
(forall b. Data b => b -> b) -> Path -> 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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u. Int -> (forall d. Data d => d -> u) -> Path -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Path -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Path -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Path -> [u]
gmapQr :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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
Data, Path -> ()
forall a. (a -> ()) -> NFData a
rnf :: Path -> ()
$crnf :: Path -> ()
NFData, [Path] -> Encoding
Path -> Encoding
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 :: forall s. Decoder s [Path]
$cdecodeList :: forall s. Decoder s [Path]
encodeList :: [Path] -> Encoding
$cencodeList :: [Path] -> Encoding
decode :: forall s. Decoder s Path
$cdecode :: forall s. Decoder s Path
encode :: Path -> Encoding
$cencode :: Path -> Encoding
Serialise, Get Path
[Path] -> Put
Path -> Put
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
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
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 -> FilePath -> FilePath
[Path] -> FilePath -> FilePath
Path -> FilePath
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [Path] -> FilePath -> FilePath
$cshowList :: [Path] -> FilePath -> FilePath
show :: Path -> FilePath
$cshow :: Path -> FilePath
showsPrec :: Int -> Path -> FilePath -> FilePath
$cshowsPrec :: Int -> Path -> FilePath -> FilePath
Show, ReadPrec [Path]
ReadPrec Path
Int -> ReadS Path
ReadS [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, Eq Path
Int -> Path -> Int
Path -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Path -> Int
$chash :: Path -> Int
hashWithSalt :: Int -> Path -> Int
$chashWithSalt :: Int -> Path -> Int
Hashable
    , NonEmpty Path -> Path
Path -> Path -> 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 :: forall b. Integral b => 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
[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
Monoid
    )

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

instance IsString Path where
  fromString :: FilePath -> Path
fromString = coerce :: forall a b. Coercible a b => a -> b
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 = coerce :: forall a b. Coercible a b => a -> b
coerce FilePath -> Bool
FilePath.isAbsolute

-- | 'Path's 'FilePath.(</>)'.
(</>) :: Path -> Path -> Path
</> :: Path -> Path -> Path
(</>) = coerce :: forall a b. Coercible a b => a -> b
coerce FilePath -> FilePath -> FilePath
(FilePath.</>)
infixr 5 </>

-- | 'Path's 'FilePath.joinPath'.
joinPath :: [Path] -> Path
joinPath :: [Path] -> Path
joinPath = coerce :: forall a b. Coercible a b => a -> b
coerce [FilePath] -> FilePath
FilePath.joinPath

-- | 'Path's 'FilePath.splitDirectories'.
splitDirectories :: Path -> [Path]
splitDirectories :: Path -> [Path]
splitDirectories = coerce :: forall a b. Coercible a b => a -> b
coerce FilePath -> [FilePath]
FilePath.splitDirectories

-- | 'Path's 'FilePath.takeDirectory'.
takeDirectory :: Path -> Path
takeDirectory :: Path -> Path
takeDirectory = coerce :: forall a b. Coercible a b => a -> b
coerce FilePath -> FilePath
FilePath.takeDirectory

-- | 'Path's 'FilePath.takeFileName'.
takeFileName :: Path -> Path
takeFileName :: Path -> Path
takeFileName = coerce :: forall a b. Coercible a b => a -> b
coerce FilePath -> FilePath
FilePath.takeFileName

-- | 'Path's 'FilePath.takeBaseName'.
takeBaseName :: Path -> String
takeBaseName :: Path -> FilePath
takeBaseName = coerce :: forall a b. Coercible a b => a -> b
coerce FilePath -> FilePath
FilePath.takeBaseName

-- | 'Path's 'FilePath.takeExtension'.
takeExtension :: Path -> String
takeExtension :: Path -> FilePath
takeExtension = coerce :: forall a b. Coercible a b => a -> b
coerce FilePath -> FilePath
FilePath.takeExtensions

-- | 'Path's 'FilePath.takeExtensions'.
takeExtensions :: Path -> String
takeExtensions :: Path -> FilePath
takeExtensions = coerce :: forall a b. Coercible a b => a -> b
coerce FilePath -> FilePath
FilePath.takeExtensions

-- | 'Path's 'FilePath.addExtensions'.
addExtension :: Path -> String -> Path
addExtension :: Path -> FilePath -> Path
addExtension = coerce :: forall a b. Coercible a b => a -> b
coerce FilePath -> FilePath -> FilePath
FilePath.addExtension

-- | 'Path's 'FilePath.dropExtensions'.
dropExtensions :: Path -> Path
dropExtensions :: Path -> Path
dropExtensions = coerce :: forall a b. Coercible a b => a -> b
coerce FilePath -> FilePath
FilePath.dropExtensions

-- | 'Path's 'FilePath.replaceExtension'.
replaceExtension :: Path -> String -> Path
replaceExtension :: Path -> FilePath -> Path
replaceExtension = coerce :: forall a b. Coercible a b => a -> b
coerce FilePath -> FilePath -> FilePath
FilePath.replaceExtension

-- | 'Path's 'FilePath.readFile'.
readFile :: MonadIO m => Path -> m Text
readFile :: forall (m :: * -> *). MonadIO m => Path -> m Text
readFile = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadIO m => FilePath -> m ByteString
readFileBS forall b c a. (b -> c) -> (a -> b) -> a -> c
. coerce :: forall a b. Coercible a b => a -> b
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 :: forall (m :: * -> *) (t :: * -> *) a.
(MonadFix m, Traversable t) =>
t (t a -> m a) -> m (t a)
loebM t (t a -> m a)
f = forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix forall a b. (a -> b) -> a -> b
$ \t a
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) (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 :: forall (f :: * -> *) a.
Functor f =>
Transform f a -> Alg f a -> Fix f -> a
adi Transform f a
g Alg f a
f = Transform f a
g forall a b. (a -> b) -> a -> b
$ Alg f a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (f :: * -> *) a.
Functor f =>
Transform f a -> Alg f a -> Fix f -> a
adi Transform f a
g Alg f a
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: Lens' a a
hasLens a -> f a
f = a -> f a
f

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

instance Has (a, b) b where
  hasLens :: Lens' (a, b) b
hasLens = 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 :: forall t (m :: * -> *) a. (MonadReader t m, Has t a) => m a
askLocal = forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall a b. (a -> b) -> a -> b
$ forall a s t b. FoldLike a s t a b -> s -> a
view forall a b. Has a b => Lens' a b
hasLens

-- * Other

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