{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}
module Hpack.CabalFile (
  CabalFile(..)
, GitConflictMarkers(..)
, ExistingCabalFile
, NewCabalFile
, readCabalFile
, parseVersion
#ifdef TEST
, extractVersion
, removeGitConflictMarkers
#endif
) where

import           Imports

import           Data.Maybe
import           Data.Version (Version(..))
import qualified Data.Version as Version
import           Text.ParserCombinators.ReadP

import           Hpack.Util

data CabalFile a = CabalFile {
  forall a. CabalFile a -> [String]
cabalFileCabalVersion :: [String]
, forall a. CabalFile a -> Maybe Version
cabalFileHpackVersion :: Maybe Version
, forall a. CabalFile a -> Maybe String
cabalFileHash :: Maybe Hash
, forall a. CabalFile a -> [String]
cabalFileContents :: [String]
, forall a. CabalFile a -> a
cabalFileGitConflictMarkers :: a
} deriving (CabalFile a -> CabalFile a -> Bool
forall a. Eq a => CabalFile a -> CabalFile a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CabalFile a -> CabalFile a -> Bool
$c/= :: forall a. Eq a => CabalFile a -> CabalFile a -> Bool
== :: CabalFile a -> CabalFile a -> Bool
$c== :: forall a. Eq a => CabalFile a -> CabalFile a -> Bool
Eq, Int -> CabalFile a -> ShowS
forall a. Show a => Int -> CabalFile a -> ShowS
forall a. Show a => [CabalFile a] -> ShowS
forall a. Show a => CabalFile a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CabalFile a] -> ShowS
$cshowList :: forall a. Show a => [CabalFile a] -> ShowS
show :: CabalFile a -> String
$cshow :: forall a. Show a => CabalFile a -> String
showsPrec :: Int -> CabalFile a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> CabalFile a -> ShowS
Show)

data GitConflictMarkers = HasGitConflictMarkers | DoesNotHaveGitConflictMarkers
  deriving (Int -> GitConflictMarkers -> ShowS
[GitConflictMarkers] -> ShowS
GitConflictMarkers -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GitConflictMarkers] -> ShowS
$cshowList :: [GitConflictMarkers] -> ShowS
show :: GitConflictMarkers -> String
$cshow :: GitConflictMarkers -> String
showsPrec :: Int -> GitConflictMarkers -> ShowS
$cshowsPrec :: Int -> GitConflictMarkers -> ShowS
Show, GitConflictMarkers -> GitConflictMarkers -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GitConflictMarkers -> GitConflictMarkers -> Bool
$c/= :: GitConflictMarkers -> GitConflictMarkers -> Bool
== :: GitConflictMarkers -> GitConflictMarkers -> Bool
$c== :: GitConflictMarkers -> GitConflictMarkers -> Bool
Eq)

type ExistingCabalFile = CabalFile GitConflictMarkers
type NewCabalFile = CabalFile ()

readCabalFile :: FilePath -> IO (Maybe ExistingCabalFile)
readCabalFile :: String -> IO (Maybe ExistingCabalFile)
readCabalFile String
cabalFile = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> ExistingCabalFile
parseCabalFile forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe String)
tryReadFile String
cabalFile

parseCabalFile :: String -> ExistingCabalFile
parseCabalFile :: String -> ExistingCabalFile
parseCabalFile (String -> [String]
lines -> [String]
input) = case forall a. (a -> Bool) -> [a] -> ([a], [a])
span String -> Bool
isComment forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
isComment) [String]
clean of
  ([String]
cabalVersion, ([String]
header, [String]
body)) -> CabalFile {
    cabalFileCabalVersion :: [String]
cabalFileCabalVersion = [String]
cabalVersion
  , cabalFileHpackVersion :: Maybe Version
cabalFileHpackVersion = [String] -> Maybe Version
extractVersion [String]
header
  , cabalFileHash :: Maybe String
cabalFileHash = [String] -> Maybe String
extractHash [String]
header
  , cabalFileContents :: [String]
cabalFileContents = forall a. (a -> Bool) -> [a] -> [a]
dropWhile forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
body
  , cabalFileGitConflictMarkers :: GitConflictMarkers
cabalFileGitConflictMarkers = GitConflictMarkers
gitConflictMarkers
  }
  where
    clean :: [String]
    clean :: [String]
