{-# LANGUAGE CPP #-}

-- | Copyright: (c) 2021-2022 berberman
-- SPDX-License-Identifier: MIT
-- Maintainer: berberman <berberman@yandex.com>
-- Stability: experimental
-- Portability: portable
module NvFetcher.Utils where

import Data.Binary
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import Data.Text (Text)
import qualified Data.Text as T
import System.Directory.Extra (XdgDirectory (XdgData), getXdgDirectory)
import Text.Regex.TDFA ((=~))
#if MIN_VERSION_aeson(2,0,0)
import qualified Data.Aeson.Key as A
#endif

encode' :: Binary a => a -> BS.ByteString
encode' :: forall a. Binary a => a -> ByteString
encode' = [ByteString] -> ByteString
BS.concat ([ByteString] -> ByteString)
-> (a -> [ByteString]) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LazyByteString -> [ByteString]
LBS.toChunks (LazyByteString -> [ByteString])
-> (a -> LazyByteString) -> a -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> LazyByteString
forall a. Binary a => a -> LazyByteString
encode

decode' :: Binary a => BS.ByteString -> a
decode' :: forall a. Binary a => ByteString -> a
decode' = LazyByteString -> a
forall a. Binary a => LazyByteString -> a
decode (LazyByteString -> a)
-> (ByteString -> LazyByteString) -> ByteString -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> LazyByteString
LBS.fromChunks ([ByteString] -> LazyByteString)
-> (ByteString -> [ByteString]) -> ByteString -> LazyByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure

quote :: Text -> Text
quote :: Text -> Text
quote = String -> Text
T.pack (String -> Text) -> (Text -> String) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall a. Show a => a -> String
show

isLegalNixId :: Text -> Bool
isLegalNixId :: Text -> Bool
isLegalNixId Text
x = Text
x Text -> String -> Bool
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ String
"^[a-zA-Z_][a-zA-Z0-9_'-]*$"

quoteIfNeeds :: Text -> Text
quoteIfNeeds :: Text -> Text
quoteIfNeeds Text
x
  | Text -> Bool
isLegalNixId Text
x = Text
x
  | Bool
otherwise = Text -> Text
quote Text
x

getDataDir :: IO FilePath
getDataDir :: IO String
getDataDir = XdgDirectory -> String -> IO String
getXdgDirectory XdgDirectory
XdgData String
"nvfetcher"

#if MIN_VERSION_aeson(2,0,0)
aesonKey :: Text -> A.Key
aesonKey :: Text -> Key
aesonKey = Text -> Key
A.fromText
#else
aesonKey :: Text -> Text
aesonKey = id
#endif