template-haskell 2.18.0.0 → 2.19.0.0

raw patch · 11 files changed

+2659/−129 lines, 11 filesdep +filepathdep ~basedep ~ghc-boot-thPVP ok

version bump matches the API change (PVP)

Dependencies added: filepath

Dependency ranges changed: base, ghc-boot-th

API changes (from Hackage documentation)

Files

• Language/Haskell/TH.hs +1/−0
• Language/Haskell/TH/CodeDo.hs +2/−0
• Language/Haskell/TH/Lib.hs +9/−6
• Language/Haskell/TH/Lib/Internal.hs +23/−1
• Language/Haskell/TH/Ppr.hs +125/−72
• Language/Haskell/TH/Syntax.hs +217/−43
• changelog.md +16/−4
• template-haskell.cabal +23/−3
• vendored-filepath/System/FilePath.hs +149/−0
• vendored-filepath/System/FilePath/Posix.hs +1047/−0
• vendored-filepath/System/FilePath/Windows.hs +1047/−0

@@ -22,6 +22,7 @@         -- *** Reify         reify,            -- :: Name -> Q Info         reifyModule,+        newDeclarationGroup,         Info(..), ModuleInfo(..),         InstanceDec,         ParentName,

@@ -1,7 +1,9 @@ -- | This module exists to work nicely with the QualifiedDo -- extension.+-- -- @ -- import qualified Language.Haskell.TH.CodeDo as Code+-- -- myExample :: Monad m => Code m a -> Code m a -> Code m a -- myExample opt1 opt2 = --   Code.do

@@ -42,9 +42,9 @@     -- *** Expressions         dyn, varE, unboundVarE, labelE, implicitParamVarE, conE, litE, staticE,         appE, appTypeE, uInfixE, parensE, infixE, infixApp, sectionL, sectionR,-        lamE, lam1E, lamCaseE, tupE, unboxedTupE, unboxedSumE, condE, multiIfE,-        letE, caseE, appsE, listE, sigE, recConE, recUpdE, stringE, fieldExp,-        getFieldE, projectionE,+        lamE, lam1E, lamCaseE, lamCasesE, tupE, unboxedTupE, unboxedSumE, condE,+        multiIfE, letE, caseE, appsE, listE, sigE, recConE, recUpdE, stringE,+        fieldExp, getFieldE, projectionE,     -- **** Ranges     fromE, fromThenE, fromToE, fromThenToE, @@ -56,9 +56,9 @@     bindS, letS, noBindS, parS, recS,      -- *** Types-        forallT, forallVisT, varT, conT, appT, appKindT, arrowT, infixT,-        mulArrowT,-        uInfixT, parensT, equalityT, listT, tupleT, unboxedTupleT, unboxedSumT,+        forallT, forallVisT, varT, conT, appT, appKindT, arrowT, mulArrowT,+        infixT, uInfixT, promotedInfixT, promotedUInfixT,+        parensT, equalityT, listT, tupleT, unboxedTupleT, unboxedSumT,         sigT, litT, wildCardT, promotedT, promotedTupleT, promotedNilT,         promotedConsT, implicitParamT,     -- **** Type literals@@ -103,6 +103,9 @@      -- **** Fixity     infixLD, infixRD, infixND,++    -- **** Default declaration+    defaultD,      -- **** Foreign Function Interface (FFI)     cCall, stdCall, cApi, prim, javaScript,

