Skip to content

Introduce purs-tidy formatter #66

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 3 commits into from
Nov 20, 2021
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension


Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
5 changes: 5 additions & 0 deletions .github/workflows/ci.yml
Original file line number Diff line number Diff line change
Expand Up @@ -15,6 +15,8 @@ jobs:

- name: Set up a PureScript toolchain
uses: purescript-contrib/setup-purescript@main
with:
purs-tidy: "latest"

- name: Cache PureScript dependencies
uses: actions/cache@v2
Expand All @@ -32,3 +34,6 @@ jobs:

- name: Run tests
run: spago test --no-install

- name: Check formatting
run: purs-tidy check src test
1 change: 1 addition & 0 deletions .gitignore
Original file line number Diff line number Diff line change
Expand Up @@ -2,6 +2,7 @@
!.gitignore
!.github
!.editorconfig
!.tidyrc.json

output
generated-docs
Expand Down
10 changes: 10 additions & 0 deletions .tidyrc.json
Original file line number Diff line number Diff line change
@@ -0,0 +1,10 @@
{
"importSort": "source",
"importWrap": "source",
"indent": 2,
"operatorsFile": null,
"ribbon": 1,
"typeArrowPlacement": "first",
"unicode": "never",
"width": null
}
1 change: 1 addition & 0 deletions CHANGELOG.md
Original file line number Diff line number Diff line change
Expand Up @@ -12,6 +12,7 @@ Bugfixes:
- Made all parsers stack safe on long input (#63 by @garyb)

Other improvements:
- Added `purs-tidy` formatter (#66 by @thomashoneyman)

## [v8.0.1](https://github.com/purescript-contrib/purescript-uri/releases/tag/v8.0.1) - 2021-05-06

Expand Down
85 changes: 38 additions & 47 deletions src/URI/AbsoluteURI.purs
Original file line number Diff line number Diff line change
Expand Up @@ -37,10 +37,12 @@ import URI.Scheme as Scheme
-- | but is required to have a `Scheme` component.
data AbsoluteURI userInfo hosts path hierPath query = AbsoluteURI Scheme (HierarchicalPart userInfo hosts path hierPath) (Maybe query)

derive instance eqAbsoluteURI ∷ (Eq userInfo, Eq hosts, Eq path, Eq hierPath, Eq query) ⇒ Eq (AbsoluteURI userInfo hosts path hierPath query)
derive instance ordAbsoluteURI ∷ (Ord userInfo, Ord hosts, Ord path, Ord hierPath, Ord query) ⇒ Ord (AbsoluteURI userInfo hosts path hierPath query)
derive instance genericAbsoluteURI ∷ Generic (AbsoluteURI userInfo hosts path hierPath query) _
instance showAbsoluteURI ∷ (Show userInfo, Show hosts, Show path, Show hierPath, Show query) ⇒ Show (AbsoluteURI userInfo hosts path hierPath query) where show = genericShow
derive instance eqAbsoluteURI :: (Eq userInfo, Eq hosts, Eq path, Eq hierPath, Eq query) => Eq (AbsoluteURI userInfo hosts path hierPath query)
derive instance ordAbsoluteURI :: (Ord userInfo, Ord hosts, Ord path, Ord hierPath, Ord query) => Ord (AbsoluteURI userInfo hosts path hierPath query)
derive instance genericAbsoluteURI :: Generic (AbsoluteURI userInfo hosts path hierPath query) _

instance showAbsoluteURI :: (Show userInfo, Show hosts, Show path, Show hierPath, Show query) => Show (AbsoluteURI userInfo hosts path hierPath query) where
show = genericShow

-- | A row type for describing the options fields used by the absolute URI
-- | parser and printer.
Expand All @@ -65,11 +67,11 @@ type AbsoluteURIOptions userInfo hosts path hierPath query =
-- | `HostPortPair.parseHosts pure pure`. See [`URI.HostPortPair`](../URI.HostPortPair)
-- | for more information on the host/port pair parser.
type AbsoluteURIParseOptions userInfo hosts path hierPath query r =
( parseUserInfo UserInfo Either URIPartParseError userInfo
, parseHosts Parser String hosts
, parsePath Path Either URIPartParseError path
, parseHierPath Either PathAbsolute PathRootless Either URIPartParseError hierPath
, parseQuery Query Either URIPartParseError query
( parseUserInfo :: UserInfo -> Either URIPartParseError userInfo
, parseHosts :: Parser String hosts
, parsePath :: Path -> Either URIPartParseError path
, parseHierPath :: Either PathAbsolute PathRootless -> Either URIPartParseError hierPath
, parseQuery :: Query -> Either URIPartParseError query
| r
)

Expand All @@ -85,31 +87,32 @@ type AbsoluteURIParseOptions userInfo hosts path hierPath query r =
-- | `HostPortPair.printHosts identity identity`. See [`URI.HostPortPair`](../URI.HostPortPair)
-- | for more information on the host/port pair printer.
type AbsoluteURIPrintOptions userInfo hosts path hierPath query r =
( printUserInfo userInfo UserInfo
, printHosts hosts String
, printPath path Path
, printHierPath hierPath Either PathAbsolute PathRootless
, printQuery query Query
( printUserInfo :: userInfo -> UserInfo
, printHosts :: hosts -> String
, printPath :: path -> Path
, printHierPath :: hierPath -> Either PathAbsolute PathRootless
, printQuery :: query -> Query
| r
)

-- | A parser for an absolute URI.
parser
∷ ∀ userInfo hosts path hierPath query r
. Record (AbsoluteURIParseOptions userInfo hosts path hierPath query r)
→ Parser String (AbsoluteURI userInfo hosts path hierPath query)
parser opts = AbsoluteURI
<$> Scheme.parser
<*> HPart.parser opts
<*> optionMaybe (wrapParser opts.parseQuery Query.parser)
<* eof
:: forall userInfo hosts path hierPath query r
. Record (AbsoluteURIParseOptions userInfo hosts path hierPath query r)
-> Parser String (AbsoluteURI userInfo hosts path hierPath query)
parser opts =
AbsoluteURI
<$> Scheme.parser
<*> HPart.parser opts
<*> optionMaybe (wrapParser opts.parseQuery Query.parser)
<* eof

-- | A printer for an absolute URI.
print
∷ ∀ userInfo hosts path hierPath query r
. Record (AbsoluteURIPrintOptions userInfo hosts path hierPath query r)
AbsoluteURI userInfo hosts path hierPath query
String
:: forall userInfo hosts path hierPath query r
. Record (AbsoluteURIPrintOptions userInfo hosts path hierPath query r)
-> AbsoluteURI userInfo hosts path hierPath query
-> String
print opts (AbsoluteURI s h q) =
String.joinWith "" $ Array.catMaybes
[ Just (Scheme.print s)
Expand All @@ -118,34 +121,22 @@ print opts (AbsoluteURI s h q) =
]

-- | The scheme component of an absolute URI.
_scheme
∷ ∀ userInfo hosts path hierPath query
. Lens'
(AbsoluteURI userInfo hosts path hierPath query)
Scheme
_scheme :: forall userInfo hosts path hierPath query. Lens' (AbsoluteURI userInfo hosts path hierPath query) Scheme
_scheme =
lens
(\(AbsoluteURI s _ _) s)
(\(AbsoluteURI _ h q) s AbsoluteURI s h q)
(\(AbsoluteURI s _ _) -> s)
(\(AbsoluteURI _ h q) s -> AbsoluteURI s h q)

-- | The hierarchical-part component of an absolute URI.
_hierPart
∷ ∀ userInfo hosts path hierPath query
. Lens'
(AbsoluteURI userInfo hosts path hierPath query)
(HierarchicalPart userInfo hosts path hierPath)
_hierPart :: forall userInfo hosts path hierPath query. Lens' (AbsoluteURI userInfo hosts path hierPath query) (HierarchicalPart userInfo hosts path hierPath)
_hierPart =
lens
(\(AbsoluteURI _ h _) h)
(\(AbsoluteURI s _ q) h AbsoluteURI s h q)
(\(AbsoluteURI _ h _) -> h)
(\(AbsoluteURI s _ q) h -> AbsoluteURI s h q)

-- | The query component of an absolute URI.
_query
∷ ∀ userInfo hosts path hierPath query
. Lens'
(AbsoluteURI userInfo hosts path hierPath query)
(Maybe query)
_query :: forall userInfo hosts path hierPath query. Lens' (AbsoluteURI userInfo hosts path hierPath query) (Maybe query)
_query =
lens
(\(AbsoluteURI _ _ q) q)
(\(AbsoluteURI s h _) q AbsoluteURI s h q)
(\(AbsoluteURI _ _ q) -> q)
(\(AbsoluteURI s h _) q -> AbsoluteURI s h q)
62 changes: 28 additions & 34 deletions src/URI/Authority.purs
Original file line number Diff line number Diff line change
Expand Up @@ -32,10 +32,12 @@ import URI.UserInfo as UserInfo
-- | `localhost:3000`, `[email protected]`.
data Authority userInfo hosts = Authority (Maybe userInfo) hosts

derive instance eqAuthority ∷ (Eq userInfo, Eq hosts) ⇒ Eq (Authority userInfo hosts)
derive instance ordAuthority ∷ (Ord userInfo, Ord hosts) ⇒ Ord (Authority userInfo hosts)
derive instance genericAuthority ∷ Generic (Authority userInfo hosts) _
instance showAuthority ∷ (Show userInfo, Show hosts) ⇒ Show (Authority userInfo hosts) where show = genericShow
derive instance eqAuthority :: (Eq userInfo, Eq hosts) => Eq (Authority userInfo hosts)
derive instance ordAuthority :: (Ord userInfo, Ord hosts) => Ord (Authority userInfo hosts)
derive instance genericAuthority :: Generic (Authority userInfo hosts) _

instance showAuthority :: (Show userInfo, Show hosts) => Show (Authority userInfo hosts) where
show = genericShow

-- | A row type for describing the options fields used by the authority parser
-- | and printer.
Expand All @@ -51,8 +53,8 @@ type AuthorityOptions userInfo hosts =
-- | Used as `Record (AuthorityParseOptions userInfo hosts ())` when type
-- | annotating an options record.
type AuthorityParseOptions userInfo hosts r =
( parseUserInfo UserInfo Either URIPartParseError userInfo
, parseHosts Parser String hosts
( parseUserInfo :: UserInfo -> Either URIPartParseError userInfo
, parseHosts :: Parser String hosts
| r
)

Expand All @@ -61,52 +63,44 @@ type AuthorityParseOptions userInfo hosts r =
-- | Used as `Record (AuthorityPrintOptions userInfo hosts ())` when type
-- | annotating an options record.
type AuthorityPrintOptions userInfo hosts r =
( printUserInfo userInfo UserInfo
, printHosts hosts String
( printUserInfo :: userInfo -> UserInfo
, printHosts :: hosts -> String
| r
)

-- | A parser for the authority part of a URI. Expects values with a `"//"`
-- | prefix.
parser
∷ ∀ userInfo hosts r
. Record (AuthorityParseOptions userInfo hosts r)
Parser String (Authority userInfo hosts)
:: forall userInfo hosts r
. Record (AuthorityParseOptions userInfo hosts r)
-> Parser String (Authority userInfo hosts)
parser opts = do
_ string "//"
ui optionMaybe $ try (wrapParser opts.parseUserInfo UserInfo.parser <* char '@')
hosts opts.parseHosts
_ <- string "//"
ui <- optionMaybe $ try (wrapParser opts.parseUserInfo UserInfo.parser <* char '@')
hosts <- opts.parseHosts
pure $ Authority ui hosts

-- | A printer for the authority part of a URI. Will print the value with a
-- | `"//"` prefix.
print
∷ ∀ userInfo hosts r
. Record (AuthorityPrintOptions userInfo hosts r)
Authority userInfo hosts
String
:: forall userInfo hosts r
. Record (AuthorityPrintOptions userInfo hosts r)
-> Authority userInfo hosts
-> String
print opts (Authority mui hs) = case mui of
Just ui "//" <> UserInfo.print (opts.printUserInfo ui) <> "@" <> opts.printHosts hs
Nothing "//" <> opts.printHosts hs
Just ui -> "//" <> UserInfo.print (opts.printUserInfo ui) <> "@" <> opts.printHosts hs
Nothing -> "//" <> opts.printHosts hs

-- | A lens for the user-info component of the authority.
_userInfo
∷ ∀ userInfo hosts
. Lens'
(Authority userInfo hosts)
(Maybe userInfo)
_userInfo :: forall userInfo hosts. Lens' (Authority userInfo hosts) (Maybe userInfo)
_userInfo =
lens
(\(Authority ui _) ui)
(\(Authority _ hs) ui Authority ui hs)
(\(Authority ui _) -> ui)
(\(Authority _ hs) ui -> Authority ui hs)

-- | A lens for the host(s) component of the authority.
_hosts
∷ ∀ userInfo hosts
. Lens'
(Authority userInfo hosts)
hosts
_hosts :: forall userInfo hosts. Lens' (Authority userInfo hosts) hosts
_hosts =
lens
(\(Authority _ hs) hs)
(\(Authority ui _) hs Authority ui hs)
(\(Authority _ hs) -> hs)
(\(Authority ui _) hs -> Authority ui hs)
62 changes: 33 additions & 29 deletions src/URI/Common.purs
Original file line number Diff line number Diff line change
Expand Up @@ -40,72 +40,76 @@ derive newtype instance eqURIPartParseError :: Eq URIPartParseError
derive newtype instance ordURIPartParseError :: Ord URIPartParseError
derive instance newtypeURIPartParseError :: Newtype URIPartParseError _
derive instance genericURIPartParseError :: Generic URIPartParseError _
instance showURIPartParseError :: Show URIPartParseError where show = genericShow

instance showURIPartParseError :: Show URIPartParseError where
show = genericShow

-- | Adapts a parser with a parser-esque function. First the original
-- | parser runs, then it attempts to refine the result with the function.
wrapParser
∷ ∀ s m a b
. Monad m
(a Either URIPartParseError b)
ParserT s m a
ParserT s m b
:: forall s m a b
. Monad m
=> (a -> Either URIPartParseError b)
-> ParserT s m a
-> ParserT s m b
wrapParser parseA p = ParserT do
ParseState _ pos _ get
a un ParserT p
ParseState _ pos _ <- get
a <- un ParserT p
case parseA a of
Left (URIPartParseError err) throwError (ParseError err pos)
Right b pure b
Left (URIPartParseError err) -> throwError (ParseError err pos)
Right b -> pure b

-- | Parser for ascii alphabetical characters (upper and lowercase).
alpha Parser String Char
alpha = satisfy \c (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')
alpha :: Parser String Char
alpha = satisfy \c -> (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')

-- | Parser for ascii alphanumeric characters (upper and lowercase for letters).
alphaNum Parser String Char
alphaNum :: Parser String Char
alphaNum = alpha <|> digit

-- | Parser for characters that are allowed in a URI but do not have a reserved
-- | purpose.
unreserved Parser String Char
unreserved :: Parser String Char
unreserved = alphaNum <|> char '-' <|> char '.' <|> char '_' <|> char '~'

-- | Parser for the "sub-delims" group of reserved characters.
subDelims Parser String Char
subDelims :: Parser String Char
subDelims =
oneOf ['!', '$', '&', '\'', '(', ')', '*', '+', ';', '=', ',']
oneOf [ '!', '$', '&', '\'', '(', ')', '*', '+', ';', '=', ',' ]

-- | Parser for a percent-encoded character.
pctEncoded Parser String NonEmptyString
pctEncoded :: Parser String NonEmptyString
pctEncoded = do
d0 char '%'
d1 hexDigit
d2 hexDigit
d0 <- char '%'
d1 <- hexDigit
d2 <- hexDigit
pure $ NES.singleton d0 <> NES.singleton d1 <> NES.singleton d2

-- | A helper function for printing URI components using percent-encoding for
-- | characters that require it.
-- |
-- | Accepts a parser that is used to determine whether a character is allowed
-- | to appear un-encoded in the URI component and the string to encode.
printEncoded Parser String Char String String
printEncoded :: Parser String Char -> String -> String
printEncoded p s = either (const s) identity (runParser s parse)
where
parse ∷ Parser String String
parse = (NES.joinWith "" <$> List.manyRec (simpleChar <|> encodedChar)) <* eof
simpleChar ∷ Parser String NonEmptyString
simpleChar = NES.singleton <$> p
encodedChar ∷ Parser String NonEmptyString
encodedChar = unsafePartial (NES.unsafeFromString <<< fromJust) <<< encodeURIComponent <<< String.singleton <$> anyChar
parse :: Parser String String
parse = (NES.joinWith "" <$> List.manyRec (simpleChar <|> encodedChar)) <* eof

simpleChar :: Parser String NonEmptyString
simpleChar = NES.singleton <$> p

encodedChar :: Parser String NonEmptyString
encodedChar = unsafePartial (NES.unsafeFromString <<< fromJust) <<< encodeURIComponent <<< String.singleton <$> anyChar

-- | A version of [`printEncoded`](#v:printEncoded) that operates on non-empty
-- | strings.
printEncoded' Parser String Char NonEmptyString NonEmptyString
printEncoded' :: Parser String Char -> NonEmptyString -> NonEmptyString
printEncoded' p =
unsafePartial NES.unsafeFromString <<< printEncoded p <<< NES.toString

-- | A version of [`decodeURIComponent`](https://pursuit.purescript.org/packages/purescript-jsuri/docs/JSURI#v:decodeURIComponent)
-- | that operates on non-empty strings.
decodeURIComponent' NonEmptyString NonEmptyString
decodeURIComponent' :: NonEmptyString -> NonEmptyString
decodeURIComponent' =
unsafePartial NES.unsafeFromString <<< unsafePartial fromJust <<< decodeURIComponent <<< NES.toString
Loading