{-# LANGUAGE CPP #-}

-- |
-- Module: Data.Version.Package
-- Copyright: 2021 Thomas Bidne
-- License: BSD-3-Clause
-- Stability: experimental
--
-- This module provides functionality for reading a package's version
-- at compile-time, along with a type representing PVP version numbers.
-- If only the former is of interest then see 'packageVersionStringTH', as
-- this is likely the most useful function.
--
-- The doctest examples use @-XOverloadedLists@.
--
-- @since 0.1.0.0
module Data.Version.Package
  ( -- * Type
    PackageVersion (..),

    -- ** Creation
    Internal.mkPackageVersion,
    mkPackageVersionTH,
    unsafePackageVersion,
    fromVersion,
    fromString,
    fromText,

    -- ** Elimination
    toVersion,
    toString,
    Internal.toText,

    -- * Reading Cabal Files

    -- ** TemplateHaskell
    -- $retrieve-version-th
    packageVersionTH,
    packageVersionStringTH,
    packageVersionTextTH,

    -- ** IO
    packageVersionThrowIO,
    packageVersionStringIO,
    packageVersionTextIO,
    packageVersionEitherIO,

    -- * Errors
    ValidationError (..),
    ReadStringError (..),
    ReadFileError (..),
  )
where

import Control.Exception
  ( Exception (displayException, fromException, toException),
    SomeAsyncException (SomeAsyncException),
    SomeException,
    throwIO,
    try,
  )
import Control.Monad ((>=>))
import Data.Bifunctor (Bifunctor (first, second))
import Data.ByteString qualified as BS
import Data.List qualified as L
import Data.List.NonEmpty qualified as NE
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.Encoding (decodeUtf8With)
import Data.Text.Encoding.Error (lenientDecode)
import Data.Version (Version (Version, versionBranch))
import Data.Version.Package.Internal
  ( PackageVersion (MkPackageVersion, unPackageVersion),
    ReadFileError
      ( ReadFileErrorGeneral,
        ReadFileErrorReadString,
        ReadFileErrorVersionNotFound
      ),
    ReadStringError (ReadStringErrorParse, ReadStringErrorValidate),
    ValidationError (ValidationErrorEmpty, ValidationErrorNegative),
  )
import Data.Version.Package.Internal qualified as Internal
import GHC.Stack (HasCallStack)
#if MIN_VERSION_template_haskell(2, 17, 0)
import Language.Haskell.TH (Code, Q)
#else
import Language.Haskell.TH (Q, TExp)
#endif
import Language.Haskell.TH qualified as TH
import Language.Haskell.TH.Syntax (Lift (liftTyped))
import Text.Read qualified as TR

-- $setup
-- >>> :set -XOverloadedLists

-- | Safely constructs a 'PackageVersion' at compile-time. If you know that
-- your input satisfies both invariants (non-empty and non-negative) at
-- compile-time, consider using the 'MkPackageVersion' constructor directly.
--
-- ==== __Examples__
-- >>> $$(mkPackageVersionTH [2,4,0])
-- MkPackageVersion {unPackageVersion = 2 :| [4,0]}
--
-- @since 0.1.0.0
#if MIN_VERSION_template_haskell(2,17,0)
mkPackageVersionTH :: [Int] -> Code Q PackageVersion
#else
mkPackageVersionTH :: [Int] -> Q (TExp PackageVersion)
#endif
mkPackageVersionTH :: [Int] -> Code Q PackageVersion
mkPackageVersionTH [Int]
v = case [Int] -> Either ValidationError PackageVersion
Internal.mkPackageVersion [Int]
v of
  Right PackageVersion
pv -> PackageVersion -> Code Q PackageVersion
forall t (m :: * -> *). (Lift t, Quote m) => t -> Code m t
forall (m :: * -> *).
Quote m =>
PackageVersion -> Code m PackageVersion
liftTyped PackageVersion
pv
  Left ValidationError
err -> [Char] -> Code Q PackageVersion
forall a. HasCallStack => [Char] -> a
error ([Char] -> Code Q PackageVersion)
-> [Char] -> Code Q PackageVersion
forall a b. (a -> b) -> a -> b
$ ValidationError -> [Char]
forall e. Exception e => e -> [Char]
displayException ValidationError
err

-- | Unsafe version of 'Internal.mkPackageVersion', intended to be used with
-- known constants. Maybe you should use 'mkPackageVersionTH' or
-- 'MkPackageVersion'?
--
-- __WARNING: This function is not total. Exercise restraint!__
--
-- ==== __Examples__
-- >>> unsafePackageVersion [1,2,3]
-- MkPackageVersion {unPackageVersion = 1 :| [2,3]}
--
-- @since 0.1.0.0
unsafePackageVersion :: (HasCallStack) => [Int] -> PackageVersion
unsafePackageVersion :: HasCallStack => [Int] -> PackageVersion
unsafePackageVersion =
  (ValidationError -> PackageVersion)
-> (PackageVersion -> PackageVersion)
-> Either ValidationError PackageVersion
-> PackageVersion
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Char] -> PackageVersion
forall a. HasCallStack => [Char] -> a
error ([Char] -> PackageVersion)
-> (ValidationError -> [Char]) -> ValidationError -> PackageVersion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValidationError -> [Char]
forall e. Exception e => e -> [Char]
displayException) PackageVersion -> PackageVersion
forall a. a -> a
id
    (Either ValidationError PackageVersion -> PackageVersion)
