{-# LANGUAGE CPP #-}
{-# LANGUAGE UndecidableInstances #-}
module Data.Version.Package
(
PackageVersion (MkPackageVersion),
Internal.mkPackageVersion,
mkPackageVersionTH,
unsafePackageVersion,
fromVersion,
fromString,
fromText,
unPackageVersion,
toVersion,
toString,
Internal.toText,
packageVersionTH,
packageVersionStringTH,
packageVersionTextTH,
packageVersionThrowIO,
packageVersionStringIO,
packageVersionTextIO,
packageVersionEitherIO,
ValidationError (..),
ReadStringError (..),
ReadFileError (..),
)
where
import Control.Exception.Safe (SomeException)
import Control.Exception.Safe qualified as SafeEx
import Control.Monad ((>=>))
import Data.Bifunctor (Bifunctor (..))
import Data.List qualified as L
import Data.Text (Text)
import Data.Text qualified as T
import Data.Version (Version (..))
#if MIN_VERSION_template_haskell(2, 17, 0)
import Language.Haskell.TH (Code, Q)
#else
import Language.Haskell.TH (Q, TExp)
#endif
#if MIN_VERSION_prettyprinter(1, 7, 1)
import Prettyprinter (Pretty (..))
import Prettyprinter qualified as Pretty
import Prettyprinter.Render.String qualified as PrettyS
#else
import Data.Text.Prettyprint.Doc (Pretty (..), (<+>))
import Data.Text.Prettyprint.Doc qualified as Pretty
import Data.Text.Prettyprint.Doc.Render.String qualified as PrettyS
#endif
import Data.Version.Package.Internal
( PackageVersion (..),
ReadFileError (..),
ReadStringError (..),
ValidationError (..),
)
import Data.Version.Package.Internal qualified as Internal
import Language.Haskell.TH qualified as TH
import Language.Haskell.TH.Syntax (Lift (..))
import System.IO qualified as IO
import Text.Read qualified as TR
#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
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 a. Pretty a => a -> [Char]
prettyErr ValidationError
err
unsafePackageVersion :: [Int] -> PackageVersion
unsafePackageVersion :: [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 a. Pretty a => a -> [Char]
prettyErr) 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
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
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
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 (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ValidationError -> ReadStringError
RsValidateErr (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 (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first [Char] -> ReadStringError
RsReadStrErr (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)
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)
toVersion :: PackageVersion -> Version
toVersion :: PackageVersion -> Version
toVersion (UnsafePackageVersion [Int]
v) = [Int] -> [[Char]] -> Version
Version [Int]
v []
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
. (Int -> [Char]) -> [Int] -> [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> [Char]
forall a. Show a => a -> [Char]
show ([Int] -> [[Char]])
-> (PackageVersion -> [Int]) -> PackageVersion -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageVersion -> [Int]
unPackageVersion
#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 (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 a. Pretty a => a -> [Char]
prettyErr) 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
#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
#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
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 (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
SafeEx.throw PackageVersion -> IO PackageVersion
forall (f :: * -> *) a. Applicative f => a -> f a
pure
packageVersionStringIO :: FilePath -> IO String
packageVersionStringIO :: [Char] -> IO [Char]
packageVersionStringIO [Char]
fp = do
Either ReadFileError PackageVersion
eVersion <- [Char] -> IO (Either ReadFileError PackageVersion)
packageVersionEitherIO [Char]
fp
[Char] -> IO [Char]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char] -> IO [Char]) -> [Char] -> IO [Char]
forall a b. (a -> b) -> a -> b
$ case Either ReadFileError PackageVersion
eVersion of
Left ReadFileError
_ -> [Char]
"UNKNOWN"
Right PackageVersion
v -> PackageVersion -> [Char]
toString PackageVersion
v
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 (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
packageVersionEitherIO :: FilePath -> IO (Either ReadFileError PackageVersion)
packageVersionEitherIO :: [Char] -> IO (Either ReadFileError PackageVersion)
packageVersionEitherIO [Char]
fp = do
Either SomeException [Text]
eContents :: Either SomeException [Text] <-
([Char] -> [Text])
-> Either SomeException [Char] -> Either SomeException [Text]
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (Text -> [Text]
T.lines (Text -> [Text]) -> ([Char] -> Text) -> [Char] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack) (Either SomeException [Char] -> Either SomeException [Text])
-> IO (Either SomeException [Char])
-> IO (Either SomeException [Text])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [Char] -> IO (Either SomeException [Char])
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
SafeEx.try ([Char] -> IO [Char]
readFile' [Char]
fp)
Either ReadFileError PackageVersion
-> IO (Either ReadFileError PackageVersion)
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
RfFileNotFoundErr ([Char] -> ReadFileError) -> [Char] -> ReadFileError
forall a b. (a -> b) -> a -> b
$ SomeException -> [Char]
forall a. Show a => a -> [Char]
show SomeException
err
Right [Text]
contents -> (Text
-> Either ReadFileError PackageVersion
-> Either ReadFileError PackageVersion)
-> Either ReadFileError PackageVersion
-> [Text]
-> Either ReadFileError PackageVersion
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
RfVersionNotFoundErr [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 (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ReadStringError -> ReadFileError
RfReadValidateErr (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
#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
liftTyped
#else
ioToTH :: Lift b => (a -> IO b) -> a -> Q (TExp b)
ioToTH f x = TH.runIO (f x) >>= liftTyped
#endif
#if MIN_VERSION_base(4, 15, 0)
readFile' :: FilePath -> IO String
readFile' :: [Char] -> IO [Char]
readFile' = [Char] -> IO [Char]
IO.readFile'
#else
readFile' :: FilePath -> IO String
readFile' name = IO.withFile name IO.ReadMode hGetContents'
where
hGetContents' h = IO.hGetContents h >>= \s -> length s `seq` pure s
#endif
prettyErr :: Pretty a => a -> String
prettyErr :: forall a. Pretty a => a -> [Char]
prettyErr =
SimpleDocStream Any -> [Char]
forall ann. SimpleDocStream ann -> [Char]
PrettyS.renderString
(SimpleDocStream Any -> [Char])
-> (a -> SimpleDocStream Any) -> a -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutOptions -> Doc Any -> SimpleDocStream Any
forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
Pretty.layoutSmart LayoutOptions
Pretty.defaultLayoutOptions
(Doc Any -> SimpleDocStream Any)
-> (a -> Doc Any) -> a -> SimpleDocStream Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Doc Any
forall a ann. Pretty a => a -> Doc ann
pretty