diff --git a/.gitignore b/.gitignore index 82f3a88..9cc4b70 100644 --- a/.gitignore +++ b/.gitignore @@ -1,6 +1,7 @@ dist dist-* cabal-dev +*.cabal *.o *.hi *.chi diff --git a/LICENSE b/LICENSE index a7f0f91..e037c72 100644 --- a/LICENSE +++ b/LICENSE @@ -1,21 +1,30 @@ -MIT License +Copyright Author name here (c) 2018 -Copyright (c) 2018 Serokell +All rights reserved. -Permission is hereby granted, free of charge, to any person obtaining a copy -of this software and associated documentation files (the "Software"), to deal -in the Software without restriction, including without limitation the rights -to use, copy, modify, merge, publish, distribute, sublicense, and/or sell -copies of the Software, and to permit persons to whom the Software is -furnished to do so, subject to the following conditions: +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: -The above copyright notice and this permission notice shall be included in all -copies or substantial portions of the Software. + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. -THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, -OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE -SOFTWARE. + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Author name here nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md index 6ef69b0..db81f16 100644 --- a/README.md +++ b/README.md @@ -1,2 +1 @@ # crossref-verifier -Check cross-references of repository documents diff --git a/Setup.hs b/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/exec/Main.hs b/exec/Main.hs new file mode 100644 index 0000000..6692395 --- /dev/null +++ b/exec/Main.hs @@ -0,0 +1,27 @@ +module Main where + +import Data.Default (def) +import Fmt (blockListF, build, fmtLn, nameF) + +import Crv.Scan +import Crv.Scanners +import Crv.Verify + +formats :: FormatsSupport +formats = specificFormatsSupport + [ markdownSupport + ] + +main :: IO () +main = do + let root = "../universum" + repoInfo <- gatherRepoInfo formats def root + fmtLn $ nameF "Repository links" $ build repoInfo + + verifyRes <- verifyRepo root repoInfo + case verifyErrors verifyRes of + Nothing -> + fmtLn "All repository links are valid" + Just (toList -> errs) -> do + fmtLn $ nameF "Invalid references found" $ blockListF errs + die "" diff --git a/package.yaml b/package.yaml new file mode 100644 index 0000000..abb5226 --- /dev/null +++ b/package.yaml @@ -0,0 +1,84 @@ +name: crossref-verifier +version: 0.1.0.0 +github: "githubuser/crossref-verifier" +license: MIT +author: "Kostya Ivanov" +maintainer: "martoon.hsk@gmail.com" +copyright: "2018 Martoon" + +extra-source-files: +- README.md + +description: Please see the README on GitHub at + +default-extensions: + - AllowAmbiguousTypes + - BangPatterns + - ConstraintKinds + - DataKinds + - DefaultSignatures + - DeriveDataTypeable + - DeriveGeneric + - FlexibleContexts + - FlexibleInstances + - FunctionalDependencies + - GeneralizedNewtypeDeriving + - LambdaCase + - MonadFailDesugaring + - MultiParamTypeClasses + - MultiWayIf + - NamedFieldPuns + - OverloadedStrings + - RankNTypes + - RecordWildCards + - ScopedTypeVariables + - StandaloneDeriving + - TemplateHaskell + - TupleSections + - TypeFamilies + - UndecidableInstances + - ViewPatterns + - TypeApplications + - TypeOperators + +build-tools: + - autoexporter + +ghc-options: + - -Wall + +dependencies: + - base-noprelude + - containers + - req + - data-default + - deepseq + - directory-tree + - directory + - filepath + - fmt + - http-client + - http-types + - lens + - loot-prelude + - pretty-terminal + - network-uri + - megaparsec + - mtl + - roman-numerals + - text + +library: + source-dirs: src + +executables: + crossref-verify: + main: Main.hs + source-dirs: exec + ghc-options: + - -threaded + - -rtsopts + - -with-rtsopts=-N + - -O2 + dependencies: + - crossref-verifier diff --git a/src/Crv/Config.hs b/src/Crv/Config.hs new file mode 100644 index 0000000..0859fd0 --- /dev/null +++ b/src/Crv/Config.hs @@ -0,0 +1,17 @@ +module Crv.Config where + +import Data.Default (Default (..)) + +data Config = Config + { cTraversal :: TraversalConfig + } + +instance Default Config where + def = Config def + +data TraversalConfig = TraversalConfig + { tcExcluded :: [FilePath] + } + +instance Default TraversalConfig where + def = TraversalConfig [".stack-work"] diff --git a/src/Crv/Core.hs b/src/Crv/Core.hs new file mode 100644 index 0000000..de2620e --- /dev/null +++ b/src/Crv/Core.hs @@ -0,0 +1,151 @@ +-- | Various primitives. + +module Crv.Core where + +import Control.DeepSeq (NFData) +import Control.Lens (makeLenses, (%=)) +import Data.Char (isAlphaNum) +import Data.Default (Default (..)) +import qualified Data.Map as M +import qualified Data.Text as T +import Fmt (Buildable (..), blockListF, blockListF', nameF, (+|), (|+)) +import System.Console.Pretty (Color (..), Style (..), color, style) +import Text.Numeral.Roman (toRoman) + +import Crv.Util () + +----------------------------------------------------------- +-- Types +----------------------------------------------------------- + +-- | Full info about a reference. +data Reference = Reference + { rName :: Text + -- ^ Text displayed as reference. + , rLink :: Text + -- ^ File or site reference points to. + , rAnchor :: Maybe Text + -- ^ Section or custom anchor tag. + } deriving (Show, Generic) + +-- | Context of anchor. +data AnchorType + = HeaderAnchor Int + -- ^ Every section header is usually an anchor + | HandAnchor + -- ^ They can be set up manually + | BiblioAnchor + -- ^ Id of entry in bibliography + deriving (Show, Eq, Generic) + +-- | A referable anchor. +data Anchor = Anchor + { aType :: AnchorType + , aName :: Text + } deriving (Show, Generic) + +-- | All information regarding a single file we care about. +data FileInfo = FileInfo + { _fiReferences :: [Reference] + , _fiAnchors :: [Anchor] + } deriving (Show, Generic) +makeLenses ''FileInfo + +instance Default FileInfo where + def = FileInfo [] [] + +newtype RepoInfo = RepoInfo (Map FilePath FileInfo) + deriving (Show) + +finaliseFileInfo :: FileInfo -> FileInfo +finaliseFileInfo = execState $ do + fiReferences %= reverse + fiAnchors %= reverse + +----------------------------------------------------------- +-- Instances +----------------------------------------------------------- + +instance NFData Reference +instance NFData AnchorType +instance NFData Anchor +instance NFData FileInfo + +instance Buildable Reference where + build Reference{..} = nameF ("reference (" +| build loc |+ ")") $ + blockListF + [ "text: " <> show rName + , "link: " <> rLink + , "anchor: " <> (rAnchor ?: style Faint "-") + ] + where + loc = locationType rLink + +instance Buildable AnchorType where + build = style Faint . \case + HeaderAnchor l -> color Green ("header " <> toRoman l) + HandAnchor -> color Yellow "hand made" + BiblioAnchor -> color Cyan "biblio" + +instance Buildable Anchor where + build (Anchor t a) = a |+ " (" +| t |+ ")" + +instance Buildable FileInfo where + build FileInfo{..} = + blockListF + [ nameF "references" $ blockListF _fiReferences + , nameF "anchors" $ blockListF _fiAnchors + ] + +instance Buildable RepoInfo where + build (RepoInfo m) = + blockListF' "⮚" buildFileReport (M.toList m) + where + buildFileReport (name, info) = mconcat + [ color Cyan $ fromString name <> ":\n" + , build info + , "\n" + ] + +----------------------------------------------------------- +-- Analysing +----------------------------------------------------------- + +-- | Type of reference. +data LocationType + = LocalLoc + -- ^ Reference on this file + | RelativeLoc + -- ^ Reference to a file relative to given one + | AbsoluteLoc + -- ^ Reference to a file relative to the root + | ExternalLoc + -- ^ Reference to a file at outer site + deriving (Show) + +instance Buildable LocationType where + build = \case + LocalLoc -> color Green "local" + RelativeLoc -> color Yellow "relative" + AbsoluteLoc -> color Blue "absolute" + ExternalLoc -> color Red "external" + +-- | Get type of reference. +locationType :: Text -> LocationType +locationType location = case toString location of + [] -> LocalLoc + '/' : _ -> AbsoluteLoc + '.' : '/' : _ -> RelativeLoc + '.' : '.' : '/' : _ -> RelativeLoc + _ | hasProtocol -> ExternalLoc + _ -> RelativeLoc + where + hasProtocol = "://" `T.isInfixOf` (T.take 10 location) + +-- | Convert section header name to an anchor refering it. +headerToAnchor :: Text -> Text +headerToAnchor = + T.filter (\c -> isAlphaNum c || c == '-') . + T.replace " " "-" . + T.replace "+" "-" . + T.toLower diff --git a/src/Crv/Scan.hs b/src/Crv/Scan.hs new file mode 100644 index 0000000..90a3932 --- /dev/null +++ b/src/Crv/Scan.hs @@ -0,0 +1,69 @@ +-- | Generalised repo scanner and analyser. + +module Crv.Scan + ( Extension + , ScanAction + , FormatsSupport + , RepoInfo (..) + + , gatherRepoInfo + , specificFormatsSupport + ) where + +import qualified Data.Foldable as F +import qualified Data.Map as M +import qualified System.Directory.Tree as Tree +import System.FilePath.Posix (takeDirectory, takeExtension, ()) + +import Crv.Config +import Crv.Core +import Crv.Util () + +-- | File extension, dot included. +type Extension = String + +-- | Way to parse a file. +type ScanAction = FilePath -> IO FileInfo + +-- | All supported ways to parse a file. +type FormatsSupport = Extension -> Maybe ScanAction + +specificFormatsSupport :: [([Extension], ScanAction)] -> FormatsSupport +specificFormatsSupport formats = \ext -> M.lookup ext formatsMap + where + formatsMap = M.fromList + [ (extension, parser) + | (extensions, parser) <- formats + , extension <- extensions + ] + +gatherRepoInfo + :: MonadIO m + => FormatsSupport -> TraversalConfig -> FilePath -> m RepoInfo +gatherRepoInfo formatsSupport config root = do + _ Tree.:/ repoTree <- liftIO $ Tree.readDirectoryWithL processFile rootNE + let fileInfos = filter (\(path, _) -> not $ isExcluded path) $ + dropSndMaybes . F.toList $ + Tree.zipPaths . (dirOfRoot Tree.:/) $ + filterExcludedDirs root repoTree + return $ RepoInfo (M.fromList fileInfos) + where + rootNE = if null root then "." else root + dirOfRoot = if null root then "" else takeDirectory root + processFile file = do + let ext = takeExtension file + forM (formatsSupport ext) $ \scanFile -> + scanFile file + dropSndMaybes l = [(a, b) | (a, Just b) <- l] + + excluded = map (root ) (tcExcluded config) + isExcluded path = any (`isPrefixOf` path) excluded + filterExcludedDirs cur = \case + Tree.Dir name subfiles -> + let subfiles' = + if isExcluded cur + then [] + else map visitRec subfiles + visitRec sub = filterExcludedDirs (cur Tree.name sub) sub + in Tree.Dir name subfiles' + other -> other diff --git a/src/Crv/Scanners.hs b/src/Crv/Scanners.hs new file mode 100644 index 0000000..27947fb --- /dev/null +++ b/src/Crv/Scanners.hs @@ -0,0 +1 @@ +{-# OPTIONS_GHC -F -pgmF autoexporter #-} diff --git a/src/Crv/Scanners/Markdown.hs b/src/Crv/Scanners/Markdown.hs new file mode 100644 index 0000000..bc2dc41 --- /dev/null +++ b/src/Crv/Scanners/Markdown.hs @@ -0,0 +1,117 @@ +-- | Markdown documents markdownScanner. + +module Crv.Scanners.Markdown + ( markdownScanner + , markdownSupport + ) where + +import Control.Lens ((%=)) +import Data.Default (Default (..)) +import qualified Data.Text as T +import qualified Data.Text.Lazy as LT +import qualified Data.Text.Lazy.IO as LT +import GHC.Conc (par) +import qualified Text.Megaparsec as P +import qualified Text.Megaparsec.Char as P + +import Crv.Core +import Crv.Scan + +type MonadFileScan m = (P.MonadParsec () LT.Text m, MonadState FileInfo m) + +inBrackets :: MonadFileScan m => LT.Text -> LT.Text -> m Text +inBrackets open close = do + _ <- P.string open + res <- P.takeWhileP (Just "in brackets") (/= LT.head close) + _ <- P.string close + return $ toStrict res + +fileInfoParser :: (MonadFileScan m) => m () +fileInfoParser = loop >> modify finaliseFileInfo + where + loop = do + asum + [ P.try parseReference + , P.try parseBiblioRef + , P.try parseFootnoteRef + , P.try parseHandAnchor + , P.try parseSectionName + , P.try parseBiblioAnchor + , skipQuotes + , skipCodeBlocks + , skipUninteresting + ] + unlessM P.atEnd loop + + parseReference = do + rName <- inBrackets "[" "]" + rawLink <- inBrackets "(" ")" + + let link = if null rawLink then rName else rawLink + let (rLink, rAnchor) = case T.splitOn "#" link of + [t] -> (t, Nothing) + t : ts -> (t, Just $ T.intercalate "#" ts) + [] -> error "impossible" + + fiReferences %= (Reference{..} :) + + parseBiblioRef = do + rName <- inBrackets "[" "]" + anchor <- inBrackets "[" "]" + let rAnchor = Just $ if null anchor then rName else anchor + let rLink = "" + fiReferences %= (Reference{..} :) + + parseFootnoteRef = do + rName <- inBrackets "[^" "]" + let rAnchor = Just ("^" <> rName) + rLink = "" + fiReferences %= (Reference{..} :) + + parseHandAnchor = do + aName <- inBrackets "" + let aType = HandAnchor + fiAnchors %= (Anchor{..} :) + + parseBiblioAnchor = do + aName <- inBrackets "[" "]:" + let aType = BiblioAnchor + fiAnchors %= (Anchor{..} :) + + parseSectionName = do + prefix <- P.takeWhile1P (Just "header prefix") (== '#') + rawName <- P.takeWhileP (Just "header") $ \c -> all (/= c) ['\r', '\n'] + _ <- P.eol + let aType = HeaderAnchor (length prefix) + aName = headerToAnchor $ + T.dropWhileEnd (\c -> c == '#' || c == ' ') $ T.strip $ + toStrict rawName + fiAnchors %= (Anchor{..} :) + + skipQuotes = do + _ <- P.char '`' + P.skipMany (void (P.string "\\\\`") <|> void (P.anySingleBut '`')) + _ <- P.char '`' + return () + + skipCodeBlocks = void $ inBrackets "```" "```" + + skipUninteresting = do + _ <- P.anySingle + P.skipMany $ P.satisfy (\c -> all (/= c) ['[', '<', '#', '`']) + +parseFileInfo :: FilePath -> LT.Text -> FileInfo +parseFileInfo path input = + let outcome = P.parse (execStateT fileInfoParser def) path input + in case outcome of + Left err -> error $ "Failed to parse file " <> show path <> + ": " <> show err + Right res -> res + +markdownScanner :: ScanAction +markdownScanner path = liftIO $ do + res <- parseFileInfo path <$> LT.readFile path + force res `par` return res + +markdownSupport :: ([Extension], ScanAction) +markdownSupport = ([".md"], markdownScanner) diff --git a/src/Crv/Util.hs b/src/Crv/Util.hs new file mode 100644 index 0000000..7cb7d6b --- /dev/null +++ b/src/Crv/Util.hs @@ -0,0 +1,15 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Crv.Util + ( nameF' + ) where + +import Fmt (Builder, build, fmt, nameF) +import System.Console.Pretty (Pretty (..), Style (Faint)) + +instance Pretty Builder where + colorize s c = build @Text . colorize s c . fmt + style s = build @Text . style s . fmt + +nameF' :: Builder -> Builder -> Builder +nameF' a b = nameF (style Faint a) b diff --git a/src/Crv/Verify.hs b/src/Crv/Verify.hs new file mode 100644 index 0000000..a314d19 --- /dev/null +++ b/src/Crv/Verify.hs @@ -0,0 +1,158 @@ +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE PartialTypeSignatures #-} +{-# OPTIONS_GHC -Wno-partial-type-signatures #-} + +module Crv.Verify + ( -- * General verification + VerifyResult (..) + , verifyOk + , verifyErrors + , verifying + + , WithReferenceLoc (..) + + -- * Cross-references validation + , CrvVerifyError (..) + , verifyRepo + , checkExternalResource + ) where + +import Control.Monad.Except (ExceptT (..), MonadError (..)) +import Data.Default (def) +import qualified Data.Map as M +import Fmt (Buildable (..), listF, (+|), (|+)) +import Network.HTTP.Client (HttpException (..), HttpExceptionContent (..), responseStatus) +import Network.HTTP.Req (GET (..), HEAD (..), HttpException (..), NoReqBody (..), ignoreResponse, + parseUrl, req, runReq) +import Network.HTTP.Types.Status (Status, statusCode, statusMessage) +import System.Console.Pretty (Style (Faint), style) +import System.Directory (doesDirectoryExist, doesFileExist) +import System.FilePath.Posix (takeDirectory) +import System.FilePath.Posix (()) +import System.Timeout (timeout) + +import Crv.Core + +----------------------------------------------------------- +-- General verification +----------------------------------------------------------- + +newtype VerifyResult e = VerifyResult [e] + deriving (Show, Functor) + +deriving instance Semigroup (VerifyResult e) +deriving instance Monoid (VerifyResult e) + +instance Buildable e => Buildable (VerifyResult e) where + build vr = case verifyErrors vr of + Nothing -> "ok" + Just errs -> listF errs + +verifyOk :: VerifyResult e -> Bool +verifyOk (VerifyResult errors) = null errors + +verifyErrors :: VerifyResult e -> Maybe (NonEmpty e) +verifyErrors (VerifyResult errors) = nonEmpty errors + +verifying :: Monad m => ExceptT e m () -> m (VerifyResult e) +verifying (ExceptT action) = fmap toVerifyRes action + +toVerifyRes :: Either e () -> VerifyResult e +toVerifyRes = VerifyResult . either one (\() -> []) + +----------------------------------------------------------- +-- Cross-references validation +----------------------------------------------------------- + +data WithReferenceLoc a = WithReferenceLoc + { wrlFile :: FilePath + , wrlReference :: Reference + , wrlItem :: a + } + +instance Buildable a => Buildable (WithReferenceLoc a) where + build WithReferenceLoc{..} = + "In file " +| style Faint wrlFile |+ " " +| wrlReference |+ "\n" + +| wrlItem |+ "\n\n" + +data CrvVerifyError + = FileDoesNotExist FilePath + | AnchorDoesNotExist Text [Anchor] + | ExternalResourceInvalidUri Text + | ExternalResourceUnavailable Text Status + | ExternalResourceSomeError Text + deriving (Show) + +instance Buildable CrvVerifyError where + build = \case + FileDoesNotExist file -> + "File does not exist: " +| file |+ "" + AnchorDoesNotExist anchor available -> + "Anchor '" +| anchor |+ "' does not exist in the file, available ones: " + +| listF available |+ "" + ExternalResourceInvalidUri link -> + "Bad url: " +| link |+ ", expected 'http' or 'https'" + ExternalResourceUnavailable link status -> + "Resource unavailable: (" +| statusCode status |+ " " +| + decodeUtf8 @Text (statusMessage status) |+ "): " +| link |+ "" + ExternalResourceSomeError err -> build err + +verifyRepo :: FilePath + -> RepoInfo + -> IO (VerifyResult $ WithReferenceLoc CrvVerifyError) +verifyRepo root (RepoInfo repoInfo) = + concatForM (M.toList repoInfo) $ \(file, fileInfo) -> + concatForM (_fiReferences fileInfo) $ \ref@Reference{..} -> + fmap (fmap $ WithReferenceLoc file ref) $ + case locationType rLink of + LocalLoc -> checkFileRef rAnchor file + RelativeLoc -> checkFileRef rAnchor + (takeDirectory file toString rLink) + AbsoluteLoc -> checkFileRef rAnchor (root <> toString rLink) + ExternalLoc -> return mempty -- checkExternalResource rLink + where + checkFileRef mAnchor file = verifying $ do + fileExists <- liftIO $ doesFileExist file + dirExists <- liftIO $ doesDirectoryExist file + unless (fileExists || dirExists) $ + throwError (FileDoesNotExist file) + + case M.lookup file repoInfo of + Nothing -> pass -- no support for such file, can do nothing + Just referedFileInfo -> + whenJust mAnchor $ \anchor -> do + let fileAnchors = _fiAnchors referedFileInfo + maybe (throwError $ AnchorDoesNotExist anchor fileAnchors) pure $ + void $ find ((== anchor) . aName) fileAnchors + +checkExternalResource :: Text -> IO (VerifyResult CrvVerifyError) +checkExternalResource link = fmap toVerifyRes $ do + makeRequest HEAD >>= \case + Right () -> return $ Right () + Left (ExternalResourceUnavailable _ status) | statusCode status == 405 + || statusCode status == 418 + -> makeRequest GET + Left err -> pure (Left err) + where + makeRequest :: _ => method -> IO (Either CrvVerifyError ()) + makeRequest method = runExceptT $ do + parsedUrl <- parseUrl (encodeUtf8 link) + & maybe (throwError $ ExternalResourceInvalidUri link) pure + let reqLink = case parsedUrl of + Left (url, option) -> + runReq def $ req method url NoReqBody ignoreResponse option + Right (url, option) -> + runReq def $ req method url NoReqBody ignoreResponse option + + -- TODO: tunable timeout + mres <- liftIO (timeout 3000000 $ void reqLink) `catch` (throwError . processErrors) + maybe (throwError $ ExternalResourceSomeError "Response timeout") pure mres + + processErrors = \case + JsonHttpException _ -> error "External link JSON parse exception" + VanillaHttpException err -> case err of + InvalidUrlException{} -> error "External link URL invalid exception" + HttpExceptionRequest _ exc -> case exc of + StatusCodeException resp _ -> + ExternalResourceUnavailable link (responseStatus resp) + other -> ExternalResourceSomeError $ show other diff --git a/stack.yaml b/stack.yaml new file mode 100644 index 0000000..8108156 --- /dev/null +++ b/stack.yaml @@ -0,0 +1,20 @@ +resolver: lts-12.0 + +packages: +- . + +extra-deps: +- base-noprelude-4.11.1.0 +- megaparsec-7.0.1 +- parser-combinators-1.0.0 +- cmark-0.5.6 +- text-format-0.3.2 +- fmt-0.6 +- pretty-terminal-0.1.0.0 +- roman-numerals-0.5.1.5 +- req-1.2.1 + +- git: https://github.com/serokell/lootbox.git + commit: 34e389808e34f1cfa56f456773682325bed56d17 + subdirs: + - code/prelude