-> ([Int] -> Either ValidationError PackageVersion)
-> [Int]
-> PackageVersion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Either ValidationError PackageVersion
Internal.mkPackageVersion

-- | Creates a 'PackageVersion' from 'Version'.
--
-- Note: Because 'PackageVersion' does not have a 'Data.Version.versionTags',
-- 'fromVersion' is not injective even on "well-formed" 'Version's
-- (i.e. non-negative and length > 1). That is, @'toVersion' . 'fromVersion'@
-- is /not/ an isomorphism.
--
-- ==== __Examples__
-- >>> fromVersion (Version [2,13,0] ["alpha"])
-- Right (MkPackageVersion {unPackageVersion = 2 :| [13,0]})
--
-- >>> fromVersion (Version [] [])
-- Left ValidationErrorEmpty
--
-- @since 0.1.0.0
fromVersion :: Version -> Either ValidationError PackageVersion
fromVersion :: Version -> Either ValidationError PackageVersion
fromVersion = [Int] -> Either ValidationError PackageVersion
Internal.mkPackageVersion ([Int] -> Either ValidationError PackageVersion)
-> (Version -> [Int])
-> Version
-> Either ValidationError PackageVersion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> [Int]
versionBranch

-- | Attempts to read a 'String' into a 'PackageVersion'. Leading and/or
-- trailing dots will result in an error, as will the empty string.
--
-- ==== __Examples__
-- >>> fromString "1.4.27.3"
-- Right (MkPackageVersion {unPackageVersion = 1 :| [4,27,3]})
--
-- >>> fromString ""
-- Left (ReadStringErrorParse "Prelude.read: no parse")
--
-- >>> fromString "1.a.2"
-- Left (ReadStringErrorParse "Prelude.read: no parse")
--
-- >>> fromString ".1.2"
-- Left (ReadStringErrorParse "Prelude.read: no parse")
--
-- >>> fromString "1.2."
-- Left (ReadStringErrorParse "Prelude.read: no parse")
--
-- >>> fromString "-3.1.2"
-- Left (ReadStringErrorValidate (ValidationErrorNegative (-3)))
--
-- @since 0.1.0.0
fromString :: String -> Either ReadStringError PackageVersion
fromString :: [Char] -> Either ReadStringError PackageVersion
fromString = Text -> Either ReadStringError PackageVersion
fromText (Text -> Either ReadStringError PackageVersion)
-> ([Char] -> Text)
-> [Char]
-> Either ReadStringError PackageVersion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack

-- | Attempts to read a 'Text' into a 'PackageVersion'. Leading and/or
-- trailing dots will result in an error, as will the empty string.
--
-- ==== __Examples__
-- >>> fromText "1.4.27.3"
-- Right (MkPackageVersion {unPackageVersion = 1 :| [4,27,3]})
--
-- >>> fromText ""
-- Left (ReadStringErrorParse "Prelude.read: no parse")
--
-- >>> fromText "1.a.2"
-- Left (ReadStringErrorParse "Prelude.read: no parse")
--
-- >>> fromText ".1.2"
-- Left (ReadStringErrorParse "Prelude.read: no parse")
--
-- >>> fromText "1.2."
-- Left (ReadStringErrorParse "Prelude.read: no parse")
--
-- >>> fromText ""
-- Left (ReadStringErrorParse "Prelude.read: no parse")
--
-- >>> fromText "-3.1.2"
-- Left (ReadStringErrorValidate (ValidationErrorNegative (-3)))
--
-- @since 0.1.0.0
fromText :: Text -> Either ReadStringError PackageVersion
fromText :: Text -> Either ReadStringError PackageVersion
fromText =
  [Text] -> Either ReadStringError [Int]
