{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

-- |
-- Copyright:   (c) 2023 Bodigrim
-- License:     BSD-3-Clause
module Distribution.Client.Common (
  CommonStanza (..),
  isComponent,
  splitAtPosition,
  TargetField (..),
  getTargetName,
) where

import Data.ByteString (ByteString)
import Data.ByteString.Char8 qualified as B
import Data.List qualified as L
import Distribution.Fields (
  Field (..),
  Name (..),
  SectionArg (..),
 )
import Distribution.PackageDescription (
  ComponentName (..),
  LibraryName (..),
  componentNameStanza,
 )
import Distribution.Parsec.Position (Position (..))

-- | Just a newtype wrapper, since @Cabal-syntax@ does not provide any.
newtype CommonStanza = CommonStanza {CommonStanza -> ByteString
unCommonStanza :: ByteString}
  deriving (CommonStanza -> CommonStanza -> Bool
(CommonStanza -> CommonStanza -> Bool)
-> (CommonStanza -> CommonStanza -> Bool) -> Eq CommonStanza
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CommonStanza -> CommonStanza -> Bool
== :: CommonStanza -> CommonStanza -> Bool
$c/= :: CommonStanza -> CommonStanza -> Bool
/= :: CommonStanza -> CommonStanza -> Bool
Eq, Eq CommonStanza
Eq CommonStanza =>
(CommonStanza -> CommonStanza -> Ordering)
-> (CommonStanza -> CommonStanza -> Bool)
-> (CommonStanza -> CommonStanza -> Bool)
-> (CommonStanza -> CommonStanza -> Bool)
-> (CommonStanza -> CommonStanza -> Bool)
-> (CommonStanza -> CommonStanza -> CommonStanza)
-> (CommonStanza -> CommonStanza -> CommonStanza)
-> Ord CommonStanza
CommonStanza -> CommonStanza -> Bool
CommonStanza -> CommonStanza -> Ordering
CommonStanza -> CommonStanza -> CommonStanza
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CommonStanza -> CommonStanza -> Ordering
compare :: CommonStanza -> CommonStanza -> Ordering
$c< :: CommonStanza -> CommonStanza -> Bool
< :: CommonStanza -> CommonStanza -> Bool
$c<= :: CommonStanza -> CommonStanza -> Bool
<= :: CommonStanza -> CommonStanza -> Bool
$c> :: CommonStanza -> CommonStanza -> Bool
> :: CommonStanza -> CommonStanza -> Bool
$c>= :: CommonStanza -> CommonStanza -> Bool
>= :: CommonStanza -> CommonStanza -> Bool
$cmax :: CommonStanza -> CommonStanza -> CommonStanza
max :: CommonStanza -> CommonStanza -> CommonStanza
$cmin :: CommonStanza -> CommonStanza -> CommonStanza
min :: CommonStanza -> CommonStanza -> CommonStanza
Ord, Int -> CommonStanza -> ShowS
[CommonStanza] -> ShowS
CommonStanza -> String
(Int -> CommonStanza -> ShowS)
-> (CommonStanza -> String)
-> ([CommonStanza] -> ShowS)
-> Show CommonStanza
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CommonStanza -> ShowS
showsPrec :: Int -> CommonStanza -> ShowS
$cshow :: CommonStanza -> String
show :: CommonStanza -> String
$cshowList :: [CommonStanza] -> ShowS
showList :: [CommonStanza] -> ShowS
Show)

isComponent :: Either CommonStanza ComponentName -> Field a -> Maybe [Field a]
isComponent :: forall a.
Either CommonStanza ComponentName -> Field a -> Maybe [Field a]
isComponent (Right ComponentName
cmp) = \case
  Section (Name a
_ ByteString
"library") [] [Field a]
subFields
    | ComponentName
cmp ComponentName -> ComponentName -> Bool
forall a. Eq a => a -> a -> Bool
== LibraryName -> ComponentName
CLibName LibraryName
LMainLibName ->
        [Field a] -> Maybe [Field a]
forall a. a -> Maybe a
Just [Field a]
subFields
  Section (Name a
_ ByteString
sectionName) [SecArgName a
_pos ByteString
sectionArg] [Field a]
subFields
    | ByteString
sectionName ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
sectionArg ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== String -> ByteString
B.pack (ComponentName -> String
componentNameStanza ComponentName
cmp) ->
        [Field a] -> Maybe [Field a]
forall a. a -> Maybe a
Just [Field a]
subFields
  Section (Name a
_ ByteString
sectionName) [SecArgStr a
_pos ByteString
sectionArg] [Field a]
subFields
    | ByteString
sectionName ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
sectionArg ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== String -> ByteString
B.pack (ComponentName -> String
componentNameStanza ComponentName
cmp) ->
        [Field a] -> Maybe [Field a]
forall a. a -> Maybe a
Just [Field a]
subFields
  Field a
_ -> Maybe [Field a]
forall a. Maybe a
Nothing
isComponent (Left (CommonStanza ByteString
commonName)) = \case
  Section (Name a
_ ByteString
"common") [SecArgName a
_pos ByteString
sectionArg] [Field a]
subFields
    | ByteString
sectionArg ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
commonName ->
        [Field a] -> Maybe [Field a]
forall a. a -> Maybe a
Just [Field a]
subFields
  Section (Name a
_ ByteString
"common") [SecArgStr a
_pos ByteString
sectionArg] [Field a]
subFields
    | ByteString
sectionArg ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
commonName ->
        [Field a] -> Maybe [Field a]
forall a. a -> Maybe a
Just [Field a]
subFields
  Field a
_ -> Maybe [Field a]
forall a. Maybe a
Nothing

-- Both lines and rows are 1-based.
splitAtPosition :: Position -> ByteString -> (ByteString, ByteString)
splitAtPosition :: Position -> ByteString -> (ByteString, ByteString)
splitAtPosition (Position Int
line Int
row) ByteString
bs
  | Int
line Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1 = Int -> ByteString -> (ByteString, ByteString)
B.splitAt (Int
row Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) ByteString
bs
  | Bool
otherwise = case Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
L.drop (Int
line Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) [Int]
nls of
      [] -> (ByteString
bs, ByteString
forall a. Monoid a => a
mempty)
      Int
nl : [Int]
_ -> Int -> ByteString -> (ByteString, ByteString)
B.splitAt (Int
nl Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
row) ByteString
bs
  where
    nls :: [Int]
nls = Char -> ByteString -> [Int]
B.elemIndices Char
'\n' ByteString
bs

-- | A field in a cabal file, new content can be added to
data TargetField
  = -- | Corresponds to @build-depends@ in the cabal file
    BuildDepends
  | -- | Corresponds to @exposed-modules@ in the cabal file
    ExposedModules
  | -- | Corresponds to @other-modules@ in the cabal file
    OtherModules
  deriving (TargetField -> TargetField -> Bool
(TargetField -> TargetField -> Bool)
-> (TargetField -> TargetField -> Bool) -> Eq TargetField
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TargetField -> TargetField -> Bool
== :: TargetField -> TargetField -> Bool
$c/= :: TargetField -> TargetField -> Bool
/= :: TargetField -> TargetField -> Bool
Eq, Int -> TargetField -> ShowS
[TargetField] -> ShowS
TargetField -> String
(Int -> TargetField -> ShowS)
-> (TargetField -> String)
-> ([TargetField] -> ShowS)
-> Show TargetField
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TargetField -> ShowS
showsPrec :: Int -> TargetField -> ShowS
$cshow :: TargetField -> String
show :: TargetField -> String
$cshowList :: [TargetField] -> ShowS
showList :: [TargetField] -> ShowS
Show, Eq TargetField
Eq TargetField =>
(TargetField -> TargetField -> Ordering)
-> (TargetField -> TargetField -> Bool)
-> (TargetField -> TargetField -> Bool)
-> (TargetField -> TargetField -> Bool)
-> (TargetField -> TargetField -> Bool)
-> (TargetField -> TargetField -> TargetField)
-> (TargetField -> TargetField -> TargetField)
-> Ord TargetField
TargetField -> TargetField -> Bool
TargetField -> TargetField -> Ordering
TargetField -> TargetField -> TargetField
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TargetField -> TargetField -> Ordering
compare :: TargetField -> TargetField -> Ordering
$c< :: TargetField -> TargetField -> Bool
< :: TargetField -> TargetField -> Bool
$c<= :: TargetField -> TargetField -> Bool
<= :: TargetField -> TargetField -> Bool
$c> :: TargetField -> TargetField -> Bool
> :: TargetField -> TargetField -> Bool
$c>= :: TargetField -> TargetField -> Bool
>= :: TargetField -> TargetField -> Bool
$cmax :: TargetField -> TargetField -> TargetField
max :: TargetField -> TargetField -> TargetField
$cmin :: TargetField -> TargetField -> TargetField
min :: TargetField -> TargetField -> TargetField
Ord)

getTargetName :: TargetField -> ByteString
getTargetName :: TargetField -> ByteString
getTargetName = \case
  TargetField
BuildDepends -> ByteString
"build-depends"
  TargetField
ExposedModules -> ByteString
"exposed-modules"
  TargetField
OtherModules -> ByteString
"other-modules"