clean = [String] -> [String]
removeGitConflictMarkers [String]
input

    gitConflictMarkers :: GitConflictMarkers
    gitConflictMarkers :: GitConflictMarkers
gitConflictMarkers
      | [String]
input forall a. Eq a => a -> a -> Bool
== [String]
clean = GitConflictMarkers
DoesNotHaveGitConflictMarkers
      | Bool
otherwise = GitConflictMarkers
HasGitConflictMarkers

    isComment :: String -> Bool
    isComment :: String -> Bool
isComment = (String
"--" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`)

extractHash :: [String] -> Maybe Hash
extractHash :: [String] -> Maybe String
extractHash = forall a. String -> (String -> Maybe a) -> [String] -> Maybe a
extract String
"-- hash: " forall a. a -> Maybe a
Just

extractVersion :: [String] -> Maybe Version
extractVersion :: [String] -> Maybe Version
extractVersion = forall a. String -> (String -> Maybe a) -> [String] -> Maybe a
extract String
prefix (String -> Maybe String
stripFileName forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> String -> Maybe Version
parseVersion forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
safeInit)
  where
    prefix :: String
prefix = String
"-- This file has been generated from "
    stripFileName :: String -> Maybe String
    stripFileName :: String -> Maybe String
stripFileName = forall a. [a] -> Maybe a
listToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
" by hpack version ") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [[a]]
tails

extract :: String -> (String -> Maybe a) -> [String] -> Maybe a
extract :: forall a. String -> (String -> Maybe a) -> [String] -> Maybe a
extract String
prefix String -> Maybe a
parse = forall a. [a] -> Maybe a
listToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
prefix forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> String -> Maybe a
parse)

safeInit :: [a] -> [a]
safeInit :: forall a. [a] -> [a]
safeInit [] = []
safeInit [a]
xs = forall a. [a] -> [a]
init [a]
xs

parseVersion :: String -> Maybe Version
parseVersion :: String -> Maybe Version
parseVersion String
xs = case [Version
v | (Version
v, String
"") <- forall a. ReadP a -> ReadS a
readP_to_S ReadP Version
Version.parseVersion String
xs] of
  [Version
v] -> forall a. a -> Maybe a
Just Version
v
  [Version]
_ -> forall a. Maybe a
Nothing

removeGitConflictMarkers :: [String] -> [String]
removeGitConflictMarkers :: [String] -> [String]
removeGitConflictMarkers = [String] -> [String]
takeBoth
  where
    takeBoth :: [String] -> [String]
takeBoth [String]
input = case forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
marker) [String]
input of
      ([String]
both, String
_marker : [String]
rest) -> [String]
both forall a. [a] -> [a] -> [a]
++ [String] -> [String]
takeOurs [String]
rest
      ([String]
both, []) -> [String]
both
      where
        marker :: String
marker = String
"<<<<<<< "

    takeOurs :: [String] -> [String]
takeOurs [String]
input = case forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== String
marker) [String]
input of
      ([String]
ours, String
_marker : [String]
rest) -> [String]
ours forall a. [a] -> [a] -> [a]
++ [String] -> [String]
dropTheirs [String]
rest
      ([String]
ours, []) -> [String]
ours
      where
        marker :: String
marker = String
"======="

    dropTheirs :: [String] -> [String]
dropTheirs [String]
input = case forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
marker) [String]
input of
      ([String]
_theirs, String
_marker : [String]
rest) -> [String] -> [String]
takeBoth [String]
rest
      ([String]
_theirs, []) -> []
      where
        marker :: String
marker = String
">>>>>>> "