readInts ([Text] -> Either ReadStringError [Int])
-> (Text -> [Text]) -> Text -> Either ReadStringError [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
splitDots
    (Text -> Either ReadStringError [Int])
-> ([Int] -> Either ReadStringError PackageVersion)
-> Text
-> Either ReadStringError PackageVersion
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (ValidationError -> ReadStringError)
-> Either ValidationError PackageVersion
-> Either ReadStringError PackageVersion
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ValidationError -> ReadStringError
ReadStringErrorValidate (Either ValidationError PackageVersion
 -> Either ReadStringError PackageVersion)
-> ([Int] -> Either ValidationError PackageVersion)
-> [Int]
-> Either ReadStringError PackageVersion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Either ValidationError PackageVersion
Internal.mkPackageVersion
  where
    splitDots :: Text -> [Text]
splitDots = (Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.')
    readInts :: [Text] -> Either ReadStringError [Int]
readInts = ([Char] -> ReadStringError)
-> Either [Char] [Int] -> Either ReadStringError [Int]
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first [Char] -> ReadStringError
ReadStringErrorParse (Either [Char] [Int] -> Either ReadStringError [Int])
-> ([Text] -> Either [Char] [Int])
-> [Text]
-> Either ReadStringError [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Either [Char] Int) -> [Text] -> Either [Char] [Int]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ([Char] -> Either [Char] Int
forall a. Read a => [Char] -> Either [Char] a
TR.readEither ([Char] -> Either [Char] Int)
-> (Text -> [Char]) -> Text -> Either [Char] Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack)

-- | Creates a 'Version' with empty 'Data.Version.versionTags' from
-- 'PackageVersion'.
--
-- ==== __Examples__
-- >>> toVersion (MkPackageVersion [3,2,0])
-- Version {versionBranch = [3,2,0], versionTags = []}
--
-- @since 0.1.0.0
toVersion :: PackageVersion -> Version
toVersion :: PackageVersion -> Version
toVersion (MkPackageVersion NonEmpty Word
v) = [Int] -> [[Char]] -> Version
Version (NonEmpty Int -> [Int]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty Int -> [Int]) -> NonEmpty Int -> [Int]
forall a b. (a -> b) -> a -> b
$ (Word -> Int) -> NonEmpty Word -> NonEmpty Int
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral NonEmpty Word
v) []

-- | Displays 'PackageVersion' in 'String' format.
--
-- ==== __Examples__
-- >>> toString (MkPackageVersion [2,7,10,0])
-- "2.7.10.0"
--
-- @since 0.1.0.0
toString :: PackageVersion -> String
toString :: PackageVersion -> [Char]
toString =
  [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
L.intercalate [Char]
"."
    ([[Char]] -> [Char])
-> (PackageVersion -> [[Char]]) -> PackageVersion -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word -> [Char]) -> [Word] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word -> [Char]
forall a. Show a => a -> [Char]
show
    ([Word] -> [[Char]])
-> (PackageVersion -> [Word]) -> PackageVersion -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Word -> [Word]
forall a. NonEmpty a -> [a]
NE.toList
    (NonEmpty Word -> [Word])
-> (PackageVersion -> NonEmpty Word) -> PackageVersion -> [Word]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageVersion -> NonEmpty Word
unPackageVersion

-- $retrieve-version-th
-- These functions allow for reading a cabal's version at compile-time. If
-- the intention is to simply read the value so it can be printed during
-- runtime (e.g. for an executable's @--version@ flag), then
-- 'packageVersionStringTH' (or 'packageVersionTextTH') is the best choice,
-- as any errors encountered will not prevent compilation.

-- | TemplateHaskell for reading the cabal file's version at compile-time.
-- Errors encountered will be returned as compilation errors.
--
-- ==== __Examples__
-- >>> $$(packageVersionTH "package-version.cabal")
-- MkPackageVersion {unPackageVersion = 0 :| [4]}
--
-- @since 0.1.0.0
#if MIN_VERSION_template_haskell(2, 17, 0)
packageVersionTH :: FilePath -> Code Q PackageVersion
#else
packageVersionTH :: FilePath -> Q (TExp PackageVersion)
#endif
packageVersionTH :: [Char] -> Code Q PackageVersion
packageVersionTH = ([Char] -> IO PackageVersion) -> [Char] -> Code Q PackageVersion
forall b a. Lift b => (a -> IO b) -> a -> Code Q b
ioToTH [Char] -> IO PackageVersion
unsafePackageVersionIO
  where
    unsafePackageVersionIO :: [Char] -> IO PackageVersion
unsafePackageVersionIO =
      (Either ReadFileError PackageVersion -> PackageVersion)
-> IO (Either ReadFileError PackageVersion) -> IO PackageVersion
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ReadFileError -> PackageVersion)
-> (PackageVersion -> PackageVersion)
-> Either ReadFileError PackageVersion
-> PackageVersion
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Char] -> PackageVersion
forall a. HasCallStack => [Char] -> a
error ([Char] -> PackageVersion)
-> (ReadFileError -> [Char]) -> ReadFileError -> PackageVersion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadFileError -> [Char]
forall e. Exception e => e -> [Char]
displayException) PackageVersion -> PackageVersion
forall a. a -> a
id)
        (IO (Either ReadFileError PackageVersion) -> IO PackageVersion)
