path-extra 0.2.0 → 0.3.0
raw patch · 3 files changed
+127/−90 lines, 3 filesdep ~basedep ~path
Dependency ranges changed: base, path
Files
- README.md +4/−30
- path-extra.cabal +11/−11
- src/Path/Extended.hs +112/−49
README.md view
@@ -1,31 +1,5 @@-# path-REST--TODO: Write description here--## Installation--TODO: Write installation instructions here--## Usage--### Creating `x`--TODO: Write usage instructions here--### Combining `x`--TODO: Write usage instructions here--### Consuming `x`--TODO: Write usage instructions here--## How to run tests--```-cabal configure --enable-tests && cabal build && cabal test-```--## Contributing+# path-extra -TODO: Write contribution instructions here+This package tries to add a few convenience functions to the+[https://hackage.haskell.org/package/path](path) library, namely the idea of a "Location" -+basically just a path, but with query string and fragment details.
path-extra.cabal view
@@ -1,24 +1,24 @@--- This file has been generated from package.yaml by hpack version 0.21.2.+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.35.2. -- -- see: https://github.com/sol/hpack ----- hash: 4604482be921c24c141cd64233a1fb7ef12012a76e45a51aacdfb5726aef5367+-- hash: 960287c20bb6f39c6a9ae6c22985774c943b509f75dfa7674b2b2c9c4b6951ac name: path-extra-version: 0.2.0+version: 0.3.0 synopsis: URLs without host information-description: Please see the README on Github at <https://github.com/githubuser/localcooking-db#readme>+description: Please see the README on Github at <https://github.com/athanclark/path-extra#readme> category: System, Filesystem, Web homepage: https://github.com/athanclark/path-extra#readme bug-reports: https://github.com/athanclark/path-extra/issues author: Athan Clark-maintainer: athan.clark@localcooking.com-copyright: Copyright (c) 2018 Athan Clark+maintainer: athan.clark@gmail.com+copyright: Copyright (c) 2023 Athan Clark license: BSD3 license-file: LICENSE build-type: Simple-cabal-version: >= 1.10- extra-source-files: README.md @@ -36,8 +36,8 @@ ghc-options: -Wall build-depends: attoparsec- , base >=4.8 && <5- , path+ , base >=4.11 && <5+ , path >=0.9 , text default-language: Haskell2010 @@ -52,7 +52,7 @@ build-depends: QuickCheck , attoparsec- , base >=4.8 && <5+ , base >=4.11 && <5 , path , path-extra , quickcheck-instances
src/Path/Extended.hs view
@@ -11,6 +11,7 @@ module Path.Extended ( -- * Types Location (..)+ , LocationPath (..) , QueryParam , -- * Classes ToPath (..)@@ -19,9 +20,10 @@ , FromLocation (..) , -- * Combinators -- ** Path- fromAbsDir- , fromAbsFile- , prepend+ fromDir+ , fromFile+ , prependAbs+ , prependRel , -- ** Query Parameters setQuery , addQuery@@ -36,19 +38,18 @@ , delFragment , getFragment , -- ** Parser & Printer- locationParser+ locationAbsParser+ , locationRelParser , printLocation ) where -- import Path as P hiding ((</>))-import Path (Path, Abs, Dir, File, (</>), toFilePath, parseAbsFile, parseAbsDir, stripProperPrefix, absdir)+import Path (Path, Abs, Rel, Dir, File, (</>), toFilePath, parseAbsFile, parseAbsDir, parseRelDir, parseRelFile, stripProperPrefix, absdir, reldir) import Prelude hiding (takeWhile)-import Data.List (intercalate)-import Data.Attoparsec.Text (Parser, char, takeWhile, takeWhile1, sepBy, sepBy1, many1)+import Data.Attoparsec.Text (Parser, char, takeWhile, takeWhile1, sepBy) import qualified Data.Text as T-import Data.Monoid ((<>))-import Control.Applicative (Alternative (many), (<|>), optional)+import Control.Applicative ((<|>), optional) import Control.Exception (SomeException) import Control.Monad (void) import GHC.Generics (Generic)@@ -62,58 +63,62 @@ -- | Convenience typeclass for symbolic, stringless routes - make an instance -- for your own data type to use your constructors as route-referencing symbols.-class ToLocation sym where- toLocation :: sym -> Location+class ToLocation sym base | sym -> base where+ toLocation :: sym -> Location base class FromPath sym base type' | sym -> base type' where parsePath :: Path base type' -> Either String sym -class FromLocation sym where- parseLocation :: Location -> Either String sym+class FromLocation sym base | sym -> base where+ parseLocation :: Location base -> Either String sym +data LocationPath base+ = Dir (Path base Dir)+ | File (Path base File)+ deriving (Eq, Ord, Generic) -- | A location for some base and type - internally uses @Path@.-data Location = Location- { locPath :: Either (Path Abs Dir) (Path Abs File)+data Location base = Location+ { locPath :: LocationPath base , locQueryParams :: [QueryParam] , locFragment :: Maybe String } deriving (Eq, Ord, Generic) -fromAbsDir :: Path Abs Dir -> Location-fromAbsDir path = Location- { locPath = Left path+fromDir :: Path base Dir -> Location base+fromDir path = Location+ { locPath = Dir path , locQueryParams = [] , locFragment = Nothing } -fromAbsFile :: Path Abs File -> Location-fromAbsFile path = Location- { locPath = Right path+fromFile :: Path base File -> Location base+fromFile path = Location+ { locPath = File path , locQueryParams = [] , locFragment = Nothing } -locationParser :: Parser Location-locationParser = do+locationAbsParser :: Parser (Location Abs)+locationAbsParser = do divider locPath <- do xs <- chunk `sepBy` divider case xs of- [] -> pure (Left [absdir|/|])+ [] -> pure $ Dir [absdir|/|] _ -> do let dir = do divider case parseAbsDir (T.unpack ("/" <> T.intercalate "/" xs <> "/")) of Left (e :: SomeException) -> fail (show e)- Right x -> pure (Left x)+ Right x -> pure (Dir x) file = case parseAbsFile (T.unpack ("/" <> T.intercalate "/" xs)) of Left (e :: SomeException) -> fail (show e)- Right x -> pure (Right x)+ Right x -> pure (File x) dir <|> file locQueryParams <- do xs <- optional $ do@@ -142,23 +147,81 @@ divider = void (char '/') chunk = takeWhile1 (`notElem` ['?','&','/','#']) +locationRelParser :: Parser (Location Rel)+locationRelParser = do+ locPath <- do+ xs <- chunk `sepBy` divider+ case xs of+ [] -> pure $ Dir [reldir|./|]+ _ -> do+ let dir = do+ divider+ case parseRelDir (T.unpack (T.intercalate "/" xs <> "/")) of+ Left (e :: SomeException) -> fail (show e)+ Right x -> pure (Dir x)+ file =+ case parseRelFile (T.unpack (T.intercalate "/" xs)) of+ Left (e :: SomeException) -> fail (show e)+ Right x -> pure (File x)+ dir <|> file+ locQueryParams <- do+ xs <- optional $ do+ let val = T.unpack <$> takeWhile (`notElem` ['=','&','#'])+ void (char '?')+ let kv = do+ k <- val+ mV <- optional $ do+ void (char '=')+ val+ pure (k,mV)+ kv `sepBy` void (char '&')+ case xs of+ Nothing -> pure []+ Just xs' -> pure xs'+ locFragment <- optional $ do+ void (char '#')+ xs <- takeWhile (const True)+ pure (T.unpack xs)+ pure Location+ { locPath+ , locQueryParams+ , locFragment+ }+ where+ divider = void (char '/')+ chunk = takeWhile1 (`notElem` ['?','&','/','#']) -prepend :: Path Abs Dir -> Location -> Location-prepend path l@Location{locPath} = l- { locPath = case locPath of- Left d -> case stripProperPrefix [absdir|/|] d of- Nothing -> error "impossible state"- Just d' -> Left (path </> d')- Right f -> case stripProperPrefix [absdir|/|] f of- Nothing -> error "impossible state"- Just f' -> Right (path </> f')- } +prependAbs :: Path Abs Dir -> Location Abs -> Location Abs+prependAbs path l@Location{locPath} =+ case locPath of+ File f ->+ l { locPath = case stripProperPrefix [absdir|/|] f of+ Nothing -> undefined+ Just f' -> File (path </> f')+ }+ Dir d ->+ l { locPath = case stripProperPrefix [absdir|/|] d of+ Nothing -> undefined+ Just d' -> Dir (path </> d')+ } +prependRel :: Path Rel Dir -> Location Rel -> Location Rel+prependRel path l@Location{locPath} =+ case locPath of+ File f ->+ l { locPath = File (path </> f)+ }+ Dir d ->+ l { locPath = Dir (path </> d)+ } -printLocation :: Location -> T.Text++printLocation :: Location base -> T.Text printLocation (Location pa qp fr) =- let loc = either toFilePath toFilePath pa+ let loc = case pa of+ Dir x -> toFilePath x+ File x -> toFilePath x query = case qp of [] -> "" qs -> "?" <> T.intercalate "&" (go <$> qs)@@ -170,46 +233,46 @@ -setQuery :: [QueryParam] -> Location -> Location+setQuery :: [QueryParam] -> Location base -> Location base setQuery qp (Location pa _ fr) = Location pa qp fr -- | Appends a query parameter-addQuery :: QueryParam -> Location -> Location+addQuery :: QueryParam -> Location base -> Location base addQuery q (Location pa qp fr) = Location pa (qp ++ [q]) fr -(<&>) :: Location -> QueryParam -> Location+(<&>) :: Location base -> QueryParam -> Location base (<&>) = flip addQuery infixl 7 <&> -addQueries :: [QueryParam] -> Location -> Location+addQueries :: [QueryParam] -> Location base -> Location base addQueries qs (Location pa qs' fr) = Location pa (qs' ++ qs) fr -delQuery :: Location -> Location+delQuery :: Location base -> Location base delQuery = setQuery [] -getQuery :: Location -> [QueryParam]+getQuery :: Location base -> [QueryParam] getQuery (Location _ qp _) = qp -setFragment :: Maybe String -> Location -> Location+setFragment :: Maybe String -> Location base -> Location base setFragment fr (Location pa qp _) = Location pa qp fr -addFragment :: String -> Location -> Location+addFragment :: String -> Location base -> Location base addFragment fr = setFragment (Just fr) -(<#>) :: Location -> String -> Location+(<#>) :: Location base -> String -> Location base (<#>) = flip addFragment infixl 8 <#> -delFragment :: Location -> Location+delFragment :: Location base -> Location base delFragment = setFragment Nothing -getFragment :: Location -> Maybe String+getFragment :: Location base -> Maybe String getFragment (Location _ _ x) = x