@@ -31,7 +31,7 @@ -- * Type synonyms ---------------------------------------------------------- --- | Levity-polymorphic since /template-haskell-2.17.0.0/.+-- | Representation-polymorphic since /template-haskell-2.17.0.0/. type TExpQ :: TYPE r -> Kind.Type type TExpQ a = Q (TExp a) @@ -300,9 +300,14 @@ lam1E :: Quote m => m Pat -> m Exp -> m Exp lam1E p e = lamE [p] e +-- | Lambda-case (@\case@) lamCaseE :: Quote m => [m Match] -> m Exp lamCaseE ms = LamCaseE <$> sequenceA ms +-- | Lambda-cases (@\cases@)+lamCasesE :: Quote m => [m Clause] -> m Exp+lamCasesE ms = LamCasesE <$> sequenceA ms+ tupE :: Quote m => [Maybe (m Exp)] -> m Exp tupE es = do { es1 <- traverse sequenceA es; pure (TupE es1)} @@ -477,10 +482,16 @@ infixND :: Quote m => Int -> Name -> m Dec infixND prec nm = pure (InfixD (Fixity prec InfixN) nm) +defaultD :: Quote m => [m Type] -> m Dec+defaultD tys = DefaultD <$> sequenceA tys+ pragInlD :: Quote m => Name -> Inline -> RuleMatch -> Phases -> m Dec pragInlD name inline rm phases   = pure $ PragmaD $ InlineP name inline rm phases +pragOpaqueD :: Quote m => Name -> m Dec+pragOpaqueD name = pure $ PragmaD $ OpaqueP name+ pragSpecD :: Quote m => Name -> m Type -> Phases -> m Dec pragSpecD n ty phases   = do@@ -695,6 +706,16 @@                      t2' <- t2                      pure (UInfixT t1' n t2') +promotedInfixT :: Quote m => m Type -> Name -> m Type -> m Type+promotedInfixT t1 n t2 = do t1' <- t1+                            t2' <- t2+                            pure (PromotedInfixT t1' n t2')++promotedUInfixT :: Quote m => m Type -> Name -> m Type -> m Type+promotedUInfixT t1 n t2 = do t1' <- t1+                             t2' <- t2+                             pure (PromotedUInfixT t1' n t2')+ parensT :: Quote m => m Type -> m Type parensT t = do t' <- t                pure (ParensT t')@@ -1039,6 +1060,7 @@     doc_loc (StandaloneDerivD _ _ _) = Nothing     doc_loc (DefaultSigD _ _)        = Nothing     doc_loc (ImplicitParamBindD _ _) = Nothing+    doc_loc (DefaultD _)             = Nothing  -- | Variant of 'withDecDoc' that applies the same documentation to -- multiple declarations. Useful for documenting quoted declarations.

@@ -1,4 +1,5 @@ {-# LANGUAGE Safe #-}+{-# LANGUAGE LambdaCase #-} -- | contains a prettyprinter for the -- Template Haskell datatypes @@ -94,10 +95,10 @@ pprPatSynType ty@(ForallT uniTys reqs ty'@(ForallT exTys provs ty''))   | null exTys,  null provs = ppr (ForallT uniTys reqs ty'')   | null uniTys, null reqs  = noreqs <+> ppr ty'-  | null reqs               = forall uniTys <+> noreqs <+> ppr ty'+  | null reqs               = pprForallBndrs uniTys <+> noreqs <+> ppr ty'   | otherwise               = ppr ty-  where noreqs     = text "() =>"-        forall tvs = text "forall" <+> (hsep (map ppr tvs)) <+> text "."+  where noreqs = text "() =>"+        pprForallBndrs tvs = text "forall" <+> hsep (map ppr tvs) <+> text "." pprPatSynType ty            = ppr ty  ------------------------------@@ -153,8 +154,11 @@ pprExp i (LamE [] e) = pprExp i e -- #13856 pprExp i (LamE ps e) = parensIf (i > noPrec) $ char '\\' <> hsep (map (pprPat appPrec) ps)                                            <+> text "->" <+> ppr e-pprExp i (LamCaseE ms) = parensIf (i > noPrec)-                       $ text "\\case" $$ nest nestDepth (ppr ms)+pprExp i (LamCaseE ms)+  = parensIf (i > noPrec) $ text "\\case" $$ braces (semiSep ms)+pprExp i (LamCasesE ms)+  = parensIf (i > noPrec) $ text "\\cases" $$ braces (semi_sep ms)+  where semi_sep = sep . punctuate semi . map (pprClause False) pprExp i (TupE es)   | [Just e] <- es   = pprExp i (ConE (tupleDataName 1) `AppE` e)@@ -182,7 +186,7 @@  pprExp i (CaseE e ms)  = parensIf (i > noPrec) $ text "case" <+> ppr e <+> text "of"-                        $$ nest nestDepth (ppr ms)+                        $$ braces (semiSep ms) pprExp i (DoE m ss_) = parensIf (i > noPrec) $     pprQualifier m <> text "do" <+> pprStms ss_   where@@ -269,6 +273,12 @@               | otherwise = arrow  ------------------------------+pprClause :: Bool -> Clause -> Doc+pprClause eqDoc (Clause ps rhs ds)+  = hsep (map (pprPat appPrec) ps) <+> pprBody eqDoc rhs+    $$ where_clause ds++------------------------------ instance Ppr Lit where   ppr = pprLit noPrec @@ -286,9 +296,42 @@ pprLit _ (StringL s)     = pprString s pprLit _ (StringPrimL s) = pprString (bytesToString s) <> char '#' pprLit _ (BytesPrimL {}) = pprString "<binary data>"-pprLit i (RationalL rat) = parensIf (i > noPrec) $-                           integer (numerator rat) <+> char '/'-                              <+> integer (denominator rat)+pprLit i (RationalL rat)+  | withoutFactor 2 (withoutFactor 5 $ denominator rat) /= 1+  -- if the denominator has prime factors other than 2 and 5, show as fraction+  = parensIf (i > noPrec) $+    integer (numerator rat) <+> char '/' <+> integer (denominator rat)+  | rat /= 0 && (zeroes < -1 || zeroes > 7),+    let (n, d) = properFraction (rat' / magnitude)+        (rat', zeroes')+          | abs rat < 1 = (10 * rat, zeroes - 1)+          | otherwise = (rat, zeroes)+  -- if < 0.01 or >= 100_000_000, use scientific notation+  = parensIf (i > noPrec && rat < 0)+             (integer n+              <> (if d == 0 then empty else char '.' <> decimals (abs d))+              <> char 'e' <> integer zeroes')+  | let (n, d) = properFraction rat+  = parensIf (i > noPrec && rat < 0)+             (integer n <> char '.'+              <> if d == 0 then char '0' else decimals (abs d))+  where zeroes :: Integer+        zeroes = truncate (logBase 10 (abs (fromRational rat) :: Double)+                           * (1 - epsilon))+        epsilon = 0.0000001+        magnitude :: Rational+        magnitude = 10 ^^ zeroes+        withoutFactor :: Integer -> Integer -> Integer+        withoutFactor _ 0 = 0+        withoutFactor p n+          | (n', 0) <- divMod n p = withoutFactor p n'+          | otherwise = n+        -- | Expects the argument 0 <= x < 1+        decimals :: Rational -> Doc+        decimals x+          | x == 0 = empty+          | otherwise = integer n <> decimals d+          where (n, d) = properFraction (x * 10)  bytesToString :: [Word8] -> String bytesToString = map (chr . fromIntegral)@@ -364,6 +407,8 @@ ppr_dec _ (KiSigD f k)  = text "type" <+> pprPrefixOcc f <+> dcolon <+> ppr k ppr_dec _ (ForeignD f)  = ppr f ppr_dec _ (InfixD fx n) = pprFixity n fx+ppr_dec _ (DefaultD tys) =+        text "default" <+> parens (sep $ punctuate comma $ map ppr tys) ppr_dec _ (PragmaD p)   = ppr p ppr_dec isTop (DataFamilyD tc tvs kind)   = text "data" <+> maybeFamily <+> ppr tc <+> hsep (map ppr tvs) <+> maybeKind@@ -442,14 +487,21 @@  ppr_data :: Doc -> Cxt -> Maybe Name -> Doc -> Maybe Kind -> [Con] -> [DerivClause]          -> Doc-ppr_data maybeInst ctxt t argsDoc ksig cs decs-  = sep [text "data" <+> maybeInst+ppr_data = ppr_typedef "data"++ppr_newtype :: Doc -> Cxt -> Maybe Name -> Doc -> Maybe Kind -> Con -> [DerivClause]+            -> Doc+ppr_newtype maybeInst ctxt t argsDoc ksig c decs = ppr_typedef "newtype" maybeInst ctxt t argsDoc ksig [c] decs++ppr_typedef :: String -> Doc -> Cxt -> Maybe Name -> Doc -> Maybe Kind -> [Con] -> [DerivClause] -> Doc+ppr_typedef data_or_newtype maybeInst ctxt t argsDoc ksig cs decs+  = sep [text data_or_newtype <+> maybeInst             <+> pprCxt ctxt             <+> case t of                  Just n -> pprName' Applied n <+> argsDoc                  Nothing -> argsDoc             <+> ksigDoc <+> maybeWhere,-         nest nestDepth (sep (pref $ map ppr cs)),+         nest nestDepth (vcat (pref $ map ppr cs)),          if null decs            then empty            else nest nestDepth@@ -475,24 +527,6 @@                 Nothing -> empty                 Just k  -> dcolon <+> ppr k -ppr_newtype :: Doc -> Cxt -> Maybe Name -> Doc -> Maybe Kind -> Con -> [DerivClause]-            -> Doc-ppr_newtype maybeInst ctxt t argsDoc ksig c decs-  = sep [text "newtype" <+> maybeInst-            <+> pprCxt ctxt-            <+> case t of-                 Just n -> ppr n <+> argsDoc-                 Nothing -> argsDoc-            <+> ksigDoc,-         nest 2 (char '=' <+> ppr c),-         if null decs-           then empty-           else nest nestDepth-                $ vcat $ map ppr_deriv_clause decs]-  where-    ksigDoc = case ksig of-                Nothing -> empty-                Just k  -> dcolon <+> ppr k  ppr_deriv_clause :: DerivClause -> Doc ppr_deriv_clause (DerivClause ds ctxt)@@ -568,6 +602,8 @@      <+> ppr phases      <+> pprName' Applied n      <+> text "#-}"+    ppr (OpaqueP n)+       = text "{-# OPAQUE" <+> pprName' Applied n <+> text "#-}"     ppr (SpecialiseP n ty inline phases)        =   text "{-# SPECIALISE"        <+> maybe empty ppr inline@@ -625,8 +661,7 @@  ------------------------------ instance Ppr Clause where-    ppr (Clause ps rhs ds) = hsep (map (pprPat appPrec) ps) <+> pprBody True rhs-                             $$ where_clause ds+    ppr = pprClause True  ------------------------------ instance Ppr Con where@@ -758,44 +793,52 @@  ------------------------------ pprParendType :: Type -> Doc-pprParendType (VarT v)            = pprName' Applied v+pprParendType (VarT v)               = pprName' Applied v -- `Applied` is used here instead of `ppr` because of infix names (#13887)-pprParendType (ConT c)            = pprName' Applied c-pprParendType (TupleT 0)          = text "()"-pprParendType (TupleT 1)          = pprParendType (ConT (tupleTypeName 1))-pprParendType (TupleT n)          = parens (hcat (replicate (n-1) comma))-pprParendType (UnboxedTupleT n)   = hashParens $ hcat $ replicate (n-1) comma-pprParendType (UnboxedSumT arity) = hashParens $ hcat $ replicate (arity-1) bar-pprParendType ArrowT              = parens (text "->")-pprParendType MulArrowT           = text "FUN"-pprParendType ListT               = text "[]"-pprParendType (LitT l)            = pprTyLit l-pprParendType (PromotedT c)       = text "'" <> pprName' Applied c-pprParendType (PromotedTupleT 0)  = text "'()"-pprParendType (PromotedTupleT 1)  = pprParendType (PromotedT (tupleDataName 1))-pprParendType (PromotedTupleT n)  = quoteParens (hcat (replicate (n-1) comma))-pprParendType PromotedNilT        = text "'[]"-pprParendType PromotedConsT       = text "'(:)"-pprParendType StarT               = char '*'-pprParendType ConstraintT         = text "Constraint"-pprParendType (SigT ty k)         = parens (ppr ty <+> text "::" <+> ppr k)-pprParendType WildCardT           = char '_'-pprParendType (InfixT x n y)      = parens (ppr x <+> pprName' Infix n <+> ppr y)-pprParendType t@(UInfixT {})      = parens (pprUInfixT t)-pprParendType (ParensT t)         = ppr t+pprParendType (ConT c)               = pprName' Applied c+pprParendType (TupleT 0)             = text "()"+pprParendType (TupleT 1)             = pprParendType (ConT (tupleTypeName 1))+pprParendType (TupleT n)             = parens (hcat (replicate (n-1) comma))+pprParendType (UnboxedTupleT n)      = hashParens $ hcat $ replicate (n-1) comma+pprParendType (UnboxedSumT arity)    = hashParens $ hcat $ replicate (arity-1) bar+pprParendType ArrowT                 = parens (text "->")+pprParendType MulArrowT              = text "FUN"+pprParendType ListT                  = text "[]"+pprParendType (LitT l)               = pprTyLit l+pprParendType (PromotedT c)          = text "'" <> pprName' Applied c+pprParendType (PromotedTupleT 0)     = text "'()"+pprParendType (PromotedTupleT 1)     = pprParendType (PromotedT (tupleDataName 1))+pprParendType (PromotedTupleT n)     = quoteParens (hcat (replicate (n-1) comma))+pprParendType PromotedNilT           = text "'[]"+pprParendType PromotedConsT          = text "'(:)"+pprParendType StarT                  = char '*'+pprParendType ConstraintT            = text "Constraint"+pprParendType (SigT ty k)            = parens (ppr ty <+> text "::" <+> ppr k)+pprParendType WildCardT              = char '_'+pprParendType t@(InfixT {})          = parens (pprInfixT t)+pprParendType t@(UInfixT {})         = parens (pprInfixT t)+pprParendType t@(PromotedInfixT {})  = parens (pprInfixT t)+pprParendType t@(PromotedUInfixT {}) = parens (pprInfixT t)+pprParendType (ParensT t)            = ppr t pprParendType tuple | (TupleT n, args) <- split tuple                     , length args == n                     = parens (commaSep args)-pprParendType (ImplicitParamT n t)= text ('?':n) <+> text "::" <+> ppr t-pprParendType EqualityT           = text "(~)"-pprParendType t@(ForallT {})      = parens (ppr t)-pprParendType t@(ForallVisT {})   = parens (ppr t)-pprParendType t@(AppT {})         = parens (ppr t)-pprParendType t@(AppKindT {})     = parens (ppr t)+pprParendType (ImplicitParamT n t)   = text ('?':n) <+> text "::" <+> ppr t+pprParendType EqualityT              = text "(~)"+pprParendType t@(ForallT {})         = parens (ppr t)+pprParendType t@(ForallVisT {})      = parens (ppr t)+pprParendType t@(AppT {})            = parens (ppr t)+pprParendType t@(AppKindT {})        = parens (ppr t) -pprUInfixT :: Type -> Doc-pprUInfixT (UInfixT x n y) = pprUInfixT x <+> pprName' Infix n <+> pprUInfixT y-pprUInfixT t               = ppr t+pprInfixT :: Type -> Doc+pprInfixT = \case+  (InfixT x n y)          -> with x n y ""  ppr+  (UInfixT x n y)         -> with x n y ""  pprInfixT+  (PromotedInfixT x n y)  -> with x n y "'" ppr+  (PromotedUInfixT x n y) -> with x n y "'" pprInfixT+  t                       -> ppr t+  where+    with x n y prefix ppr' = ppr' x <+> text prefix <> pprName' Infix n <+> ppr' y  instance Ppr Type where     ppr (ForallT tvars ctxt ty) = sep [pprForall tvars ctxt, ppr ty]@@ -916,18 +959,18 @@ instance Ppr Range where     ppr = brackets . pprRange         where pprRange :: Range -> Doc-              pprRange (FromR e) = ppr e <> text ".."+              pprRange (FromR e) = ppr e <+> text ".."               pprRange (FromThenR e1 e2) = ppr e1 <> text ","-                                        <> ppr e2 <> text ".."-              pprRange (FromToR e1 e2) = ppr e1 <> text ".." <> ppr e2+                                           <+> ppr e2 <+> text ".."+              pprRange (FromToR e1 e2) = ppr e1 <+> text ".." <+> ppr e2               pprRange (FromThenToR e1 e2 e3) = ppr e1 <> text ","-                                             <> ppr e2 <> text ".."-                                             <> ppr e3+                                             <+> ppr e2 <+> text ".."+                                             <+> ppr e3  ------------------------------ where_clause :: [Dec] -> Doc where_clause [] = empty-where_clause ds = nest nestDepth $ text "where" <+> vcat (map (ppr_dec False) ds)+where_clause ds = nest nestDepth $ text "where" <+> braces (semiSepWith (ppr_dec False) ds)  showtextl :: Show a => a -> Doc showtextl = text . map toLower . show@@ -949,6 +992,11 @@            , text "-"            , parens $ int end_ln <> comma <> int end_col ] +-- Takes a separator and a pretty-printing function and prints a list of things+-- separated by the separator followed by space.+sepWith :: Doc -> (a -> Doc) -> [a] -> Doc+sepWith sepDoc pprFun = sep . punctuate sepDoc . map pprFun+ -- Takes a list of printable things and prints them separated by commas followed -- by space. commaSep :: Ppr a => [a] -> Doc@@ -957,12 +1005,17 @@ -- Takes a list of things and prints them with the given pretty-printing -- function, separated by commas followed by space. commaSepWith :: (a -> Doc) -> [a] -> Doc-commaSepWith pprFun = sep . punctuate comma . map pprFun+commaSepWith pprFun = sepWith comma pprFun  -- Takes a list of printable things and prints them separated by semicolons -- followed by space. semiSep :: Ppr a => [a] -> Doc semiSep = sep . punctuate semi . map ppr++-- Takes a list of things and prints them with the given pretty-printing+-- function, separated by semicolons followed by space.+semiSepWith :: (a -> Doc) -> [a] -> Doc+semiSepWith pprFun = sepWith semi pprFun  -- Prints out the series of vertical bars that wraps an expression or pattern -- used in an unboxed sum.

@@ -2,8 +2,8 @@              DeriveGeneric, FlexibleInstances, DefaultSignatures,              RankNTypes, RoleAnnotations, ScopedTypeVariables,              MagicHash, KindSignatures, PolyKinds, TypeApplications, DataKinds,-             GADTs, UnboxedTuples, UnboxedSums, TypeInType,-             Trustworthy, DeriveFunctor #-}+             GADTs, UnboxedTuples, UnboxedSums, TypeInType, TypeOperators,+             Trustworthy, DeriveFunctor, BangPatterns, RecordWildCards, ImplicitParams #-}  {-# OPTIONS_GHC -fno-warn-inline-rule-shadowing #-} @@ -31,6 +31,7 @@ import Data.Data hiding (Fixity(..)) import Data.IORef import System.IO.Unsafe ( unsafePerformIO )+import System.FilePath import GHC.IO.Unsafe    ( unsafeDupableInterleaveIO ) import Control.Monad (liftM) import Control.Monad.IO.Class (MonadIO (..))@@ -60,11 +61,22 @@ import Foreign.ForeignPtr import Foreign.C.String import Foreign.C.Types+import GHC.Stack  #if __GLASGOW_HASKELL__ >= 901 import GHC.Types ( Levity(..) ) #endif +#if __GLASGOW_HASKELL__ >= 903+import Data.Array.Byte (ByteArray(..))+import GHC.Exts+  ( ByteArray#, unsafeFreezeByteArray#, copyAddrToByteArray#, newByteArray#+  , isByteArrayPinned#, isTrue#, sizeofByteArray#, unsafeCoerce#, byteArrayContents#+  , copyByteArray#, newPinnedByteArray#)+import GHC.ForeignPtr (ForeignPtr(..), ForeignPtrContents(..))+import GHC.ST (ST(..), runST)+#endif+ ----------------------------------------------------- -- --              The Quasi class@@ -103,6 +115,7 @@   qRunIO :: IO a -> m a   qRunIO = liftIO   -- ^ Input/output (dangerous)+  qGetPackageRoot :: m FilePath    qAddDependentFile :: FilePath -> m () @@ -154,6 +167,7 @@   qReifyConStrictness _ = badIO "reifyConStrictness"   qLocation             = badIO "currentLocation"   qRecover _ _          = badIO "recover" -- Maybe we could fix this?+  qGetPackageRoot       = badIO "getProjectRoot"   qAddDependentFile _   = badIO "addDependentFile"   qAddTempFile _        = badIO "addTempFile"   qAddTopDecls _        = badIO "addTopDecls"@@ -351,12 +365,12 @@ --       In the expression: [|| "foo" ||] --       In the Template Haskell splice $$([|| "foo" ||]) ----- Levity-polymorphic since /template-haskell-2.16.0.0/.+-- Representation-polymorphic since /template-haskell-2.16.0.0/.  -- | Discard the type annotation and produce a plain Template Haskell -- expression ----- Levity-polymorphic since /template-haskell-2.16.0.0/.+-- Representation-polymorphic since /template-haskell-2.16.0.0/. unTypeQ :: forall (r :: RuntimeRep) (a :: TYPE r) m . Quote m => m (TExp a) -> m Exp unTypeQ m = do { TExp e <- m                ; return e }@@ -366,7 +380,7 @@ -- This is unsafe because GHC cannot check for you that the expression -- really does have the type you claim it has. ----- Levity-polymorphic since /template-haskell-2.16.0.0/.+-- Representation-polymorphic since /template-haskell-2.16.0.0/. unsafeTExpCoerce :: forall (r :: RuntimeRep) (a :: TYPE r) m .                       Quote m => m Exp -> m (TExp a) unsafeTExpCoerce m = do { e <- m@@ -532,7 +546,10 @@ -}  -{- | 'reify' looks up information about the 'Name'.+{- | 'reify' looks up information about the 'Name'. It will fail with+a compile error if the 'Name' is not visible. A 'Name' is visible if it is+imported or defined in a prior top-level declaration group. See the+documentation for 'newDeclarationGroup' for more details.  It is sometimes useful to construct the argument name using 'lookupTypeName' or 'lookupValueName' to ensure that we are reifying from the right namespace. For instance, in this context:@@ -568,6 +585,60 @@ reifyType :: Name -> Q Type reifyType nm = Q (qReifyType nm) +{- | Template Haskell is capable of reifying information about types and+terms defined in previous declaration groups. Top-level declaration splices break up+declaration groups.++For an example, consider this  code block. We define a datatype @X@ and+then try to call 'reify' on the datatype.++@+module Check where++data X = X+    deriving Eq++$(do+    info <- reify ''X+    runIO $ print info+ )+@++This code fails to compile, noting that @X@ is not available for reification at the site of 'reify'. We can fix this by creating a new declaration group using an empty top-level splice:++@+data X = X+    deriving Eq++$(pure [])++$(do+    info <- reify ''X+    runIO $ print info+ )+@++We provide 'newDeclarationGroup' as a means of documenting this behavior+and providing a name for the pattern.++Since top level splices infer the presence of the @$( ... )@ brackets, we can also write:++@+data X = X+    deriving Eq++newDeclarationGroup++$(do+    info <- reify ''X+    runIO $ print info+ )+@++-}+newDeclarationGroup :: Q [Dec]+newDeclarationGroup = pure []+ {- | @reifyInstances nm tys@ returns a list of visible instances of @nm tys@. That is, if @nm@ is the name of a type class, then all instances of this class at the types @tys@ are returned. Alternatively, if @nm@ is the name of a data family or type family,@@ -585,13 +656,29 @@  There is one edge case: @reifyInstances ''Typeable tys@ currently always produces an empty list (no matter what @tys@ are given).++An instance is visible if it is imported or defined in a prior top-level+declaration group. See the documentation for 'newDeclarationGroup' for more details.+ -} reifyInstances :: Name -> [Type] -> Q [InstanceDec] reifyInstances cls tys = Q (qReifyInstances cls tys) -{- | @reifyRoles nm@ returns the list of roles associated with the parameters of+{- | @reifyRoles nm@ returns the list of roles associated with the parameters+(both visible and invisible) of the tycon @nm@. Fails if @nm@ cannot be found or is not a tycon. The returned list should never contain 'InferR'.++An invisible parameter to a tycon is often a kind parameter. For example, if+we have++@+type Proxy :: forall k. k -> Type+data Proxy a = MkProxy+@++and @reifyRoles Proxy@, we will get @['NominalR', 'PhantomR']@. The 'NominalR' is+the role of the invisible @k@ parameter. Kind parameters are always nominal. -} reifyRoles :: Name -> Q [Role] reifyRoles nm = Q (qReifyRoles nm)@@ -625,6 +712,10 @@ reifyConStrictness n = Q (qReifyConStrictness n)  -- | Is the list of instances returned by 'reifyInstances' nonempty?+--+-- If you're confused by an instance not being visible despite being+-- defined in the same module and above the splice in question, see the+-- docs for 'newDeclarationGroup' for a possible explanation. isInstance :: Name -> [Type] -> Q Bool isInstance nm tys = do { decs <- reifyInstances nm tys                        ; return (not (null decs)) }@@ -643,6 +734,27 @@ runIO :: IO a -> Q a runIO m = Q (qRunIO m) +-- | Get the package root for the current package which is being compiled.+-- This can be set explicitly with the -package-root flag but is normally+-- just the current working directory.+--+-- The motivation for this flag is to provide a principled means to remove the+-- assumption from splices that they will be executed in the directory where the+-- cabal file resides. Projects such as haskell-language-server can't and don't+-- change directory when compiling files but instead set the -package-root flag+-- appropiately.+getPackageRoot :: Q FilePath+getPackageRoot = Q qGetPackageRoot++-- | The input is a filepath, which if relative is offset by the package root.+makeRelativeToProject :: FilePath -> Q FilePath+makeRelativeToProject fp | isRelative fp = do+  root <- getPackageRoot+  return (root </> fp)+makeRelativeToProject fp = return fp+++ -- | Record external files that runIO is using (dependent upon). -- The compiler can then recognize that it should re-compile the Haskell file -- when an external file changes.@@ -793,6 +905,7 @@   qReifyConStrictness = reifyConStrictness   qLookupName         = lookupName   qLocation           = location+  qGetPackageRoot     = getPackageRoot   qAddDependentFile   = addDependentFile   qAddTempFile        = addTempFile   qAddTopDecls        = addTopDecls@@ -848,7 +961,7 @@ -- > data Bar a = Bar1 a (Bar a) | Bar2 String -- >   deriving Lift ----- Levity-polymorphic since /template-haskell-2.16.0.0/.+-- Representation-polymorphic since /template-haskell-2.16.0.0/. class Lift (t :: TYPE r) where   -- | Turn a value into a Template Haskell expression, suitable for use in   -- a splice.@@ -972,6 +1085,51 @@   lift x     = return (LitE (StringPrimL (map (fromIntegral . ord) (unpackCString# x)))) +#if __GLASGOW_HASKELL__ >= 903++-- |+-- @since 2.19.0.0+instance Lift ByteArray where+  liftTyped x = unsafeCodeCoerce (lift x)+  lift (ByteArray b) = return+    (AppE (AppE (VarE addrToByteArrayName) (LitE (IntegerL (fromIntegral len))))+      (LitE (BytesPrimL (Bytes ptr 0 (fromIntegral len)))))+    where+      len# = sizeofByteArray# b+      len = I# len#+      pb :: ByteArray#+      !(ByteArray pb)+        | isTrue# (isByteArrayPinned# b) = ByteArray b+        | otherwise = runST $ ST $+          \s -> case newPinnedByteArray# len# s of+            (# s', mb #) -> case copyByteArray# b 0# mb 0# len# s' of+              s'' -> case unsafeFreezeByteArray# mb s'' of+                (# s''', ret #) -> (# s''', ByteArray ret #)+      ptr :: ForeignPtr Word8+      ptr = ForeignPtr (byteArrayContents# pb) (PlainPtr (unsafeCoerce# pb))+++-- We can't use a TH quote in this module because we're in the template-haskell+-- package, so we conconct this quite defensive solution to make the correct name+-- which will work if the package name or module name changes in future.+addrToByteArrayName :: Name+addrToByteArrayName = helper+  where+    helper :: HasCallStack => Name+    helper =+      case head (getCallStack ?callStack) of+        (_, SrcLoc{..}) -> mkNameG_v srcLocPackage srcLocModule "addrToByteArray"+++addrToByteArray :: Int -> Addr# -> ByteArray+addrToByteArray (I# len) addr = runST $ ST $+  \s -> case newByteArray# len s of+    (# s', mb #) -> case copyAddrToByteArray# addr mb 0# len s' of+      s'' -> case unsafeFreezeByteArray# mb s'' of+        (# s''', ret #) -> (# s''', ByteArray ret #)++#endif+ instance Lift a => Lift (Maybe a) where   liftTyped x = unsafeCodeCoerce (lift x) @@ -1921,9 +2079,10 @@ @+@ and @*@, we don't know whether to parse it as @a + (b * c)@ or @(a + b) * c@. -In cases like this, use 'UInfixE', 'UInfixP', or 'UInfixT', which stand for-\"unresolved infix expression/pattern/type\", respectively. When the compiler-is given a splice containing a tree of @UInfixE@ applications such as+In cases like this, use 'UInfixE', 'UInfixP', 'UInfixT', or 'PromotedUInfixT',+which stand for \"unresolved infix expression/pattern/type/promoted+constructor\", respectively. When the compiler is given a splice containing a+tree of @UInfixE@ applications such as  > UInfixE >   (UInfixE e1 op1 e2)@@ -1938,7 +2097,8 @@      > (a + b * c) + d * e -  * 'InfixE', 'InfixP', and 'InfixT' expressions are never reassociated.+  * 'InfixE', 'InfixP', 'InfixT', and 'PromotedInfixT' expressions are never+    reassociated.    * The 'UInfixE' constructor doesn't support sections. Sections     such as @(a *)@ have no ambiguity, so 'InfixE' suffices. For longer@@ -1965,8 +2125,8 @@     > [p| a : b : c |] :: Q Pat     > [t| T + T |] :: Q Type -    will never contain 'UInfixE', 'UInfixP', 'UInfixT', 'InfixT', 'ParensE',-    'ParensP', or 'ParensT' constructors.+    will never contain 'UInfixE', 'UInfixP', 'UInfixT', 'PromotedUInfixT',+    'InfixT', 'PromotedInfixT, 'ParensE', 'ParensP', or 'ParensT' constructors.  -} @@ -2004,6 +2164,7 @@    { bytesPtr    :: ForeignPtr Word8 -- ^ Pointer to the data    , bytesOffset :: Word             -- ^ Offset from the pointer    , bytesSize   :: Word             -- ^ Number of bytes+    -- Maybe someday:    -- , bytesAlignement  :: Word -- ^ Alignement constraint    -- , bytesReadOnly    :: Bool -- ^ Shall we embed into a read-only@@ -2081,6 +2242,7 @@  data Match = Match Pat Body [Dec] -- ^ @case e of { pat -> body where decs }@     deriving( Show, Eq, Ord, Data, Generic )+ data Clause = Clause [Pat] Body [Dec]                                   -- ^ @f { p1 p2 = body where decs }@     deriving( Show, Eq, Ord, Data, Generic )@@ -2112,6 +2274,7 @@                                        -- See "Language.Haskell.TH.Syntax#infix"   | LamE [Pat] Exp                     -- ^ @{ \\ p1 p2 -> e }@   | LamCaseE [Match]                   -- ^ @{ \\case m1; m2 }@+  | LamCasesE [Clause]                 -- ^ @{ \\cases m1; m2 }@   | TupE [Maybe Exp]                   -- ^ @{ (e1,e2) }  @                                        --                                        -- The 'Maybe' is necessary for handling@@ -2226,6 +2389,7 @@                                   --{ foreign export ... }@    | InfixD Fixity Name            -- ^ @{ infix 3 foo }@+  | DefaultD [Type]               -- ^ @{ default (Integer, Double) }@    -- | pragmas   | PragmaD Pragma                -- ^ @{ {\-\# INLINE [1] foo \#-\} }@@@ -2285,7 +2449,7 @@ data Overlap = Overlappable   -- ^ May be overlapped by more specific instances              | Overlapping    -- ^ May overlap a more general instance              | Overlaps       -- ^ Both 'Overlapping' and 'Overlappable'-             | Incoherent     -- ^ Both 'Overlappable' and 'Overlappable', and+             | Incoherent     -- ^ Both 'Overlapping' and 'Overlappable', and                               -- pick an arbitrary one if multiple choices are                               -- available.   deriving( Show, Eq, Ord, Data, Generic )@@ -2393,6 +2557,7 @@         deriving( Show, Eq, Ord, Data, Generic )  data Pragma = InlineP         Name Inline RuleMatch Phases+            | OpaqueP         Name             | SpecialiseP     Name Type (Maybe Inline) Phases             | SpecialiseInstP Type             | RuleP           String (Maybe [TyVarBndr ()]) [RuleBndr] Exp Exp Phases@@ -2481,6 +2646,10 @@ --   @ -- --   In @MkBar@, 'ForallC' will quantify @a@, @b@, and @c@.+--+-- Multiplicity annotations for data types are currently not supported+-- in Template Haskell (i.e. all fields represented by Template Haskell+-- will be linear). data Con = NormalC Name [BangType]       -- ^ @C Int a@          | RecC Name [VarBangType]       -- ^ @C { v :: Int, w :: a }@          | InfixC BangType Name BangType -- ^ @Int :+ a@@@ -2495,7 +2664,6 @@  -- Note [GADT return type] -- ~~~~~~~~~~~~~~~~~~~~~~~--- -- The return type of a GADT constructor does not necessarily match the name of -- the data type: --@@ -2554,35 +2722,41 @@   deriving( Show, Eq, Ord, Data, Generic )  data Type = ForallT [TyVarBndr Specificity] Cxt Type -- ^ @forall \<vars\>. \<ctxt\> => \<type\>@-          | ForallVisT [TyVarBndr ()] Type  -- ^ @forall \<vars\> -> \<type\>@-          | AppT Type Type                -- ^ @T a b@-          | AppKindT Type Kind            -- ^ @T \@k t@-          | SigT Type Kind                -- ^ @t :: k@-          | VarT Name                     -- ^ @a@-          | ConT Name                     -- ^ @T@-          | PromotedT Name                -- ^ @'T@-          | InfixT Type Name Type         -- ^ @T + T@-          | UInfixT Type Name Type        -- ^ @T + T@-                                          ---                                          -- See "Language.Haskell.TH.Syntax#infix"-          | ParensT Type                  -- ^ @(T)@+          | ForallVisT [TyVarBndr ()] Type -- ^ @forall \<vars\> -> \<type\>@+          | AppT Type Type                 -- ^ @T a b@+          | AppKindT Type Kind             -- ^ @T \@k t@+          | SigT Type Kind                 -- ^ @t :: k@+          | VarT Name                      -- ^ @a@+          | ConT Name                      -- ^ @T@+          | PromotedT Name                 -- ^ @'T@+          | InfixT Type Name Type          -- ^ @T + T@+          | UInfixT Type Name Type         -- ^ @T + T@+                                           --+                                           -- See "Language.Haskell.TH.Syntax#infix"+          | PromotedInfixT Type Name Type  -- ^ @T :+: T@+          | PromotedUInfixT Type Name Type -- ^ @T :+: T@+                                           --+                                           -- See "Language.Haskell.TH.Syntax#infix"+          | ParensT Type                   -- ^ @(T)@            -- See Note [Representing concrete syntax in types]-          | TupleT Int                    -- ^ @(,), (,,), etc.@-          | UnboxedTupleT Int             -- ^ @(\#,\#), (\#,,\#), etc.@-          | UnboxedSumT SumArity          -- ^ @(\#|\#), (\#||\#), etc.@-          | ArrowT                        -- ^ @->@-          | MulArrowT                     -- ^ @FUN@-          | EqualityT                     -- ^ @~@-          | ListT                         -- ^ @[]@-          | PromotedTupleT Int            -- ^ @'(), '(,), '(,,), etc.@-          | PromotedNilT                  -- ^ @'[]@-          | PromotedConsT                 -- ^ @(':)@-          | StarT                         -- ^ @*@-          | ConstraintT                   -- ^ @Constraint@-          | LitT TyLit                    -- ^ @0,1,2, etc.@-          | WildCardT                     -- ^ @_@-          | ImplicitParamT String Type    -- ^ @?x :: t@+          | TupleT Int                     -- ^ @(,), (,,), etc.@+          | UnboxedTupleT Int              -- ^ @(\#,\#), (\#,,\#), etc.@+          | UnboxedSumT SumArity           -- ^ @(\#|\#), (\#||\#), etc.@+          | ArrowT                         -- ^ @->@+          | MulArrowT                      -- ^ @%n ->@+                                           --+                                           -- Generalised arrow type with multiplicity argument+          | EqualityT                      -- ^ @~@+          | ListT                          -- ^ @[]@+          | PromotedTupleT Int             -- ^ @'(), '(,), '(,,), etc.@+          | PromotedNilT                   -- ^ @'[]@+          | PromotedConsT                  -- ^ @(':)@+          | StarT                          -- ^ @*@+          | ConstraintT                    -- ^ @Constraint@+          | LitT TyLit                     -- ^ @0,1,2, etc.@+          | WildCardT                      -- ^ @_@+          | ImplicitParamT String Type     -- ^ @?x :: t@       deriving( Show, Eq, Ord, Data, Generic )  data Specificity = SpecifiedSpec          -- ^ @a@

@@ -4,6 +4,22 @@    * Add `DefaultD` constructor to support Haskell `default` declarations. +  * Add support for Overloaded Record Dot.+    Introduces `getFieldE :: Quote m => m Exp -> String -> m Exp` and+    `projectionE :: Quote m => [String] -> m Exp`.+  * Add `instance Lift ByteArray`.++  * Add `PromotedInfixT` and `PromotedUInfixT`, which are analogs to `InfixT`+    and `UInfixT` that ensure that if a dynamically bound name (i.e. a name+    with `NameFlavour` `NameS` or `NameQ`; the flavours produced by `mkName`)+    is used as operator, it will be bound to a promoted data constructor rather+    than a type constructor, if both are in scope.++  * Add a `vendor-filepath` Cabal flag to the `template-haskell` package. If+    this flag is set then `template-haskell` will not depend on the `filepath`+    package and will instead use  some modules from `filepath` that have been+    copied into the  `template-haskell` source tree.+ ## 2.18.0.0   * The types of `ConP` and `conP` have been changed to allow for an additional list     of type applications preceding the argument patterns.@@ -20,10 +36,6 @@    * Add `newDeclarationGroup` to document the effect of visibility while     reifying types and instances.--  * Add support for Overloaded Record Dot. -    Introduces `getFieldE :: Quote m => m Exp -> String -> m Exp` and-    `projectionE :: Quote m => [String] -> m Exp`.  ## 2.17.0.0   * Typed Quotations now return a value of type `Code m a` (GHC Proposal #195).

@@ -3,7 +3,7 @@ -- template-haskell.cabal.  name:           template-haskell-version:        2.18.0.0+version:        2.19.0.0 -- NOTE: Don't forget to update ./changelog.md license:        BSD3 license-file:   LICENSE@@ -27,6 +27,14 @@     location: https://gitlab.haskell.org/ghc/ghc.git     subdir:   libraries/template-haskell ++-- We give the option to vendor filepath to avoid making filepath non-reinstallable..+-- see #21738 for why we are doing this now and what the plan is for the future.+Flag vendor-filepath+    Description: Vendor the dependency on filepath+    Default: False+    Manual: True+ Library     default-language: Haskell2010     other-extensions:@@ -55,10 +63,22 @@         Language.Haskell.TH.Lib.Map      build-depends:-        base        >= 4.11 && < 4.17,-        ghc-boot-th == 9.2.1,+        base        >= 4.11 && < 4.18,+        ghc-boot-th == 9.4.1,         ghc-prim,         pretty      == 1.1.*++    if flag(vendor-filepath)+      other-modules:+        System.FilePath+        System.FilePath.Posix+        System.FilePath.Windows+      hs-source-dirs: ./vendored-filepath .+      default-extensions:+        ImplicitPrelude+    else+      build-depends: filepath+      hs-source-dirs: .      ghc-options: -Wall 

@@ -0,0 +1,149 @@+-- Vendored from filepath v1.4.2.2++{-# LANGUAGE CPP #-}+#if __GLASGOW_HASKELL__ >= 704+{-# LANGUAGE Safe #-}+#endif+{- |+Module      :  System.FilePath+Copyright   :  (c) Neil Mitchell 2005-2014+License     :  BSD3++Maintainer  :  ndmitchell@gmail.com+Stability   :  stable+Portability :  portable++A library for 'FilePath' manipulations, using Posix or Windows filepaths+depending on the platform.++Both "System.FilePath.Posix" and "System.FilePath.Windows" provide the+same interface.++Given the example 'FilePath': @\/directory\/file.ext@++We can use the following functions to extract pieces.++* 'takeFileName' gives @\"file.ext\"@++* 'takeDirectory' gives @\"\/directory\"@++* 'takeExtension' gives @\".ext\"@++* 'dropExtension' gives @\"\/directory\/file\"@++* 'takeBaseName' gives @\"file\"@++And we could have built an equivalent path with the following expressions:++* @\"\/directory\" '</>' \"file.ext\"@.++* @\"\/directory\/file" '<.>' \"ext\"@.++* @\"\/directory\/file.txt" '-<.>' \"ext\"@.++Each function in this module is documented with several examples,+which are also used as tests.++Here are a few examples of using the @filepath@ functions together:++/Example 1:/ Find the possible locations of a Haskell module @Test@ imported from module @Main@:++@['replaceFileName' path_to_main \"Test\" '<.>' ext | ext <- [\"hs\",\"lhs\"] ]@++/Example 2:/ Download a file from @url@ and save it to disk:++@do let file = 'makeValid' url+  System.Directory.createDirectoryIfMissing True ('takeDirectory' file)@++/Example 3:/ Compile a Haskell file, putting the @.hi@ file under @interface@:++@'takeDirectory' file '</>' \"interface\" '</>' ('takeFileName' file '-<.>' \"hi\")@++References:+[1] <http://msdn.microsoft.com/en-us/library/windows/desktop/aa365247.aspx Naming Files, Paths and Namespaces> (Microsoft MSDN)+-}+++#if defined(mingw32_HOST_OS) || defined(__MINGW32__)+module System.FilePath(+    -- * Separator predicates+    FilePath,+    pathSeparator, pathSeparators, isPathSeparator,+    searchPathSeparator, isSearchPathSeparator,+    extSeparator, isExtSeparator,++    -- * @$PATH@ methods+    splitSearchPath, getSearchPath,++    -- * Extension functions+    splitExtension,+    takeExtension, replaceExtension, (-<.>), dropExtension, addExtension, hasExtension, (<.>),+    splitExtensions, dropExtensions, takeExtensions, replaceExtensions, isExtensionOf,+    stripExtension,++    -- * Filename\/directory functions+    splitFileName,+    takeFileName, replaceFileName, dropFileName,+    takeBaseName, replaceBaseName,+    takeDirectory, replaceDirectory,+    combine, (</>),+    splitPath, joinPath, splitDirectories,++    -- * Drive functions+    splitDrive, joinDrive,+    takeDrive, hasDrive, dropDrive, isDrive,++    -- * Trailing slash functions+    hasTrailingPathSeparator,+    addTrailingPathSeparator,+    dropTrailingPathSeparator,++    -- * File name manipulations+    normalise, equalFilePath,+    makeRelative,+    isRelative, isAbsolute,+    isValid, makeValid+) where+import System.FilePath.Windows+#else+module System.FilePath(+    -- * Separator predicates+    FilePath,+    pathSeparator, pathSeparators, isPathSeparator,+    searchPathSeparator, isSearchPathSeparator,+    extSeparator, isExtSeparator,++    -- * @$PATH@ methods+    splitSearchPath, getSearchPath,++    -- * Extension functions+    splitExtension,+    takeExtension, replaceExtension, (-<.>), dropExtension, addExtension, hasExtension, (<.>),+    splitExtensions, dropExtensions, takeExtensions, replaceExtensions, isExtensionOf,+    stripExtension,++    -- * Filename\/directory functions+    splitFileName,+    takeFileName, replaceFileName, dropFileName,+    takeBaseName, replaceBaseName,+    takeDirectory, replaceDirectory,+    combine, (</>),+    splitPath, joinPath, splitDirectories,++    -- * Drive functions+    splitDrive, joinDrive,+    takeDrive, hasDrive, dropDrive, isDrive,++    -- * Trailing slash functions+    hasTrailingPathSeparator,+    addTrailingPathSeparator,+    dropTrailingPathSeparator,++    -- * File name manipulations+    normalise, equalFilePath,+    makeRelative,+    isRelative, isAbsolute,+    isValid, makeValid+) where+import System.FilePath.Posix+#endif

@@ -0,0 +1,1047 @@+-- Vendored from filepath v1.4.2.2++{-# LANGUAGE PatternGuards #-}++-- This template expects CPP definitions for:+--     MODULE_NAME = Posix | Windows+--     IS_WINDOWS  = False | True++-- |+-- Module      :  System.FilePath.MODULE_NAME+-- Copyright   :  (c) Neil Mitchell 2005-2014+-- License     :  BSD3+--+-- Maintainer  :  ndmitchell@gmail.com+-- Stability   :  stable+-- Portability :  portable+--+-- A library for 'FilePath' manipulations, using MODULE_NAME style paths on+-- all platforms. Importing "System.FilePath" is usually better.+--+-- Given the example 'FilePath': @\/directory\/file.ext@+--+-- We can use the following functions to extract pieces.+--+-- * 'takeFileName' gives @\"file.ext\"@+--+-- * 'takeDirectory' gives @\"\/directory\"@+--+-- * 'takeExtension' gives @\".ext\"@+--+-- * 'dropExtension' gives @\"\/directory\/file\"@+--+-- * 'takeBaseName' gives @\"file\"@+--+-- And we could have built an equivalent path with the following expressions:+--+-- * @\"\/directory\" '</>' \"file.ext\"@.+--+-- * @\"\/directory\/file" '<.>' \"ext\"@.+--+-- * @\"\/directory\/file.txt" '-<.>' \"ext\"@.+--+-- Each function in this module is documented with several examples,+-- which are also used as tests.+--+-- Here are a few examples of using the @filepath@ functions together:+--+-- /Example 1:/ Find the possible locations of a Haskell module @Test@ imported from module @Main@:+--+-- @['replaceFileName' path_to_main \"Test\" '<.>' ext | ext <- [\"hs\",\"lhs\"] ]@+--+-- /Example 2:/ Download a file from @url@ and save it to disk:+--+-- @do let file = 'makeValid' url+--   System.Directory.createDirectoryIfMissing True ('takeDirectory' file)@+--+-- /Example 3:/ Compile a Haskell file, putting the @.hi@ file under @interface@:+--+-- @'takeDirectory' file '</>' \"interface\" '</>' ('takeFileName' file '-<.>' \"hi\")@+--+-- References:+-- [1] <http://msdn.microsoft.com/en-us/library/windows/desktop/aa365247.aspx Naming Files, Paths and Namespaces> (Microsoft MSDN)+module System.FilePath.Posix+    (+    -- * Separator predicates+    FilePath,+    pathSeparator, pathSeparators, isPathSeparator,+    searchPathSeparator, isSearchPathSeparator,+    extSeparator, isExtSeparator,++    -- * @$PATH@ methods+    splitSearchPath, getSearchPath,++    -- * Extension functions+    splitExtension,+    takeExtension, replaceExtension, (-<.>), dropExtension, addExtension, hasExtension, (<.>),+    splitExtensions, dropExtensions, takeExtensions, replaceExtensions, isExtensionOf,+    stripExtension,++    -- * Filename\/directory functions+    splitFileName,+    takeFileName, replaceFileName, dropFileName,+    takeBaseName, replaceBaseName,+    takeDirectory, replaceDirectory,+    combine, (</>),+    splitPath, joinPath, splitDirectories,++    -- * Drive functions+    splitDrive, joinDrive,+    takeDrive, hasDrive, dropDrive, isDrive,++    -- * Trailing slash functions+    hasTrailingPathSeparator,+    addTrailingPathSeparator,+    dropTrailingPathSeparator,++    -- * File name manipulations+    normalise, equalFilePath,+    makeRelative,+    isRelative, isAbsolute,+    isValid, makeValid+    )+    where++import Data.Char(toLower, toUpper, isAsciiLower, isAsciiUpper)+import Data.Maybe(isJust)+import Data.List(stripPrefix, isSuffixOf)++import System.Environment(getEnv)+++infixr 7  <.>, -<.>+infixr 5  </>++++++---------------------------------------------------------------------+-- Platform Abstraction Methods (private)++-- | Is the operating system Unix or Linux like+isPosix :: Bool+isPosix = not isWindows++-- | Is the operating system Windows like+isWindows :: Bool+isWindows = False+++---------------------------------------------------------------------+-- The basic functions++-- | The character that separates directories. In the case where more than+--   one character is possible, 'pathSeparator' is the \'ideal\' one.+--+-- > Windows: pathSeparator == '\\'+-- > Posix:   pathSeparator ==  '/'+-- > isPathSeparator pathSeparator+pathSeparator :: Char+pathSeparator = if isWindows then '\\' else '/'++-- | The list of all possible separators.+--+-- > Windows: pathSeparators == ['\\', '/']+-- > Posix:   pathSeparators == ['/']+-- > pathSeparator `elem` pathSeparators+pathSeparators :: [Char]+pathSeparators = if isWindows then "\\/" else "/"++-- | Rather than using @(== 'pathSeparator')@, use this. Test if something+--   is a path separator.+--+-- > isPathSeparator a == (a `elem` pathSeparators)+isPathSeparator :: Char -> Bool+isPathSeparator '/' = True+isPathSeparator '\\' = isWindows+isPathSeparator _ = False+++-- | The character that is used to separate the entries in the $PATH environment variable.+--+-- > Windows: searchPathSeparator == ';'+-- > Posix:   searchPathSeparator == ':'+searchPathSeparator :: Char+searchPathSeparator = if isWindows then ';' else ':'++-- | Is the character a file separator?+--+-- > isSearchPathSeparator a == (a == searchPathSeparator)+isSearchPathSeparator :: Char -> Bool+isSearchPathSeparator = (== searchPathSeparator)+++-- | File extension character+--+-- > extSeparator == '.'+extSeparator :: Char+extSeparator = '.'++-- | Is the character an extension character?+--+-- > isExtSeparator a == (a == extSeparator)+isExtSeparator :: Char -> Bool+isExtSeparator = (== extSeparator)+++---------------------------------------------------------------------+-- Path methods (environment $PATH)++-- | Take a string, split it on the 'searchPathSeparator' character.+--   Blank items are ignored on Windows, and converted to @.@ on Posix.+--   On Windows path elements are stripped of quotes.+--+--   Follows the recommendations in+--   <http://www.opengroup.org/onlinepubs/009695399/basedefs/xbd_chap08.html>+--+-- > Posix:   splitSearchPath "File1:File2:File3"  == ["File1","File2","File3"]+-- > Posix:   splitSearchPath "File1::File2:File3" == ["File1",".","File2","File3"]+-- > Windows: splitSearchPath "File1;File2;File3"  == ["File1","File2","File3"]+-- > Windows: splitSearchPath "File1;;File2;File3" == ["File1","File2","File3"]+-- > Windows: splitSearchPath "File1;\"File2\";File3" == ["File1","File2","File3"]+splitSearchPath :: String -> [FilePath]+splitSearchPath = f+    where+    f xs = case break isSearchPathSeparator xs of+           (pre, []    ) -> g pre+           (pre, _:post) -> g pre ++ f post++    g "" = ["." | isPosix]+    g ('\"':x@(_:_)) | isWindows && last x == '\"' = [init x]+    g x = [x]+++-- | Get a list of 'FilePath's in the $PATH variable.+getSearchPath :: IO [FilePath]+getSearchPath = fmap splitSearchPath (getEnv "PATH")+++---------------------------------------------------------------------+-- Extension methods++-- | Split on the extension. 'addExtension' is the inverse.+--+-- > splitExtension "/directory/path.ext" == ("/directory/path",".ext")+-- > uncurry (++) (splitExtension x) == x+-- > Valid x => uncurry addExtension (splitExtension x) == x+-- > splitExtension "file.txt" == ("file",".txt")+-- > splitExtension "file" == ("file","")+-- > splitExtension "file/file.txt" == ("file/file",".txt")+-- > splitExtension "file.txt/boris" == ("file.txt/boris","")+-- > splitExtension "file.txt/boris.ext" == ("file.txt/boris",".ext")+-- > splitExtension "file/path.txt.bob.fred" == ("file/path.txt.bob",".fred")+-- > splitExtension "file/path.txt/" == ("file/path.txt/","")+splitExtension :: FilePath -> (String, String)+splitExtension x = case nameDot of+                       "" -> (x,"")+                       _ -> (dir ++ init nameDot, extSeparator : ext)+    where+        (dir,file) = splitFileName_ x+        (nameDot,ext) = breakEnd isExtSeparator file++-- | Get the extension of a file, returns @\"\"@ for no extension, @.ext@ otherwise.+--+-- > takeExtension "/directory/path.ext" == ".ext"+-- > takeExtension x == snd (splitExtension x)+-- > Valid x => takeExtension (addExtension x "ext") == ".ext"+-- > Valid x => takeExtension (replaceExtension x "ext") == ".ext"+takeExtension :: FilePath -> String+takeExtension = snd . splitExtension++-- | Remove the current extension and add another, equivalent to 'replaceExtension'.+--+-- > "/directory/path.txt" -<.> "ext" == "/directory/path.ext"+-- > "/directory/path.txt" -<.> ".ext" == "/directory/path.ext"+-- > "foo.o" -<.> "c" == "foo.c"+(-<.>) :: FilePath -> String -> FilePath+(-<.>) = replaceExtension++-- | Set the extension of a file, overwriting one if already present, equivalent to '-<.>'.+--+-- > replaceExtension "/directory/path.txt" "ext" == "/directory/path.ext"+-- > replaceExtension "/directory/path.txt" ".ext" == "/directory/path.ext"+-- > replaceExtension "file.txt" ".bob" == "file.bob"+-- > replaceExtension "file.txt" "bob" == "file.bob"+-- > replaceExtension "file" ".bob" == "file.bob"+-- > replaceExtension "file.txt" "" == "file"+-- > replaceExtension "file.fred.bob" "txt" == "file.fred.txt"+-- > replaceExtension x y == addExtension (dropExtension x) y+replaceExtension :: FilePath -> String -> FilePath+replaceExtension x y = dropExtension x <.> y++-- | Add an extension, even if there is already one there, equivalent to 'addExtension'.+--+-- > "/directory/path" <.> "ext" == "/directory/path.ext"+-- > "/directory/path" <.> ".ext" == "/directory/path.ext"+(<.>) :: FilePath -> String -> FilePath+(<.>) = addExtension++-- | Remove last extension, and the \".\" preceding it.+--+-- > dropExtension "/directory/path.ext" == "/directory/path"+-- > dropExtension x == fst (splitExtension x)+dropExtension :: FilePath -> FilePath+dropExtension = fst . splitExtension++-- | Add an extension, even if there is already one there, equivalent to '<.>'.+--+-- > addExtension "/directory/path" "ext" == "/directory/path.ext"+-- > addExtension "file.txt" "bib" == "file.txt.bib"+-- > addExtension "file." ".bib" == "file..bib"+-- > addExtension "file" ".bib" == "file.bib"+-- > addExtension "/" "x" == "/.x"+-- > addExtension x "" == x+-- > Valid x => takeFileName (addExtension (addTrailingPathSeparator x) "ext") == ".ext"+-- > Windows: addExtension "\\\\share" ".txt" == "\\\\share\\.txt"+addExtension :: FilePath -> String -> FilePath+addExtension file "" = file+addExtension file xs@(x:_) = joinDrive a res+    where+        res = if isExtSeparator x then b ++ xs+              else b ++ [extSeparator] ++ xs++        (a,b) = splitDrive file++-- | Does the given filename have an extension?+--+-- > hasExtension "/directory/path.ext" == True+-- > hasExtension "/directory/path" == False+-- > null (takeExtension x) == not (hasExtension x)+hasExtension :: FilePath -> Bool+hasExtension = any isExtSeparator . takeFileName+++-- | Does the given filename have the specified extension?+--+-- > "png" `isExtensionOf` "/directory/file.png" == True+-- > ".png" `isExtensionOf` "/directory/file.png" == True+-- > ".tar.gz" `isExtensionOf` "bar/foo.tar.gz" == True+-- > "ar.gz" `isExtensionOf` "bar/foo.tar.gz" == False+-- > "png" `isExtensionOf` "/directory/file.png.jpg" == False+-- > "csv/table.csv" `isExtensionOf` "/data/csv/table.csv" == False+isExtensionOf :: String -> FilePath -> Bool+isExtensionOf ext@('.':_) = isSuffixOf ext . takeExtensions+isExtensionOf ext         = isSuffixOf ('.':ext) . takeExtensions++-- | Drop the given extension from a FilePath, and the @\".\"@ preceding it.+--   Returns 'Nothing' if the FilePath does not have the given extension, or+--   'Just' and the part before the extension if it does.+--+--   This function can be more predictable than 'dropExtensions', especially if the filename+--   might itself contain @.@ characters.+--+-- > stripExtension "hs.o" "foo.x.hs.o" == Just "foo.x"+-- > stripExtension "hi.o" "foo.x.hs.o" == Nothing+-- > dropExtension x == fromJust (stripExtension (takeExtension x) x)+-- > dropExtensions x == fromJust (stripExtension (takeExtensions x) x)+-- > stripExtension ".c.d" "a.b.c.d"  == Just "a.b"+-- > stripExtension ".c.d" "a.b..c.d" == Just "a.b."+-- > stripExtension "baz"  "foo.bar"  == Nothing+-- > stripExtension "bar"  "foobar"   == Nothing+-- > stripExtension ""     x          == Just x+stripExtension :: String -> FilePath -> Maybe FilePath+stripExtension []        path = Just path+stripExtension ext@(x:_) path = stripSuffix dotExt path+    where dotExt = if isExtSeparator x then ext else '.':ext+++-- | Split on all extensions.+--+-- > splitExtensions "/directory/path.ext" == ("/directory/path",".ext")+-- > splitExtensions "file.tar.gz" == ("file",".tar.gz")+-- > uncurry (++) (splitExtensions x) == x+-- > Valid x => uncurry addExtension (splitExtensions x) == x+-- > splitExtensions "file.tar.gz" == ("file",".tar.gz")+splitExtensions :: FilePath -> (FilePath, String)+splitExtensions x = (a ++ c, d)+    where+        (a,b) = splitFileName_ x+        (c,d) = break isExtSeparator b++-- | Drop all extensions.+--+-- > dropExtensions "/directory/path.ext" == "/directory/path"+-- > dropExtensions "file.tar.gz" == "file"+-- > not $ hasExtension $ dropExtensions x+-- > not $ any isExtSeparator $ takeFileName $ dropExtensions x+dropExtensions :: FilePath -> FilePath+dropExtensions = fst . splitExtensions++-- | Get all extensions.+--+-- > takeExtensions "/directory/path.ext" == ".ext"+-- > takeExtensions "file.tar.gz" == ".tar.gz"+takeExtensions :: FilePath -> String+takeExtensions = snd . splitExtensions+++-- | Replace all extensions of a file with a new extension. Note+--   that 'replaceExtension' and 'addExtension' both work for adding+--   multiple extensions, so only required when you need to drop+--   all extensions first.+--+-- > replaceExtensions "file.fred.bob" "txt" == "file.txt"+-- > replaceExtensions "file.fred.bob" "tar.gz" == "file.tar.gz"+replaceExtensions :: FilePath -> String -> FilePath+replaceExtensions x y = dropExtensions x <.> y++++---------------------------------------------------------------------+-- Drive methods++-- | Is the given character a valid drive letter?+-- only a-z and A-Z are letters, not isAlpha which is more unicodey+isLetter :: Char -> Bool+isLetter x = isAsciiLower x || isAsciiUpper x+++-- | Split a path into a drive and a path.+--   On Posix, \/ is a Drive.+--+-- > uncurry (++) (splitDrive x) == x+-- > Windows: splitDrive "file" == ("","file")+-- > Windows: splitDrive "c:/file" == ("c:/","file")+-- > Windows: splitDrive "c:\\file" == ("c:\\","file")+-- > Windows: splitDrive "\\\\shared\\test" == ("\\\\shared\\","test")+-- > Windows: splitDrive "\\\\shared" == ("\\\\shared","")+-- > Windows: splitDrive "\\\\?\\UNC\\shared\\file" == ("\\\\?\\UNC\\shared\\","file")+-- > Windows: splitDrive "\\\\?\\UNCshared\\file" == ("\\\\?\\","UNCshared\\file")+-- > Windows: splitDrive "\\\\?\\d:\\file" == ("\\\\?\\d:\\","file")+-- > Windows: splitDrive "/d" == ("","/d")+-- > Posix:   splitDrive "/test" == ("/","test")+-- > Posix:   splitDrive "//test" == ("//","test")+-- > Posix:   splitDrive "test/file" == ("","test/file")+-- > Posix:   splitDrive "file" == ("","file")+splitDrive :: FilePath -> (FilePath, FilePath)+splitDrive x | isPosix = span (== '/') x+splitDrive x | Just y <- readDriveLetter x = y+splitDrive x | Just y <- readDriveUNC x = y+splitDrive x | Just y <- readDriveShare x = y+splitDrive x = ("",x)++addSlash :: FilePath -> FilePath -> (FilePath, FilePath)+addSlash a xs = (a++c,d)+    where (c,d) = span isPathSeparator xs++-- See [1].+-- "\\?\D:\<path>" or "\\?\UNC\<server>\<share>"+readDriveUNC :: FilePath -> Maybe (FilePath, FilePath)+readDriveUNC (s1:s2:'?':s3:xs) | all isPathSeparator [s1,s2,s3] =+    case map toUpper xs of+        ('U':'N':'C':s4:_) | isPathSeparator s4 ->+            let (a,b) = readDriveShareName (drop 4 xs)+            in Just (s1:s2:'?':s3:take 4 xs ++ a, b)+        _ -> case readDriveLetter xs of+                 -- Extended-length path.+                 Just (a,b) -> Just (s1:s2:'?':s3:a,b)+                 Nothing -> Nothing+readDriveUNC _ = Nothing++{- c:\ -}+readDriveLetter :: String -> Maybe (FilePath, FilePath)+readDriveLetter (x:':':y:xs) | isLetter x && isPathSeparator y = Just $ addSlash [x,':'] (y:xs)+readDriveLetter (x:':':xs) | isLetter x = Just ([x,':'], xs)+readDriveLetter _ = Nothing++{- \\sharename\ -}+readDriveShare :: String -> Maybe (FilePath, FilePath)+readDriveShare (s1:s2:xs) | isPathSeparator s1 && isPathSeparator s2 =+        Just (s1:s2:a,b)+    where (a,b) = readDriveShareName xs+readDriveShare _ = Nothing++{- assume you have already seen \\ -}+{- share\bob -> "share\", "bob" -}+readDriveShareName :: String -> (FilePath, FilePath)+readDriveShareName name = addSlash a b+    where (a,b) = break isPathSeparator name++++-- | Join a drive and the rest of the path.+--+-- > Valid x => uncurry joinDrive (splitDrive x) == x+-- > Windows: joinDrive "C:" "foo" == "C:foo"+-- > Windows: joinDrive "C:\\" "bar" == "C:\\bar"+-- > Windows: joinDrive "\\\\share" "foo" == "\\\\share\\foo"+-- > Windows: joinDrive "/:" "foo" == "/:\\foo"+joinDrive :: FilePath -> FilePath -> FilePath+joinDrive = combineAlways++-- | Get the drive from a filepath.+--+-- > takeDrive x == fst (splitDrive x)+takeDrive :: FilePath -> FilePath+takeDrive = fst . splitDrive++-- | Delete the drive, if it exists.+--+-- > dropDrive x == snd (splitDrive x)+dropDrive :: FilePath -> FilePath+dropDrive = snd . splitDrive++-- | Does a path have a drive.+--+-- > not (hasDrive x) == null (takeDrive x)+-- > Posix:   hasDrive "/foo" == True+-- > Windows: hasDrive "C:\\foo" == True+-- > Windows: hasDrive "C:foo" == True+-- >          hasDrive "foo" == False+-- >          hasDrive "" == False+hasDrive :: FilePath -> Bool+hasDrive = not . null . takeDrive+++-- | Is an element a drive+--+-- > Posix:   isDrive "/" == True+-- > Posix:   isDrive "/foo" == False+-- > Windows: isDrive "C:\\" == True+-- > Windows: isDrive "C:\\foo" == False+-- >          isDrive "" == False+isDrive :: FilePath -> Bool+isDrive x = not (null x) && null (dropDrive x)+++---------------------------------------------------------------------+-- Operations on a filepath, as a list of directories++-- | Split a filename into directory and file. '</>' is the inverse.+--   The first component will often end with a trailing slash.+--+-- > splitFileName "/directory/file.ext" == ("/directory/","file.ext")+-- > Valid x => uncurry (</>) (splitFileName x) == x || fst (splitFileName x) == "./"+-- > Valid x => isValid (fst (splitFileName x))+-- > splitFileName "file/bob.txt" == ("file/", "bob.txt")+-- > splitFileName "file/" == ("file/", "")+-- > splitFileName "bob" == ("./", "bob")+-- > Posix:   splitFileName "/" == ("/","")+-- > Windows: splitFileName "c:" == ("c:","")+splitFileName :: FilePath -> (String, String)+splitFileName x = (if null dir then "./" else dir, name)+    where+        (dir, name) = splitFileName_ x++-- version of splitFileName where, if the FilePath has no directory+-- component, the returned directory is "" rather than "./".  This+-- is used in cases where we are going to combine the returned+-- directory to make a valid FilePath, and having a "./" appear would+-- look strange and upset simple equality properties.  See+-- e.g. replaceFileName.+splitFileName_ :: FilePath -> (String, String)+splitFileName_ x = (drv ++ dir, file)+    where+        (drv,pth) = splitDrive x+        (dir,file) = breakEnd isPathSeparator pth++-- | Set the filename.+--+-- > replaceFileName "/directory/other.txt" "file.ext" == "/directory/file.ext"+-- > Valid x => replaceFileName x (takeFileName x) == x+replaceFileName :: FilePath -> String -> FilePath+replaceFileName x y = a </> y where (a,_) = splitFileName_ x++-- | Drop the filename. Unlike 'takeDirectory', this function will leave+--   a trailing path separator on the directory.+--+-- > dropFileName "/directory/file.ext" == "/directory/"+-- > dropFileName x == fst (splitFileName x)+dropFileName :: FilePath -> FilePath+dropFileName = fst . splitFileName+++-- | Get the file name.+--+-- > takeFileName "/directory/file.ext" == "file.ext"+-- > takeFileName "test/" == ""+-- > takeFileName x `isSuffixOf` x+-- > takeFileName x == snd (splitFileName x)+-- > Valid x => takeFileName (replaceFileName x "fred") == "fred"+-- > Valid x => takeFileName (x </> "fred") == "fred"+-- > Valid x => isRelative (takeFileName x)+takeFileName :: FilePath -> FilePath+takeFileName = snd . splitFileName++-- | Get the base name, without an extension or path.+--+-- > takeBaseName "/directory/file.ext" == "file"+-- > takeBaseName "file/test.txt" == "test"+-- > takeBaseName "dave.ext" == "dave"+-- > takeBaseName "" == ""+-- > takeBaseName "test" == "test"+-- > takeBaseName (addTrailingPathSeparator x) == ""+-- > takeBaseName "file/file.tar.gz" == "file.tar"+takeBaseName :: FilePath -> String+takeBaseName = dropExtension . takeFileName++-- | Set the base name.+--+-- > replaceBaseName "/directory/other.ext" "file" == "/directory/file.ext"+-- > replaceBaseName "file/test.txt" "bob" == "file/bob.txt"+-- > replaceBaseName "fred" "bill" == "bill"+-- > replaceBaseName "/dave/fred/bob.gz.tar" "new" == "/dave/fred/new.tar"+-- > Valid x => replaceBaseName x (takeBaseName x) == x+replaceBaseName :: FilePath -> String -> FilePath+replaceBaseName pth nam = combineAlways a (nam <.> ext)+    where+        (a,b) = splitFileName_ pth+        ext = takeExtension b++-- | Is an item either a directory or the last character a path separator?+--+-- > hasTrailingPathSeparator "test" == False+-- > hasTrailingPathSeparator "test/" == True+hasTrailingPathSeparator :: FilePath -> Bool+hasTrailingPathSeparator "" = False+hasTrailingPathSeparator x = isPathSeparator (last x)+++hasLeadingPathSeparator :: FilePath -> Bool+hasLeadingPathSeparator "" = False+hasLeadingPathSeparator x = isPathSeparator (head x)+++-- | Add a trailing file path separator if one is not already present.+--+-- > hasTrailingPathSeparator (addTrailingPathSeparator x)+-- > hasTrailingPathSeparator x ==> addTrailingPathSeparator x == x+-- > Posix:    addTrailingPathSeparator "test/rest" == "test/rest/"+addTrailingPathSeparator :: FilePath -> FilePath+addTrailingPathSeparator x = if hasTrailingPathSeparator x then x else x ++ [pathSeparator]+++-- | Remove any trailing path separators+--+-- > dropTrailingPathSeparator "file/test/" == "file/test"+-- >           dropTrailingPathSeparator "/" == "/"+-- > Windows:  dropTrailingPathSeparator "\\" == "\\"+-- > Posix:    not (hasTrailingPathSeparator (dropTrailingPathSeparator x)) || isDrive x+dropTrailingPathSeparator :: FilePath -> FilePath+dropTrailingPathSeparator x =+    if hasTrailingPathSeparator x && not (isDrive x)+    then let x' = dropWhileEnd isPathSeparator x+         in if null x' then [last x] else x'+    else x+++-- | Get the directory name, move up one level.+--+-- >           takeDirectory "/directory/other.ext" == "/directory"+-- >           takeDirectory x `isPrefixOf` x || takeDirectory x == "."+-- >           takeDirectory "foo" == "."+-- >           takeDirectory "/" == "/"+-- >           takeDirectory "/foo" == "/"+-- >           takeDirectory "/foo/bar/baz" == "/foo/bar"+-- >           takeDirectory "/foo/bar/baz/" == "/foo/bar/baz"+-- >           takeDirectory "foo/bar/baz" == "foo/bar"+-- > Windows:  takeDirectory "foo\\bar" == "foo"+-- > Windows:  takeDirectory "foo\\bar\\\\" == "foo\\bar"+-- > Windows:  takeDirectory "C:\\" == "C:\\"+takeDirectory :: FilePath -> FilePath+takeDirectory = dropTrailingPathSeparator . dropFileName++-- | Set the directory, keeping the filename the same.+--+-- > replaceDirectory "root/file.ext" "/directory/" == "/directory/file.ext"+-- > Valid x => replaceDirectory x (takeDirectory x) `equalFilePath` x+replaceDirectory :: FilePath -> String -> FilePath+replaceDirectory x dir = combineAlways dir (takeFileName x)+++-- | An alias for '</>'.+combine :: FilePath -> FilePath -> FilePath+combine a b | hasLeadingPathSeparator b || hasDrive b = b+            | otherwise = combineAlways a b++-- | Combine two paths, assuming rhs is NOT absolute.+combineAlways :: FilePath -> FilePath -> FilePath+combineAlways a b | null a = b+                  | null b = a+                  | hasTrailingPathSeparator a = a ++ b+                  | otherwise = case a of+                      [a1,':'] | isWindows && isLetter a1 -> a ++ b+                      _ -> a ++ [pathSeparator] ++ b+++-- | Combine two paths with a path separator.+--   If the second path starts with a path separator or a drive letter, then it returns the second.+--   The intention is that @readFile (dir '</>' file)@ will access the same file as+--   @setCurrentDirectory dir; readFile file@.+--+-- > Posix:   "/directory" </> "file.ext" == "/directory/file.ext"+-- > Windows: "/directory" </> "file.ext" == "/directory\\file.ext"+-- >          "directory" </> "/file.ext" == "/file.ext"+-- > Valid x => (takeDirectory x </> takeFileName x) `equalFilePath` x+--+--   Combined:+--+-- > Posix:   "/" </> "test" == "/test"+-- > Posix:   "home" </> "bob" == "home/bob"+-- > Posix:   "x:" </> "foo" == "x:/foo"+-- > Windows: "C:\\foo" </> "bar" == "C:\\foo\\bar"+-- > Windows: "home" </> "bob" == "home\\bob"+--+--   Not combined:+--+-- > Posix:   "home" </> "/bob" == "/bob"+-- > Windows: "home" </> "C:\\bob" == "C:\\bob"+--+--   Not combined (tricky):+--+--   On Windows, if a filepath starts with a single slash, it is relative to the+--   root of the current drive. In [1], this is (confusingly) referred to as an+--   absolute path.+--   The current behavior of '</>' is to never combine these forms.+--+-- > Windows: "home" </> "/bob" == "/bob"+-- > Windows: "home" </> "\\bob" == "\\bob"+-- > Windows: "C:\\home" </> "\\bob" == "\\bob"+--+--   On Windows, from [1]: "If a file name begins with only a disk designator+--   but not the backslash after the colon, it is interpreted as a relative path+--   to the current directory on the drive with the specified letter."+--   The current behavior of '</>' is to never combine these forms.+--+-- > Windows: "D:\\foo" </> "C:bar" == "C:bar"+-- > Windows: "C:\\foo" </> "C:bar" == "C:bar"+(</>) :: FilePath -> FilePath -> FilePath+(</>) = combine+++-- | Split a path by the directory separator.+--+-- > splitPath "/directory/file.ext" == ["/","directory/","file.ext"]+-- > concat (splitPath x) == x+-- > splitPath "test//item/" == ["test//","item/"]+-- > splitPath "test/item/file" == ["test/","item/","file"]+-- > splitPath "" == []+-- > Windows: splitPath "c:\\test\\path" == ["c:\\","test\\","path"]+-- > Posix:   splitPath "/file/test" == ["/","file/","test"]+splitPath :: FilePath -> [FilePath]+splitPath x = [drive | drive /= ""] ++ f path+    where+        (drive,path) = splitDrive x++        f "" = []+        f y = (a++c) : f d+            where+                (a,b) = break isPathSeparator y+                (c,d) = span  isPathSeparator b++-- | Just as 'splitPath', but don't add the trailing slashes to each element.+--+-- >          splitDirectories "/directory/file.ext" == ["/","directory","file.ext"]+-- >          splitDirectories "test/file" == ["test","file"]+-- >          splitDirectories "/test/file" == ["/","test","file"]+-- > Windows: splitDirectories "C:\\test\\file" == ["C:\\", "test", "file"]+-- >          Valid x => joinPath (splitDirectories x) `equalFilePath` x+-- >          splitDirectories "" == []+-- > Windows: splitDirectories "C:\\test\\\\\\file" == ["C:\\", "test", "file"]+-- >          splitDirectories "/test///file" == ["/","test","file"]+splitDirectories :: FilePath -> [FilePath]+splitDirectories = map dropTrailingPathSeparator . splitPath+++-- | Join path elements back together.+--+-- > joinPath a == foldr (</>) "" a+-- > joinPath ["/","directory/","file.ext"] == "/directory/file.ext"+-- > Valid x => joinPath (splitPath x) == x+-- > joinPath [] == ""+-- > Posix: joinPath ["test","file","path"] == "test/file/path"+joinPath :: [FilePath] -> FilePath+-- Note that this definition on c:\\c:\\, join then split will give c:\\.+joinPath = foldr combine ""+++++++---------------------------------------------------------------------+-- File name manipulators++-- | Equality of two 'FilePath's.+--   If you call @System.Directory.canonicalizePath@+--   first this has a much better chance of working.+--   Note that this doesn't follow symlinks or DOSNAM~1s.+--+-- Similar to 'normalise', this does not expand @".."@, because of symlinks.+--+-- >          x == y ==> equalFilePath x y+-- >          normalise x == normalise y ==> equalFilePath x y+-- >          equalFilePath "foo" "foo/"+-- >          not (equalFilePath "/a/../c" "/c")+-- >          not (equalFilePath "foo" "/foo")+-- > Posix:   not (equalFilePath "foo" "FOO")+-- > Windows: equalFilePath "foo" "FOO"+-- > Windows: not (equalFilePath "C:" "C:/")+equalFilePath :: FilePath -> FilePath -> Bool+equalFilePath a b = f a == f b+    where+        f x | isWindows = dropTrailingPathSeparator $ map toLower $ normalise x+            | otherwise = dropTrailingPathSeparator $ normalise x+++-- | Contract a filename, based on a relative path. Note that the resulting path+--   will never introduce @..@ paths, as the presence of symlinks means @..\/b@+--   may not reach @a\/b@ if it starts from @a\/c@. For a worked example see+--   <http://neilmitchell.blogspot.co.uk/2015/10/filepaths-are-subtle-symlinks-are-hard.html this blog post>.+--+--   The corresponding @makeAbsolute@ function can be found in+--   @System.Directory@.+--+-- >          makeRelative "/directory" "/directory/file.ext" == "file.ext"+-- >          Valid x => makeRelative (takeDirectory x) x `equalFilePath` takeFileName x+-- >          makeRelative x x == "."+-- >          Valid x y => equalFilePath x y || (isRelative x && makeRelative y x == x) || equalFilePath (y </> makeRelative y x) x+-- > Windows: makeRelative "C:\\Home" "c:\\home\\bob" == "bob"+-- > Windows: makeRelative "C:\\Home" "c:/home/bob" == "bob"+-- > Windows: makeRelative "C:\\Home" "D:\\Home\\Bob" == "D:\\Home\\Bob"+-- > Windows: makeRelative "C:\\Home" "C:Home\\Bob" == "C:Home\\Bob"+-- > Windows: makeRelative "/Home" "/home/bob" == "bob"+-- > Windows: makeRelative "/" "//" == "//"+-- > Posix:   makeRelative "/Home" "/home/bob" == "/home/bob"+-- > Posix:   makeRelative "/home/" "/home/bob/foo/bar" == "bob/foo/bar"+-- > Posix:   makeRelative "/fred" "bob" == "bob"+-- > Posix:   makeRelative "/file/test" "/file/test/fred" == "fred"+-- > Posix:   makeRelative "/file/test" "/file/test/fred/" == "fred/"+-- > Posix:   makeRelative "some/path" "some/path/a/b/c" == "a/b/c"+makeRelative :: FilePath -> FilePath -> FilePath+makeRelative root path+ | equalFilePath root path = "."+ | takeAbs root /= takeAbs path = path+ | otherwise = f (dropAbs root) (dropAbs path)+    where+        f "" y = dropWhile isPathSeparator y+        f x y = let (x1,x2) = g x+                    (y1,y2) = g y+                in if equalFilePath x1 y1 then f x2 y2 else path++        g x = (dropWhile isPathSeparator a, dropWhile isPathSeparator b)+            where (a,b) = break isPathSeparator $ dropWhile isPathSeparator x++        -- on windows, need to drop '/' which is kind of absolute, but not a drive+        dropAbs x | hasLeadingPathSeparator x && not (hasDrive x) = tail x+        dropAbs x = dropDrive x++        takeAbs x | hasLeadingPathSeparator x && not (hasDrive x) = [pathSeparator]+        takeAbs x = map (\y -> if isPathSeparator y then pathSeparator else toLower y) $ takeDrive x++-- | Normalise a file+--+-- * \/\/ outside of the drive can be made blank+--+-- * \/ -> 'pathSeparator'+--+-- * .\/ -> \"\"+--+-- Does not remove @".."@, because of symlinks.+--+-- > Posix:   normalise "/file/\\test////" == "/file/\\test/"+-- > Posix:   normalise "/file/./test" == "/file/test"+-- > Posix:   normalise "/test/file/../bob/fred/" == "/test/file/../bob/fred/"+-- > Posix:   normalise "../bob/fred/" == "../bob/fred/"+-- > Posix:   normalise "/a/../c" == "/a/../c"+-- > Posix:   normalise "./bob/fred/" == "bob/fred/"+-- > Windows: normalise "c:\\file/bob\\" == "C:\\file\\bob\\"+-- > Windows: normalise "c:\\" == "C:\\"+-- > Windows: normalise "C:.\\" == "C:"+-- > Windows: normalise "\\\\server\\test" == "\\\\server\\test"+-- > Windows: normalise "//server/test" == "\\\\server\\test"+-- > Windows: normalise "c:/file" == "C:\\file"+-- > Windows: normalise "/file" == "\\file"+-- > Windows: normalise "\\" == "\\"+-- > Windows: normalise "/./" == "\\"+-- >          normalise "." == "."+-- > Posix:   normalise "./" == "./"+-- > Posix:   normalise "./." == "./"+-- > Posix:   normalise "/./" == "/"+-- > Posix:   normalise "/" == "/"+-- > Posix:   normalise "bob/fred/." == "bob/fred/"+-- > Posix:   normalise "//home" == "/home"+normalise :: FilePath -> FilePath+normalise path = result ++ [pathSeparator | addPathSeparator]+    where+        (drv,pth) = splitDrive path+        result = joinDrive' (normaliseDrive drv) (f pth)++        joinDrive' "" "" = "."+        joinDrive' d p = joinDrive d p++        addPathSeparator = isDirPath pth+            && not (hasTrailingPathSeparator result)+            && not (isRelativeDrive drv)++        isDirPath xs = hasTrailingPathSeparator xs+            || not (null xs) && last xs == '.' && hasTrailingPathSeparator (init xs)++        f = joinPath . dropDots . propSep . splitDirectories++        propSep (x:xs) | all isPathSeparator x = [pathSeparator] : xs+                       | otherwise = x : xs+        propSep [] = []++        dropDots = filter ("." /=)++normaliseDrive :: FilePath -> FilePath+normaliseDrive "" = ""+normaliseDrive _ | isPosix = [pathSeparator]+normaliseDrive drive = if isJust $ readDriveLetter x2+                       then map toUpper x2+                       else x2+    where+        x2 = map repSlash drive++        repSlash x = if isPathSeparator x then pathSeparator else x++-- Information for validity functions on Windows. See [1].+isBadCharacter :: Char -> Bool+isBadCharacter x = x >= '\0' && x <= '\31' || x `elem` ":*?><|\""++badElements :: [FilePath]+badElements =+    ["CON","PRN","AUX","NUL","CLOCK$"+    ,"COM1","COM2","COM3","COM4","COM5","COM6","COM7","COM8","COM9"+    ,"LPT1","LPT2","LPT3","LPT4","LPT5","LPT6","LPT7","LPT8","LPT9"]+++-- | Is a FilePath valid, i.e. could you create a file like it? This function checks for invalid names,+--   and invalid characters, but does not check if length limits are exceeded, as these are typically+--   filesystem dependent.+--+-- >          isValid "" == False+-- >          isValid "\0" == False+-- > Posix:   isValid "/random_ path:*" == True+-- > Posix:   isValid x == not (null x)+-- > Windows: isValid "c:\\test" == True+-- > Windows: isValid "c:\\test:of_test" == False+-- > Windows: isValid "test*" == False+-- > Windows: isValid "c:\\test\\nul" == False+-- > Windows: isValid "c:\\test\\prn.txt" == False+-- > Windows: isValid "c:\\nul\\file" == False+-- > Windows: isValid "\\\\" == False+-- > Windows: isValid "\\\\\\foo" == False+-- > Windows: isValid "\\\\?\\D:file" == False+-- > Windows: isValid "foo\tbar" == False+-- > Windows: isValid "nul .txt" == False+-- > Windows: isValid " nul.txt" == True+isValid :: FilePath -> Bool+isValid "" = False+isValid x | '\0' `elem` x = False+isValid _ | isPosix = True+isValid path =+        not (any isBadCharacter x2) &&+        not (any f $ splitDirectories x2) &&+        not (isJust (readDriveShare x1) && all isPathSeparator x1) &&+        not (isJust (readDriveUNC x1) && not (hasTrailingPathSeparator x1))+    where+        (x1,x2) = splitDrive path+        f x = map toUpper (dropWhileEnd (== ' ') $ dropExtensions x) `elem` badElements+++-- | Take a FilePath and make it valid; does not change already valid FilePaths.+--+-- > isValid (makeValid x)+-- > isValid x ==> makeValid x == x+-- > makeValid "" == "_"+-- > makeValid "file\0name" == "file_name"+-- > Windows: makeValid "c:\\already\\/valid" == "c:\\already\\/valid"+-- > Windows: makeValid "c:\\test:of_test" == "c:\\test_of_test"+-- > Windows: makeValid "test*" == "test_"+-- > Windows: makeValid "c:\\test\\nul" == "c:\\test\\nul_"+-- > Windows: makeValid "c:\\test\\prn.txt" == "c:\\test\\prn_.txt"+-- > Windows: makeValid "c:\\test/prn.txt" == "c:\\test/prn_.txt"+-- > Windows: makeValid "c:\\nul\\file" == "c:\\nul_\\file"+-- > Windows: makeValid "\\\\\\foo" == "\\\\drive"+-- > Windows: makeValid "\\\\?\\D:file" == "\\\\?\\D:\\file"+-- > Windows: makeValid "nul .txt" == "nul _.txt"+makeValid :: FilePath -> FilePath+makeValid "" = "_"+makeValid path+        | isPosix = map (\x -> if x == '\0' then '_' else x) path+        | isJust (readDriveShare drv) && all isPathSeparator drv = take 2 drv ++ "drive"+        | isJust (readDriveUNC drv) && not (hasTrailingPathSeparator drv) =+            makeValid (drv ++ [pathSeparator] ++ pth)+        | otherwise = joinDrive drv $ validElements $ validChars pth+    where+        (drv,pth) = splitDrive path++        validChars = map f+        f x = if isBadCharacter x then '_' else x++        validElements x = joinPath $ map g $ splitPath x+        g x = h a ++ b+            where (a,b) = break isPathSeparator x+        h x = if map toUpper (dropWhileEnd (== ' ') a) `elem` badElements then a ++ "_" <.> b else x+            where (a,b) = splitExtensions x+++-- | Is a path relative, or is it fixed to the root?+--+-- > Windows: isRelative "path\\test" == True+-- > Windows: isRelative "c:\\test" == False+-- > Windows: isRelative "c:test" == True+-- > Windows: isRelative "c:\\" == False+-- > Windows: isRelative "c:/" == False+-- > Windows: isRelative "c:" == True+-- > Windows: isRelative "\\\\foo" == False+-- > Windows: isRelative "\\\\?\\foo" == False+-- > Windows: isRelative "\\\\?\\UNC\\foo" == False+-- > Windows: isRelative "/foo" == True+-- > Windows: isRelative "\\foo" == True+-- > Posix:   isRelative "test/path" == True+-- > Posix:   isRelative "/test" == False+-- > Posix:   isRelative "/" == False+--+-- According to [1]:+--+-- * "A UNC name of any format [is never relative]."+--+-- * "You cannot use the "\\?\" prefix with a relative path."+isRelative :: FilePath -> Bool+isRelative x = null drive || isRelativeDrive drive+    where drive = takeDrive x+++{- c:foo -}+-- From [1]: "If a file name begins with only a disk designator but not the+-- backslash after the colon, it is interpreted as a relative path to the+-- current directory on the drive with the specified letter."+isRelativeDrive :: String -> Bool+isRelativeDrive x =+    maybe False (not . hasTrailingPathSeparator . fst) (readDriveLetter x)+++-- | @not . 'isRelative'@+--+-- > isAbsolute x == not (isRelative x)+isAbsolute :: FilePath -> Bool+isAbsolute = not . isRelative+++-----------------------------------------------------------------------------+-- dropWhileEnd (>2) [1,2,3,4,1,2,3,4] == [1,2,3,4,1,2])+-- Note that Data.List.dropWhileEnd is only available in base >= 4.5.+dropWhileEnd :: (a -> Bool) -> [a] -> [a]+dropWhileEnd p = reverse . dropWhile p . reverse++-- takeWhileEnd (>2) [1,2,3,4,1,2,3,4] == [3,4])+takeWhileEnd :: (a -> Bool) -> [a] -> [a]+takeWhileEnd p = reverse . takeWhile p . reverse++-- spanEnd (>2) [1,2,3,4,1,2,3,4] = ([1,2,3,4,1,2], [3,4])+spanEnd :: (a -> Bool) -> [a] -> ([a], [a])+spanEnd p xs = (dropWhileEnd p xs, takeWhileEnd p xs)++-- breakEnd (< 2) [1,2,3,4,1,2,3,4] == ([1,2,3,4,1],[2,3,4])+breakEnd :: (a -> Bool) -> [a] -> ([a], [a])+breakEnd p = spanEnd (not . p)++-- | The stripSuffix function drops the given suffix from a list. It returns+-- Nothing if the list did not end with the suffix given, or Just the list+-- before the suffix, if it does.+stripSuffix :: Eq a => [a] -> [a] -> Maybe [a]+stripSuffix xs ys = fmap reverse $ stripPrefix (reverse xs) (reverse ys)

@@ -0,0 +1,1047 @@+-- Vendored from filepath v1.4.2.2++{-# LANGUAGE PatternGuards #-}++-- This template expects CPP definitions for:+--     MODULE_NAME = Posix | Windows+--     IS_WINDOWS  = False | True++-- |+-- Module      :  System.FilePath.MODULE_NAME+-- Copyright   :  (c) Neil Mitchell 2005-2014+-- License     :  BSD3+--+-- Maintainer  :  ndmitchell@gmail.com+-- Stability   :  stable+-- Portability :  portable+--+-- A library for 'FilePath' manipulations, using MODULE_NAME style paths on+-- all platforms. Importing "System.FilePath" is usually better.+--+-- Given the example 'FilePath': @\/directory\/file.ext@+--+-- We can use the following functions to extract pieces.+--+-- * 'takeFileName' gives @\"file.ext\"@+--+-- * 'takeDirectory' gives @\"\/directory\"@+--+-- * 'takeExtension' gives @\".ext\"@+--+-- * 'dropExtension' gives @\"\/directory\/file\"@+--+-- * 'takeBaseName' gives @\"file\"@+--+-- And we could have built an equivalent path with the following expressions:+--+-- * @\"\/directory\" '</>' \"file.ext\"@.+--+-- * @\"\/directory\/file" '<.>' \"ext\"@.+--+-- * @\"\/directory\/file.txt" '-<.>' \"ext\"@.+--+-- Each function in this module is documented with several examples,+-- which are also used as tests.+--+-- Here are a few examples of using the @filepath@ functions together:+--+-- /Example 1:/ Find the possible locations of a Haskell module @Test@ imported from module @Main@:+--+-- @['replaceFileName' path_to_main \"Test\" '<.>' ext | ext <- [\"hs\",\"lhs\"] ]@+--+-- /Example 2:/ Download a file from @url@ and save it to disk:+--+-- @do let file = 'makeValid' url+--   System.Directory.createDirectoryIfMissing True ('takeDirectory' file)@+--+-- /Example 3:/ Compile a Haskell file, putting the @.hi@ file under @interface@:+--+-- @'takeDirectory' file '</>' \"interface\" '</>' ('takeFileName' file '-<.>' \"hi\")@+--+-- References:+-- [1] <http://msdn.microsoft.com/en-us/library/windows/desktop/aa365247.aspx Naming Files, Paths and Namespaces> (Microsoft MSDN)+module System.FilePath.Windows+    (+    -- * Separator predicates+    FilePath,+    pathSeparator, pathSeparators, isPathSeparator,+    searchPathSeparator, isSearchPathSeparator,+    extSeparator, isExtSeparator,++    -- * @$PATH@ methods+    splitSearchPath, getSearchPath,++    -- * Extension functions+    splitExtension,+    takeExtension, replaceExtension, (-<.>), dropExtension, addExtension, hasExtension, (<.>),+    splitExtensions, dropExtensions, takeExtensions, replaceExtensions, isExtensionOf,+    stripExtension,++    -- * Filename\/directory functions+    splitFileName,+    takeFileName, replaceFileName, dropFileName,+    takeBaseName, replaceBaseName,+    takeDirectory, replaceDirectory,+    combine, (</>),+    splitPath, joinPath, splitDirectories,++    -- * Drive functions+    splitDrive, joinDrive,+    takeDrive, hasDrive, dropDrive, isDrive,++    -- * Trailing slash functions+    hasTrailingPathSeparator,+    addTrailingPathSeparator,+    dropTrailingPathSeparator,++    -- * File name manipulations+    normalise, equalFilePath,+    makeRelative,+    isRelative, isAbsolute,+    isValid, makeValid+    )+    where++import Data.Char(toLower, toUpper, isAsciiLower, isAsciiUpper)+import Data.Maybe(isJust)+import Data.List(stripPrefix, isSuffixOf)++import System.Environment(getEnv)+++infixr 7  <.>, -<.>+infixr 5  </>++++++---------------------------------------------------------------------+-- Platform Abstraction Methods (private)++-- | Is the operating system Unix or Linux like+isPosix :: Bool+isPosix = not isWindows++-- | Is the operating system Windows like+isWindows :: Bool+isWindows = True+++---------------------------------------------------------------------+-- The basic functions++-- | The character that separates directories. In the case where more than+--   one character is possible, 'pathSeparator' is the \'ideal\' one.+--+-- > Windows: pathSeparator == '\\'+-- > Posix:   pathSeparator ==  '/'+-- > isPathSeparator pathSeparator+pathSeparator :: Char+pathSeparator = if isWindows then '\\' else '/'++-- | The list of all possible separators.+--+-- > Windows: pathSeparators == ['\\', '/']+-- > Posix:   pathSeparators == ['/']+-- > pathSeparator `elem` pathSeparators+pathSeparators :: [Char]+pathSeparators = if isWindows then "\\/" else "/"++-- | Rather than using @(== 'pathSeparator')@, use this. Test if something+--   is a path separator.+--+-- > isPathSeparator a == (a `elem` pathSeparators)+isPathSeparator :: Char -> Bool+isPathSeparator '/' = True+isPathSeparator '\\' = isWindows+isPathSeparator _ = False+++-- | The character that is used to separate the entries in the $PATH environment variable.+--+-- > Windows: searchPathSeparator == ';'+-- > Posix:   searchPathSeparator == ':'+searchPathSeparator :: Char+searchPathSeparator = if isWindows then ';' else ':'++-- | Is the character a file separator?+--+-- > isSearchPathSeparator a == (a == searchPathSeparator)+isSearchPathSeparator :: Char -> Bool+isSearchPathSeparator = (== searchPathSeparator)+++-- | File extension character+--+-- > extSeparator == '.'+extSeparator :: Char+extSeparator = '.'++-- | Is the character an extension character?+--+-- > isExtSeparator a == (a == extSeparator)+isExtSeparator :: Char -> Bool+isExtSeparator = (== extSeparator)+++---------------------------------------------------------------------+-- Path methods (environment $PATH)++-- | Take a string, split it on the 'searchPathSeparator' character.+--   Blank items are ignored on Windows, and converted to @.@ on Posix.+--   On Windows path elements are stripped of quotes.+--+--   Follows the recommendations in+--   <http://www.opengroup.org/onlinepubs/009695399/basedefs/xbd_chap08.html>+--+-- > Posix:   splitSearchPath "File1:File2:File3"  == ["File1","File2","File3"]+-- > Posix:   splitSearchPath "File1::File2:File3" == ["File1",".","File2","File3"]+-- > Windows: splitSearchPath "File1;File2;File3"  == ["File1","File2","File3"]+-- > Windows: splitSearchPath "File1;;File2;File3" == ["File1","File2","File3"]+-- > Windows: splitSearchPath "File1;\"File2\";File3" == ["File1","File2","File3"]+splitSearchPath :: String -> [FilePath]+splitSearchPath = f+    where+    f xs = case break isSearchPathSeparator xs of+           (pre, []    ) -> g pre+           (pre, _:post) -> g pre ++ f post++    g "" = ["." | isPosix]+    g ('\"':x@(_:_)) | isWindows && last x == '\"' = [init x]+    g x = [x]+++-- | Get a list of 'FilePath's in the $PATH variable.+getSearchPath :: IO [FilePath]+getSearchPath = fmap splitSearchPath (getEnv "PATH")+++---------------------------------------------------------------------+-- Extension methods++-- | Split on the extension. 'addExtension' is the inverse.+--+-- > splitExtension "/directory/path.ext" == ("/directory/path",".ext")+-- > uncurry (++) (splitExtension x) == x+-- > Valid x => uncurry addExtension (splitExtension x) == x+-- > splitExtension "file.txt" == ("file",".txt")+-- > splitExtension "file" == ("file","")+-- > splitExtension "file/file.txt" == ("file/file",".txt")+-- > splitExtension "file.txt/boris" == ("file.txt/boris","")+-- > splitExtension "file.txt/boris.ext" == ("file.txt/boris",".ext")+-- > splitExtension "file/path.txt.bob.fred" == ("file/path.txt.bob",".fred")+-- > splitExtension "file/path.txt/" == ("file/path.txt/","")+splitExtension :: FilePath -> (String, String)+splitExtension x = case nameDot of+                       "" -> (x,"")+                       _ -> (dir ++ init nameDot, extSeparator : ext)+    where+        (dir,file) = splitFileName_ x+        (nameDot,ext) = breakEnd isExtSeparator file++-- | Get the extension of a file, returns @\"\"@ for no extension, @.ext@ otherwise.+--+-- > takeExtension "/directory/path.ext" == ".ext"+-- > takeExtension x == snd (splitExtension x)+-- > Valid x => takeExtension (addExtension x "ext") == ".ext"+-- > Valid x => takeExtension (replaceExtension x "ext") == ".ext"+takeExtension :: FilePath -> String+takeExtension = snd . splitExtension++-- | Remove the current extension and add another, equivalent to 'replaceExtension'.+--+-- > "/directory/path.txt" -<.> "ext" == "/directory/path.ext"+-- > "/directory/path.txt" -<.> ".ext" == "/directory/path.ext"+-- > "foo.o" -<.> "c" == "foo.c"+(-<.>) :: FilePath -> String -> FilePath+(-<.>) = replaceExtension++-- | Set the extension of a file, overwriting one if already present, equivalent to '-<.>'.+--+-- > replaceExtension "/directory/path.txt" "ext" == "/directory/path.ext"+-- > replaceExtension "/directory/path.txt" ".ext" == "/directory/path.ext"+-- > replaceExtension "file.txt" ".bob" == "file.bob"+-- > replaceExtension "file.txt" "bob" == "file.bob"+-- > replaceExtension "file" ".bob" == "file.bob"+-- > replaceExtension "file.txt" "" == "file"+-- > replaceExtension "file.fred.bob" "txt" == "file.fred.txt"+-- > replaceExtension x y == addExtension (dropExtension x) y+replaceExtension :: FilePath -> String -> FilePath+replaceExtension x y = dropExtension x <.> y++-- | Add an extension, even if there is already one there, equivalent to 'addExtension'.+--+-- > "/directory/path" <.> "ext" == "/directory/path.ext"+-- > "/directory/path" <.> ".ext" == "/directory/path.ext"+(<.>) :: FilePath -> String -> FilePath+(<.>) = addExtension++-- | Remove last extension, and the \".\" preceding it.+--+-- > dropExtension "/directory/path.ext" == "/directory/path"+-- > dropExtension x == fst (splitExtension x)+dropExtension :: FilePath -> FilePath+dropExtension = fst . splitExtension++-- | Add an extension, even if there is already one there, equivalent to '<.>'.+--+-- > addExtension "/directory/path" "ext" == "/directory/path.ext"+-- > addExtension "file.txt" "bib" == "file.txt.bib"+-- > addExtension "file." ".bib" == "file..bib"+-- > addExtension "file" ".bib" == "file.bib"+-- > addExtension "/" "x" == "/.x"+-- > addExtension x "" == x+-- > Valid x => takeFileName (addExtension (addTrailingPathSeparator x) "ext") == ".ext"+-- > Windows: addExtension "\\\\share" ".txt" == "\\\\share\\.txt"+addExtension :: FilePath -> String -> FilePath+addExtension file "" = file+addExtension file xs@(x:_) = joinDrive a res+    where+        res = if isExtSeparator x then b ++ xs+              else b ++ [extSeparator] ++ xs++        (a,b) = splitDrive file++-- | Does the given filename have an extension?+--+-- > hasExtension "/directory/path.ext" == True+-- > hasExtension "/directory/path" == False+-- > null (takeExtension x) == not (hasExtension x)+hasExtension :: FilePath -> Bool+hasExtension = any isExtSeparator . takeFileName+++-- | Does the given filename have the specified extension?+--+-- > "png" `isExtensionOf` "/directory/file.png" == True+-- > ".png" `isExtensionOf` "/directory/file.png" == True+-- > ".tar.gz" `isExtensionOf` "bar/foo.tar.gz" == True+-- > "ar.gz" `isExtensionOf` "bar/foo.tar.gz" == False+-- > "png" `isExtensionOf` "/directory/file.png.jpg" == False+-- > "csv/table.csv" `isExtensionOf` "/data/csv/table.csv" == False+isExtensionOf :: String -> FilePath -> Bool+isExtensionOf ext@('.':_) = isSuffixOf ext . takeExtensions+isExtensionOf ext         = isSuffixOf ('.':ext) . takeExtensions++-- | Drop the given extension from a FilePath, and the @\".\"@ preceding it.+--   Returns 'Nothing' if the FilePath does not have the given extension, or+--   'Just' and the part before the extension if it does.+--+--   This function can be more predictable than 'dropExtensions', especially if the filename+--   might itself contain @.@ characters.+--+-- > stripExtension "hs.o" "foo.x.hs.o" == Just "foo.x"+-- > stripExtension "hi.o" "foo.x.hs.o" == Nothing+-- > dropExtension x == fromJust (stripExtension (takeExtension x) x)+-- > dropExtensions x == fromJust (stripExtension (takeExtensions x) x)+-- > stripExtension ".c.d" "a.b.c.d"  == Just "a.b"+-- > stripExtension ".c.d" "a.b..c.d" == Just "a.b."+-- > stripExtension "baz"  "foo.bar"  == Nothing+-- > stripExtension "bar"  "foobar"   == Nothing+-- > stripExtension ""     x          == Just x+stripExtension :: String -> FilePath -> Maybe FilePath+stripExtension []        path = Just path+stripExtension ext@(x:_) path = stripSuffix dotExt path+    where dotExt = if isExtSeparator x then ext else '.':ext+++-- | Split on all extensions.+--+-- > splitExtensions "/directory/path.ext" == ("/directory/path",".ext")+-- > splitExtensions "file.tar.gz" == ("file",".tar.gz")+-- > uncurry (++) (splitExtensions x) == x+-- > Valid x => uncurry addExtension (splitExtensions x) == x+-- > splitExtensions "file.tar.gz" == ("file",".tar.gz")+splitExtensions :: FilePath -> (FilePath, String)+splitExtensions x = (a ++ c, d)+    where+        (a,b) = splitFileName_ x+        (c,d) = break isExtSeparator b++-- | Drop all extensions.+--+-- > dropExtensions "/directory/path.ext" == "/directory/path"+-- > dropExtensions "file.tar.gz" == "file"+-- > not $ hasExtension $ dropExtensions x+-- > not $ any isExtSeparator $ takeFileName $ dropExtensions x+dropExtensions :: FilePath -> FilePath+dropExtensions = fst . splitExtensions++-- | Get all extensions.+--+-- > takeExtensions "/directory/path.ext" == ".ext"+-- > takeExtensions "file.tar.gz" == ".tar.gz"+takeExtensions :: FilePath -> String+takeExtensions = snd . splitExtensions+++-- | Replace all extensions of a file with a new extension. Note+--   that 'replaceExtension' and 'addExtension' both work for adding+--   multiple extensions, so only required when you need to drop+--   all extensions first.+--+-- > replaceExtensions "file.fred.bob" "txt" == "file.txt"+-- > replaceExtensions "file.fred.bob" "tar.gz" == "file.tar.gz"+replaceExtensions :: FilePath -> String -> FilePath+replaceExtensions x y = dropExtensions x <.> y++++---------------------------------------------------------------------+-- Drive methods++-- | Is the given character a valid drive letter?+-- only a-z and A-Z are letters, not isAlpha which is more unicodey+isLetter :: Char -> Bool+isLetter x = isAsciiLower x || isAsciiUpper x+++-- | Split a path into a drive and a path.+--   On Posix, \/ is a Drive.+--+-- > uncurry (++) (splitDrive x) == x+-- > Windows: splitDrive "file" == ("","file")+-- > Windows: splitDrive "c:/file" == ("c:/","file")+-- > Windows: splitDrive "c:\\file" == ("c:\\","file")+-- > Windows: splitDrive "\\\\shared\\test" == ("\\\\shared\\","test")+-- > Windows: splitDrive "\\\\shared" == ("\\\\shared","")+-- > Windows: splitDrive "\\\\?\\UNC\\shared\\file" == ("\\\\?\\UNC\\shared\\","file")+-- > Windows: splitDrive "\\\\?\\UNCshared\\file" == ("\\\\?\\","UNCshared\\file")+-- > Windows: splitDrive "\\\\?\\d:\\file" == ("\\\\?\\d:\\","file")+-- > Windows: splitDrive "/d" == ("","/d")+-- > Posix:   splitDrive "/test" == ("/","test")+-- > Posix:   splitDrive "//test" == ("//","test")+-- > Posix:   splitDrive "test/file" == ("","test/file")+-- > Posix:   splitDrive "file" == ("","file")+splitDrive :: FilePath -> (FilePath, FilePath)+splitDrive x | isPosix = span (== '/') x+splitDrive x | Just y <- readDriveLetter x = y+splitDrive x | Just y <- readDriveUNC x = y+splitDrive x | Just y <- readDriveShare x = y+splitDrive x = ("",x)++addSlash :: FilePath -> FilePath -> (FilePath, FilePath)+addSlash a xs = (a++c,d)+    where (c,d) = span isPathSeparator xs++-- See [1].+-- "\\?\D:\<path>" or "\\?\UNC\<server>\<share>"+readDriveUNC :: FilePath -> Maybe (FilePath, FilePath)+readDriveUNC (s1:s2:'?':s3:xs) | all isPathSeparator [s1,s2,s3] =+    case map toUpper xs of+        ('U':'N':'C':s4:_) | isPathSeparator s4 ->+            let (a,b) = readDriveShareName (drop 4 xs)+            in Just (s1:s2:'?':s3:take 4 xs ++ a, b)+        _ -> case readDriveLetter xs of+                 -- Extended-length path.+                 Just (a,b) -> Just (s1:s2:'?':s3:a,b)+                 Nothing -> Nothing+readDriveUNC _ = Nothing++{- c:\ -}+readDriveLetter :: String -> Maybe (FilePath, FilePath)+readDriveLetter (x:':':y:xs) | isLetter x && isPathSeparator y = Just $ addSlash [x,':'] (y:xs)+readDriveLetter (x:':':xs) | isLetter x = Just ([x,':'], xs)+readDriveLetter _ = Nothing++{- \\sharename\ -}+readDriveShare :: String -> Maybe (FilePath, FilePath)+readDriveShare (s1:s2:xs) | isPathSeparator s1 && isPathSeparator s2 =+        Just (s1:s2:a,b)+    where (a,b) = readDriveShareName xs+readDriveShare _ = Nothing++{- assume you have already seen \\ -}+{- share\bob -> "share\", "bob" -}+readDriveShareName :: String -> (FilePath, FilePath)+readDriveShareName name = addSlash a b+    where (a,b) = break isPathSeparator name++++-- | Join a drive and the rest of the path.+--+-- > Valid x => uncurry joinDrive (splitDrive x) == x+-- > Windows: joinDrive "C:" "foo" == "C:foo"+-- > Windows: joinDrive "C:\\" "bar" == "C:\\bar"+-- > Windows: joinDrive "\\\\share" "foo" == "\\\\share\\foo"+-- > Windows: joinDrive "/:" "foo" == "/:\\foo"+joinDrive :: FilePath -> FilePath -> FilePath+joinDrive = combineAlways++-- | Get the drive from a filepath.+--+-- > takeDrive x == fst (splitDrive x)+takeDrive :: FilePath -> FilePath+takeDrive = fst . splitDrive++-- | Delete the drive, if it exists.+--+-- > dropDrive x == snd (splitDrive x)+dropDrive :: FilePath -> FilePath+dropDrive = snd . splitDrive++-- | Does a path have a drive.+--+-- > not (hasDrive x) == null (takeDrive x)+-- > Posix:   hasDrive "/foo" == True+-- > Windows: hasDrive "C:\\foo" == True+-- > Windows: hasDrive "C:foo" == True+-- >          hasDrive "foo" == False+-- >          hasDrive "" == False+hasDrive :: FilePath -> Bool+hasDrive = not . null . takeDrive+++-- | Is an element a drive+--+-- > Posix:   isDrive "/" == True+-- > Posix:   isDrive "/foo" == False+-- > Windows: isDrive "C:\\" == True+-- > Windows: isDrive "C:\\foo" == False+-- >          isDrive "" == False+isDrive :: FilePath -> Bool+isDrive x = not (null x) && null (dropDrive x)+++---------------------------------------------------------------------+-- Operations on a filepath, as a list of directories++-- | Split a filename into directory and file. '</>' is the inverse.+--   The first component will often end with a trailing slash.+--+-- > splitFileName "/directory/file.ext" == ("/directory/","file.ext")+-- > Valid x => uncurry (</>) (splitFileName x) == x || fst (splitFileName x) == "./"+-- > Valid x => isValid (fst (splitFileName x))+-- > splitFileName "file/bob.txt" == ("file/", "bob.txt")+-- > splitFileName "file/" == ("file/", "")+-- > splitFileName "bob" == ("./", "bob")+-- > Posix:   splitFileName "/" == ("/","")+-- > Windows: splitFileName "c:" == ("c:","")+splitFileName :: FilePath -> (String, String)+splitFileName x = (if null dir then "./" else dir, name)+    where+        (dir, name) = splitFileName_ x++-- version of splitFileName where, if the FilePath has no directory+-- component, the returned directory is "" rather than "./".  This+-- is used in cases where we are going to combine the returned+-- directory to make a valid FilePath, and having a "./" appear would+-- look strange and upset simple equality properties.  See+-- e.g. replaceFileName.+splitFileName_ :: FilePath -> (String, String)+splitFileName_ x = (drv ++ dir, file)+    where+        (drv,pth) = splitDrive x+        (dir,file) = breakEnd isPathSeparator pth++-- | Set the filename.+--+-- > replaceFileName "/directory/other.txt" "file.ext" == "/directory/file.ext"+-- > Valid x => replaceFileName x (takeFileName x) == x+replaceFileName :: FilePath -> String -> FilePath+replaceFileName x y = a </> y where (a,_) = splitFileName_ x++-- | Drop the filename. Unlike 'takeDirectory', this function will leave+--   a trailing path separator on the directory.+--+-- > dropFileName "/directory/file.ext" == "/directory/"+-- > dropFileName x == fst (splitFileName x)+dropFileName :: FilePath -> FilePath+dropFileName = fst . splitFileName+++-- | Get the file name.+--+-- > takeFileName "/directory/file.ext" == "file.ext"+-- > takeFileName "test/" == ""+-- > takeFileName x `isSuffixOf` x+-- > takeFileName x == snd (splitFileName x)+-- > Valid x => takeFileName (replaceFileName x "fred") == "fred"+-- > Valid x => takeFileName (x </> "fred") == "fred"+-- > Valid x => isRelative (takeFileName x)+takeFileName :: FilePath -> FilePath+takeFileName = snd . splitFileName++-- | Get the base name, without an extension or path.+--+-- > takeBaseName "/directory/file.ext" == "file"+-- > takeBaseName "file/test.txt" == "test"+-- > takeBaseName "dave.ext" == "dave"+-- > takeBaseName "" == ""+-- > takeBaseName "test" == "test"+-- > takeBaseName (addTrailingPathSeparator x) == ""+-- > takeBaseName "file/file.tar.gz" == "file.tar"+takeBaseName :: FilePath -> String+takeBaseName = dropExtension . takeFileName++-- | Set the base name.+--+-- > replaceBaseName "/directory/other.ext" "file" == "/directory/file.ext"+-- > replaceBaseName "file/test.txt" "bob" == "file/bob.txt"+-- > replaceBaseName "fred" "bill" == "bill"+-- > replaceBaseName "/dave/fred/bob.gz.tar" "new" == "/dave/fred/new.tar"+-- > Valid x => replaceBaseName x (takeBaseName x) == x+replaceBaseName :: FilePath -> String -> FilePath+replaceBaseName pth nam = combineAlways a (nam <.> ext)+    where+        (a,b) = splitFileName_ pth+        ext = takeExtension b++-- | Is an item either a directory or the last character a path separator?+--+-- > hasTrailingPathSeparator "test" == False+-- > hasTrailingPathSeparator "test/" == True+hasTrailingPathSeparator :: FilePath -> Bool+hasTrailingPathSeparator "" = False+hasTrailingPathSeparator x = isPathSeparator (last x)+++hasLeadingPathSeparator :: FilePath -> Bool+hasLeadingPathSeparator "" = False+hasLeadingPathSeparator x = isPathSeparator (head x)+++-- | Add a trailing file path separator if one is not already present.+--+-- > hasTrailingPathSeparator (addTrailingPathSeparator x)+-- > hasTrailingPathSeparator x ==> addTrailingPathSeparator x == x+-- > Posix:    addTrailingPathSeparator "test/rest" == "test/rest/"+addTrailingPathSeparator :: FilePath -> FilePath+addTrailingPathSeparator x = if hasTrailingPathSeparator x then x else x ++ [pathSeparator]+++-- | Remove any trailing path separators+--+-- > dropTrailingPathSeparator "file/test/" == "file/test"+-- >           dropTrailingPathSeparator "/" == "/"+-- > Windows:  dropTrailingPathSeparator "\\" == "\\"+-- > Posix:    not (hasTrailingPathSeparator (dropTrailingPathSeparator x)) || isDrive x+dropTrailingPathSeparator :: FilePath -> FilePath+dropTrailingPathSeparator x =+    if hasTrailingPathSeparator x && not (isDrive x)+    then let x' = dropWhileEnd isPathSeparator x+         in if null x' then [last x] else x'+    else x+++-- | Get the directory name, move up one level.+--+-- >           takeDirectory "/directory/other.ext" == "/directory"+-- >           takeDirectory x `isPrefixOf` x || takeDirectory x == "."+-- >           takeDirectory "foo" == "."+-- >           takeDirectory "/" == "/"+-- >           takeDirectory "/foo" == "/"+-- >           takeDirectory "/foo/bar/baz" == "/foo/bar"+-- >           takeDirectory "/foo/bar/baz/" == "/foo/bar/baz"+-- >           takeDirectory "foo/bar/baz" == "foo/bar"+-- > Windows:  takeDirectory "foo\\bar" == "foo"+-- > Windows:  takeDirectory "foo\\bar\\\\" == "foo\\bar"+-- > Windows:  takeDirectory "C:\\" == "C:\\"+takeDirectory :: FilePath -> FilePath+takeDirectory = dropTrailingPathSeparator . dropFileName++-- | Set the directory, keeping the filename the same.+--+-- > replaceDirectory "root/file.ext" "/directory/" == "/directory/file.ext"+-- > Valid x => replaceDirectory x (takeDirectory x) `equalFilePath` x+replaceDirectory :: FilePath -> String -> FilePath+replaceDirectory x dir = combineAlways dir (takeFileName x)+++-- | An alias for '</>'.+combine :: FilePath -> FilePath -> FilePath+combine a b | hasLeadingPathSeparator b || hasDrive b = b+            | otherwise = combineAlways a b++-- | Combine two paths, assuming rhs is NOT absolute.+combineAlways :: FilePath -> FilePath -> FilePath+combineAlways a b | null a = b+                  | null b = a+                  | hasTrailingPathSeparator a = a ++ b+                  | otherwise = case a of+                      [a1,':'] | isWindows && isLetter a1 -> a ++ b+                      _ -> a ++ [pathSeparator] ++ b+++-- | Combine two paths with a path separator.+--   If the second path starts with a path separator or a drive letter, then it returns the second.+--   The intention is that @readFile (dir '</>' file)@ will access the same file as+--   @setCurrentDirectory dir; readFile file@.+--+-- > Posix:   "/directory" </> "file.ext" == "/directory/file.ext"+-- > Windows: "/directory" </> "file.ext" == "/directory\\file.ext"+-- >          "directory" </> "/file.ext" == "/file.ext"+-- > Valid x => (takeDirectory x </> takeFileName x) `equalFilePath` x+--+--   Combined:+--+-- > Posix:   "/" </> "test" == "/test"+-- > Posix:   "home" </> "bob" == "home/bob"+-- > Posix:   "x:" </> "foo" == "x:/foo"+-- > Windows: "C:\\foo" </> "bar" == "C:\\foo\\bar"+-- > Windows: "home" </> "bob" == "home\\bob"+--+--   Not combined:+--+-- > Posix:   "home" </> "/bob" == "/bob"+-- > Windows: "home" </> "C:\\bob" == "C:\\bob"+--+--   Not combined (tricky):+--+--   On Windows, if a filepath starts with a single slash, it is relative to the+--   root of the current drive. In [1], this is (confusingly) referred to as an+--   absolute path.+--   The current behavior of '</>' is to never combine these forms.+--+-- > Windows: "home" </> "/bob" == "/bob"+-- > Windows: "home" </> "\\bob" == "\\bob"+-- > Windows: "C:\\home" </> "\\bob" == "\\bob"+--+--   On Windows, from [1]: "If a file name begins with only a disk designator+--   but not the backslash after the colon, it is interpreted as a relative path+--   to the current directory on the drive with the specified letter."+--   The current behavior of '</>' is to never combine these forms.+--+-- > Windows: "D:\\foo" </> "C:bar" == "C:bar"+-- > Windows: "C:\\foo" </> "C:bar" == "C:bar"+(</>) :: FilePath -> FilePath -> FilePath+(</>) = combine+++-- | Split a path by the directory separator.+--+-- > splitPath "/directory/file.ext" == ["/","directory/","file.ext"]+-- > concat (splitPath x) == x+-- > splitPath "test//item/" == ["test//","item/"]+-- > splitPath "test/item/file" == ["test/","item/","file"]+-- > splitPath "" == []+-- > Windows: splitPath "c:\\test\\path" == ["c:\\","test\\","path"]+-- > Posix:   splitPath "/file/test" == ["/","file/","test"]+splitPath :: FilePath -> [FilePath]+splitPath x = [drive | drive /= ""] ++ f path+    where+        (drive,path) = splitDrive x++        f "" = []+        f y = (a++c) : f d+            where+                (a,b) = break isPathSeparator y+                (c,d) = span  isPathSeparator b++-- | Just as 'splitPath', but don't add the trailing slashes to each element.+--+-- >          splitDirectories "/directory/file.ext" == ["/","directory","file.ext"]+-- >          splitDirectories "test/file" == ["test","file"]+-- >          splitDirectories "/test/file" == ["/","test","file"]+-- > Windows: splitDirectories "C:\\test\\file" == ["C:\\", "test", "file"]+-- >          Valid x => joinPath (splitDirectories x) `equalFilePath` x+-- >          splitDirectories "" == []+-- > Windows: splitDirectories "C:\\test\\\\\\file" == ["C:\\", "test", "file"]+-- >          splitDirectories "/test///file" == ["/","test","file"]+splitDirectories :: FilePath -> [FilePath]+splitDirectories = map dropTrailingPathSeparator . splitPath+++-- | Join path elements back together.+--+-- > joinPath a == foldr (</>) "" a+-- > joinPath ["/","directory/","file.ext"] == "/directory/file.ext"+-- > Valid x => joinPath (splitPath x) == x+-- > joinPath [] == ""+-- > Posix: joinPath ["test","file","path"] == "test/file/path"+joinPath :: [FilePath] -> FilePath+-- Note that this definition on c:\\c:\\, join then split will give c:\\.+joinPath = foldr combine ""+++++++---------------------------------------------------------------------+-- File name manipulators++-- | Equality of two 'FilePath's.+--   If you call @System.Directory.canonicalizePath@+--   first this has a much better chance of working.+--   Note that this doesn't follow symlinks or DOSNAM~1s.+--+-- Similar to 'normalise', this does not expand @".."@, because of symlinks.+--+-- >          x == y ==> equalFilePath x y+-- >          normalise x == normalise y ==> equalFilePath x y+-- >          equalFilePath "foo" "foo/"+-- >          not (equalFilePath "/a/../c" "/c")+-- >          not (equalFilePath "foo" "/foo")+-- > Posix:   not (equalFilePath "foo" "FOO")+-- > Windows: equalFilePath "foo" "FOO"+-- > Windows: not (equalFilePath "C:" "C:/")+equalFilePath :: FilePath -> FilePath -> Bool+equalFilePath a b = f a == f b+    where+        f x | isWindows = dropTrailingPathSeparator $ map toLower $ normalise x+            | otherwise = dropTrailingPathSeparator $ normalise x+++-- | Contract a filename, based on a relative path. Note that the resulting path+--   will never introduce @..@ paths, as the presence of symlinks means @..\/b@+--   may not reach @a\/b@ if it starts from @a\/c@. For a worked example see+--   <http://neilmitchell.blogspot.co.uk/2015/10/filepaths-are-subtle-symlinks-are-hard.html this blog post>.+--+--   The corresponding @makeAbsolute@ function can be found in+--   @System.Directory@.+--+-- >          makeRelative "/directory" "/directory/file.ext" == "file.ext"+-- >          Valid x => makeRelative (takeDirectory x) x `equalFilePath` takeFileName x+-- >          makeRelative x x == "."+-- >          Valid x y => equalFilePath x y || (isRelative x && makeRelative y x == x) || equalFilePath (y </> makeRelative y x) x+-- > Windows: makeRelative "C:\\Home" "c:\\home\\bob" == "bob"+-- > Windows: makeRelative "C:\\Home" "c:/home/bob" == "bob"+-- > Windows: makeRelative "C:\\Home" "D:\\Home\\Bob" == "D:\\Home\\Bob"+-- > Windows: makeRelative "C:\\Home" "C:Home\\Bob" == "C:Home\\Bob"+-- > Windows: makeRelative "/Home" "/home/bob" == "bob"+-- > Windows: makeRelative "/" "//" == "//"+-- > Posix:   makeRelative "/Home" "/home/bob" == "/home/bob"+-- > Posix:   makeRelative "/home/" "/home/bob/foo/bar" == "bob/foo/bar"+-- > Posix:   makeRelative "/fred" "bob" == "bob"+-- > Posix:   makeRelative "/file/test" "/file/test/fred" == "fred"+-- > Posix:   makeRelative "/file/test" "/file/test/fred/" == "fred/"+-- > Posix:   makeRelative "some/path" "some/path/a/b/c" == "a/b/c"+makeRelative :: FilePath -> FilePath -> FilePath+makeRelative root path+ | equalFilePath root path = "."+ | takeAbs root /= takeAbs path = path+ | otherwise = f (dropAbs root) (dropAbs path)+    where+        f "" y = dropWhile isPathSeparator y+        f x y = let (x1,x2) = g x+                    (y1,y2) = g y+                in if equalFilePath x1 y1 then f x2 y2 else path++        g x = (dropWhile isPathSeparator a, dropWhile isPathSeparator b)+            where (a,b) = break isPathSeparator $ dropWhile isPathSeparator x++        -- on windows, need to drop '/' which is kind of absolute, but not a drive+        dropAbs x | hasLeadingPathSeparator x && not (hasDrive x) = tail x+        dropAbs x = dropDrive x++        takeAbs x | hasLeadingPathSeparator x && not (hasDrive x) = [pathSeparator]+        takeAbs x = map (\y -> if isPathSeparator y then pathSeparator else toLower y) $ takeDrive x++-- | Normalise a file+--+-- * \/\/ outside of the drive can be made blank+--+-- * \/ -> 'pathSeparator'+--+-- * .\/ -> \"\"+--+-- Does not remove @".."@, because of symlinks.+--+-- > Posix:   normalise "/file/\\test////" == "/file/\\test/"+-- > Posix:   normalise "/file/./test" == "/file/test"+-- > Posix:   normalise "/test/file/../bob/fred/" == "/test/file/../bob/fred/"+-- > Posix:   normalise "../bob/fred/" == "../bob/fred/"+-- > Posix:   normalise "/a/../c" == "/a/../c"+-- > Posix:   normalise "./bob/fred/" == "bob/fred/"+-- > Windows: normalise "c:\\file/bob\\" == "C:\\file\\bob\\"+-- > Windows: normalise "c:\\" == "C:\\"+-- > Windows: normalise "C:.\\" == "C:"+-- > Windows: normalise "\\\\server\\test" == "\\\\server\\test"+-- > Windows: normalise "//server/test" == "\\\\server\\test"+-- > Windows: normalise "c:/file" == "C:\\file"+-- > Windows: normalise "/file" == "\\file"+-- > Windows: normalise "\\" == "\\"+-- > Windows: normalise "/./" == "\\"+-- >          normalise "." == "."+-- > Posix:   normalise "./" == "./"+-- > Posix:   normalise "./." == "./"+-- > Posix:   normalise "/./" == "/"+-- > Posix:   normalise "/" == "/"+-- > Posix:   normalise "bob/fred/." == "bob/fred/"+-- > Posix:   normalise "//home" == "/home"+normalise :: FilePath -> FilePath+normalise path = result ++ [pathSeparator | addPathSeparator]+    where+        (drv,pth) = splitDrive path+        result = joinDrive' (normaliseDrive drv) (f pth)++        joinDrive' "" "" = "."+        joinDrive' d p = joinDrive d p++        addPathSeparator = isDirPath pth+            && not (hasTrailingPathSeparator result)+            && not (isRelativeDrive drv)++        isDirPath xs = hasTrailingPathSeparator xs+            || not (null xs) && last xs == '.' && hasTrailingPathSeparator (init xs)++        f = joinPath . dropDots . propSep . splitDirectories++        propSep (x:xs) | all isPathSeparator x = [pathSeparator] : xs+                       | otherwise = x : xs+        propSep [] = []++        dropDots = filter ("." /=)++normaliseDrive :: FilePath -> FilePath+normaliseDrive "" = ""+normaliseDrive _ | isPosix = [pathSeparator]+normaliseDrive drive = if isJust $ readDriveLetter x2+                       then map toUpper x2+                       else x2+    where+        x2 = map repSlash drive++        repSlash x = if isPathSeparator x then pathSeparator else x++-- Information for validity functions on Windows. See [1].+isBadCharacter :: Char -> Bool+isBadCharacter x = x >= '\0' && x <= '\31' || x `elem` ":*?><|\""++badElements :: [FilePath]+badElements =+    ["CON","PRN","AUX","NUL","CLOCK$"+    ,"COM1","COM2","COM3","COM4","COM5","COM6","COM7","COM8","COM9"+    ,"LPT1","LPT2","LPT3","LPT4","LPT5","LPT6","LPT7","LPT8","LPT9"]+++-- | Is a FilePath valid, i.e. could you create a file like it? This function checks for invalid names,+--   and invalid characters, but does not check if length limits are exceeded, as these are typically+--   filesystem dependent.+--+-- >          isValid "" == False+-- >          isValid "\0" == False+-- > Posix:   isValid "/random_ path:*" == True+-- > Posix:   isValid x == not (null x)+-- > Windows: isValid "c:\\test" == True+-- > Windows: isValid "c:\\test:of_test" == False+-- > Windows: isValid "test*" == False+-- > Windows: isValid "c:\\test\\nul" == False+-- > Windows: isValid "c:\\test\\prn.txt" == False+-- > Windows: isValid "c:\\nul\\file" == False+-- > Windows: isValid "\\\\" == False+-- > Windows: isValid "\\\\\\foo" == False+-- > Windows: isValid "\\\\?\\D:file" == False+-- > Windows: isValid "foo\tbar" == False+-- > Windows: isValid "nul .txt" == False+-- > Windows: isValid " nul.txt" == True+isValid :: FilePath -> Bool+isValid "" = False+isValid x | '\0' `elem` x = False+isValid _ | isPosix = True+isValid path =+        not (any isBadCharacter x2) &&+        not (any f $ splitDirectories x2) &&+        not (isJust (readDriveShare x1) && all isPathSeparator x1) &&+        not (isJust (readDriveUNC x1) && not (hasTrailingPathSeparator x1))+    where+        (x1,x2) = splitDrive path+        f x = map toUpper (dropWhileEnd (== ' ') $ dropExtensions x) `elem` badElements+++-- | Take a FilePath and make it valid; does not change already valid FilePaths.+--+-- > isValid (makeValid x)+-- > isValid x ==> makeValid x == x+-- > makeValid "" == "_"+-- > makeValid "file\0name" == "file_name"+-- > Windows: makeValid "c:\\already\\/valid" == "c:\\already\\/valid"+-- > Windows: makeValid "c:\\test:of_test" == "c:\\test_of_test"+-- > Windows: makeValid "test*" == "test_"+-- > Windows: makeValid "c:\\test\\nul" == "c:\\test\\nul_"+-- > Windows: makeValid "c:\\test\\prn.txt" == "c:\\test\\prn_.txt"+-- > Windows: makeValid "c:\\test/prn.txt" == "c:\\test/prn_.txt"+-- > Windows: makeValid "c:\\nul\\file" == "c:\\nul_\\file"+-- > Windows: makeValid "\\\\\\foo" == "\\\\drive"+-- > Windows: makeValid "\\\\?\\D:file" == "\\\\?\\D:\\file"+-- > Windows: makeValid "nul .txt" == "nul _.txt"+makeValid :: FilePath -> FilePath+makeValid "" = "_"+makeValid path+        | isPosix = map (\x -> if x == '\0' then '_' else x) path+        | isJust (readDriveShare drv) && all isPathSeparator drv = take 2 drv ++ "drive"+        | isJust (readDriveUNC drv) && not (hasTrailingPathSeparator drv) =+            makeValid (drv ++ [pathSeparator] ++ pth)+        | otherwise = joinDrive drv $ validElements $ validChars pth+    where+        (drv,pth) = splitDrive path++        validChars = map f+        f x = if isBadCharacter x then '_' else x++        validElements x = joinPath $ map g $ splitPath x+        g x = h a ++ b+            where (a,b) = break isPathSeparator x+        h x = if map toUpper (dropWhileEnd (== ' ') a) `elem` badElements then a ++ "_" <.> b else x+            where (a,b) = splitExtensions x+++-- | Is a path relative, or is it fixed to the root?+--+-- > Windows: isRelative "path\\test" == True+-- > Windows: isRelative "c:\\test" == False+-- > Windows: isRelative "c:test" == True+-- > Windows: isRelative "c:\\" == False+-- > Windows: isRelative "c:/" == False+-- > Windows: isRelative "c:" == True+-- > Windows: isRelative "\\\\foo" == False+-- > Windows: isRelative "\\\\?\\foo" == False+-- > Windows: isRelative "\\\\?\\UNC\\foo" == False+-- > Windows: isRelative "/foo" == True+-- > Windows: isRelative "\\foo" == True+-- > Posix:   isRelative "test/path" == True+-- > Posix:   isRelative "/test" == False+-- > Posix:   isRelative "/" == False+--+-- According to [1]:+--+-- * "A UNC name of any format [is never relative]."+--+-- * "You cannot use the "\\?\" prefix with a relative path."+isRelative :: FilePath -> Bool+isRelative x = null drive || isRelativeDrive drive+    where drive = takeDrive x+++{- c:foo -}+-- From [1]: "If a file name begins with only a disk designator but not the+-- backslash after the colon, it is interpreted as a relative path to the+-- current directory on the drive with the specified letter."+isRelativeDrive :: String -> Bool+isRelativeDrive x =+    maybe False (not . hasTrailingPathSeparator . fst) (readDriveLetter x)+++-- | @not . 'isRelative'@+--+-- > isAbsolute x == not (isRelative x)+isAbsolute :: FilePath -> Bool+isAbsolute = not . isRelative+++-----------------------------------------------------------------------------+-- dropWhileEnd (>2) [1,2,3,4,1,2,3,4] == [1,2,3,4,1,2])+-- Note that Data.List.dropWhileEnd is only available in base >= 4.5.+dropWhileEnd :: (a -> Bool) -> [a] -> [a]+dropWhileEnd p = reverse . dropWhile p . reverse++-- takeWhileEnd (>2) [1,2,3,4,1,2,3,4] == [3,4])+takeWhileEnd :: (a -> Bool) -> [a] -> [a]+takeWhileEnd p = reverse . takeWhile p . reverse++-- spanEnd (>2) [1,2,3,4,1,2,3,4] = ([1,2,3,4,1,2], [3,4])+spanEnd :: (a -> Bool) -> [a] -> ([a], [a])+spanEnd p xs = (dropWhileEnd p xs, takeWhileEnd p xs)++-- breakEnd (< 2) [1,2,3,4,1,2,3,4] == ([1,2,3,4,1],[2,3,4])+breakEnd :: (a -> Bool) -> [a] -> ([a], [a])+breakEnd p = spanEnd (not . p)++-- | The stripSuffix function drops the given suffix from a list. It returns+-- Nothing if the list did not end with the suffix given, or Just the list+-- before the suffix, if it does.+stripSuffix :: Eq a => [a] -> [a] -> Maybe [a]+stripSuffix xs ys = fmap reverse $ stripPrefix (reverse xs) (reverse ys)