-> ([Char] -> IO (Either ReadFileError PackageVersion))
-> [Char]
-> IO PackageVersion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> IO (Either ReadFileError PackageVersion)
packageVersionEitherIO

-- | Version of 'packageVersionTH' that returns a 'String' representation of
-- 'PackageVersion' at compile-time. Returns @\"UNKNOWN\"@ if any errors are
-- encountered.
--
-- ==== __Examples__
-- >>> $$(packageVersionStringTH "package-version.cabal")
-- "0.4"
--
-- >>> $$(packageVersionStringTH "not-found.cabal")
-- "UNKNOWN"
--
-- @since 0.1.0.0
#if MIN_VERSION_template_haskell(2, 17, 0)
packageVersionStringTH :: FilePath -> Code Q String
#else
packageVersionStringTH :: FilePath -> Q (TExp String)
#endif
packageVersionStringTH :: [Char] -> Code Q [Char]
packageVersionStringTH = ([Char] -> IO [Char]) -> [Char] -> Code Q [Char]
forall b a. Lift b => (a -> IO b) -> a -> Code Q b
ioToTH [Char] -> IO [Char]
packageVersionStringIO

-- | Version of 'packageVersionTH' that returns a 'Text' representation of
-- 'PackageVersion' at compile-time. Returns @\"UNKNOWN\"@ if any errors are
-- encountered.
--
-- ==== __Examples__
-- >>> $$(packageVersionTextTH "package-version.cabal")
-- "0.4"
--
-- >>> $$(packageVersionTextTH "not-found.cabal")
-- "UNKNOWN"
--
-- @since 0.1.0.0
#if MIN_VERSION_template_haskell(2, 17, 0)
packageVersionTextTH :: FilePath -> Code Q Text
#else
packageVersionTextTH :: FilePath -> Q (TExp Text)
#endif
packageVersionTextTH :: [Char] -> Code Q Text
packageVersionTextTH = ([Char] -> IO Text) -> [Char] -> Code Q Text
forall b a. Lift b => (a -> IO b) -> a -> Code Q b
ioToTH [Char] -> IO Text
packageVersionTextIO

-- | Version of 'packageVersionEitherIO' that throws an
-- 'Exception' if any errors are encountered.
--
-- ==== __Examples__
-- >>> packageVersionThrowIO "package-version.cabal"
-- MkPackageVersion {unPackageVersion = 0 :| [4]}
--
-- @since 0.1.0.0
packageVersionThrowIO :: FilePath -> IO PackageVersion
packageVersionThrowIO :: [Char] -> IO PackageVersion
packageVersionThrowIO = [Char] -> IO (Either ReadFileError PackageVersion)
packageVersionEitherIO ([Char] -> IO (Either ReadFileError PackageVersion))
-> (Either ReadFileError PackageVersion -> IO PackageVersion)
-> [Char]
-> IO PackageVersion
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (ReadFileError -> IO PackageVersion)
-> (PackageVersion -> IO PackageVersion)
-> Either ReadFileError PackageVersion
-> IO PackageVersion
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ReadFileError -> IO PackageVersion
forall e a. Exception e => e -> IO a
throwIO PackageVersion -> IO PackageVersion
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Version of 'packageVersionEitherIO' that returns a 'String' representation of
-- 'PackageVersion' at runtime. Returns @\"UNKNOWN\"@ if any errors are
-- encountered.
--
-- ==== __Examples__
-- >>> packageVersionStringIO "package-version.cabal"
-- "0.4"
--
-- >>> packageVersionStringIO "not-found.cabal"
-- "UNKNOWN"
--
-- @since 0.1.0.0
packageVersionStringIO :: FilePath -> IO String
packageVersionStringIO :: [Char] -> IO [Char]
packageVersionStringIO = (Text -> [Char]) -> IO Text -> IO [Char]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> [Char]
T.unpack (IO Text -> IO [Char])
-> ([Char] -> IO Text) -> [Char] -> IO [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> IO Text
packageVersionTextIO

-- | Version of 'packageVersionEitherIO' that returns a 'Text' representation of
-- 'PackageVersion' at runtime. Returns @\"UNKNOWN\"@ if any errors are
-- encountered.
--
-- ==== __Examples__
-- >>> packageVersionTextIO "package-version.cabal"
-- "0.4"
--
-- >>> packageVersionTextIO "not-found.cabal"
-- "UNKNOWN"
--
-- @since 0.1.0.0
packageVersionTextIO :: FilePath -> IO Text
packageVersionTextIO :: [Char] -> IO Text
packageVersionTextIO [Char]
fp = do
  Either ReadFileError PackageVersion
eVersion <- [Char] -> IO (Either ReadFileError PackageVersion)
packageVersionEitherIO [Char]
fp
  Text -> IO Text
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$ case Either ReadFileError PackageVersion
eVersion of
    Left ReadFileError
_ -> Text
"UNKNOWN"
    Right PackageVersion
v -> PackageVersion -> Text
Internal.toText PackageVersion
v

-- | Reads the cabal-file's version.
--
-- ==== __Examples__
-- >>> packageVersionEitherIO "package-version.cabal"
-- Right (MkPackageVersion {unPackageVersion = 0 :| [4]})
--
-- @since 0.1.0.0
packageVersionEitherIO :: FilePath -> IO (Either ReadFileError PackageVersion)
packageVersionEitherIO :: [Char] -> IO (Either ReadFileError PackageVersion)
packageVersionEitherIO [Char]
fp = do
  Either SomeException [Text]
eContents <- (Text -> [Text])
-> Either SomeException Text -> Either SomeException [Text]
forall b c a. (b -> c) -> Either a b -> Either a c
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Text -> [Text]
T.lines (Either SomeException Text -> Either SomeException [Text])
-> IO (Either SomeException Text)
-> IO (Either SomeException [Text])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e a. Exception e => IO a -> IO (Either e a)
try' @SomeException ([Char] -> IO Text
readFile' [Char]
fp)
  Either ReadFileError PackageVersion
-> IO (Either ReadFileError PackageVersion)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ReadFileError PackageVersion
 -> IO (Either ReadFileError PackageVersion))
-> Either ReadFileError PackageVersion
-> IO (Either ReadFileError PackageVersion)
forall a b. (a -> b) -> a -> b
$ case Either SomeException [Text]
eContents of
    Left SomeException
err -> ReadFileError -> Either ReadFileError PackageVersion
forall a b. a -> Either a b
Left (ReadFileError -> Either ReadFileError PackageVersion)
-> ReadFileError -> Either ReadFileError PackageVersion
forall a b. (a -> b) -> a -> b
$ [Char] -> ReadFileError
ReadFileErrorGeneral ([Char] -> ReadFileError) -> [Char] -> ReadFileError
forall a b. (a -> b) -> a -> b
$ SomeException -> [Char]
forall e. Exception e => e -> [Char]
displayException SomeException
err
    Right [Text]
contents -> (Text
 -> Either ReadFileError PackageVersion
 -> Either ReadFileError PackageVersion)
-> Either ReadFileError PackageVersion
-> [Text]
-> Either ReadFileError PackageVersion
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Text
-> Either ReadFileError PackageVersion
-> Either ReadFileError PackageVersion
findVers Either ReadFileError PackageVersion
forall {b}. Either ReadFileError b
noVersErr [Text]
contents
  where
    noVersErr :: Either ReadFileError b
noVersErr = ReadFileError -> Either ReadFileError b
forall a b. a -> Either a b
Left (ReadFileError -> Either ReadFileError b)
-> ReadFileError -> Either ReadFileError b
forall a b. (a -> b) -> a -> b
$ [Char] -> ReadFileError
ReadFileErrorVersionNotFound [Char]
fp
    findVers :: Text
-> Either ReadFileError PackageVersion
-> Either ReadFileError PackageVersion
findVers Text
line Either ReadFileError PackageVersion
acc = case Text -> Text -> Maybe Text
T.stripPrefix Text
"version:" Text
line of
      Just Text
rest -> (ReadStringError -> ReadFileError)
-> Either ReadStringError PackageVersion
-> Either ReadFileError PackageVersion
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ReadStringError -> ReadFileError
ReadFileErrorReadString (Either ReadStringError PackageVersion
 -> Either ReadFileError PackageVersion)
-> Either ReadStringError PackageVersion
-> Either ReadFileError PackageVersion
forall a b. (a -> b) -> a -> b
$ Text -> Either ReadStringError PackageVersion
fromText (Text -> Text
T.strip Text
rest)
      Maybe Text
Nothing -> Either ReadFileError PackageVersion
acc
    readFile' :: [Char] -> IO Text
readFile' = (ByteString -> Text) -> IO ByteString -> IO Text
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
lenientDecode) (IO ByteString -> IO Text)
-> ([Char] -> IO ByteString) -> [Char] -> IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> IO ByteString
BS.readFile

-- Vendoring safe-exceptions' "isSyncException" logic, as we only need it for
-- this single function, so it seems a shame to add a dependency when we
-- can easily inline it.
try' :: (Exception e) => IO a -> IO (Either e a)
try' :: forall e a. Exception e => IO a -> IO (Either e a)
try' IO a
io =
  IO a -> IO (Either e a)
forall e a. Exception e => IO a -> IO (Either e a)
try IO a
io IO (Either e a)
-> (Either e a -> IO (Either e a)) -> IO (Either e a)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left e
ex
      | e -> Bool
forall e. Exception e => e -> Bool
isSyncException e
ex -> Either e a -> IO (Either e a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either e a -> IO (Either e a)) -> Either e a -> IO (Either e a)
forall a b. (a -> b) -> a -> b
$ e -> Either e a
forall a b. a -> Either a b
Left e
ex
      | Bool
otherwise -> e -> IO (Either e a)
forall e a. Exception e => e -> IO a
throwIO e
ex
    Right a
x -> Either e a -> IO (Either e a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either e a -> IO (Either e a)) -> Either e a -> IO (Either e a)
forall a b. (a -> b) -> a -> b
$ a -> Either e a
forall a b. b -> Either a b
Right a
x

isSyncException :: (Exception e) => e -> Bool
isSyncException :: forall e. Exception e => e -> Bool
isSyncException e
e =
  case SomeException -> Maybe SomeAsyncException
forall e. Exception e => SomeException -> Maybe e
fromException (e -> SomeException
forall e. Exception e => e -> SomeException
toException e
e) of
    Just (SomeAsyncException e
_) -> Bool
False
    Maybe SomeAsyncException
Nothing -> Bool
True

#if MIN_VERSION_template_haskell(2, 17, 0)
ioToTH :: Lift b => (a -> IO b) -> a -> Code Q b
ioToTH :: forall b a. Lift b => (a -> IO b) -> a -> Code Q b
ioToTH a -> IO b
f a
x = Q b -> (b -> Code Q b) -> Code Q b
forall (m :: * -> *) a b.
Monad m =>
m a -> (a -> Code m b) -> Code m b
TH.bindCode (IO b -> Q b
forall a. IO a -> Q a
TH.runIO (a -> IO b
f a
x)) b -> Code Q b
forall t (m :: * -> *). (Lift t, Quote m) => t -> Code m t
forall (m :: * -> *). Quote m => b -> Code m b
liftTyped
#else
ioToTH :: Lift b => (a -> IO b) -> a -> Q (TExp b)
ioToTH f x = TH.runIO (f x) >>= liftTyped
#endif