{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}
module Hpack.CabalFile where

import           Imports

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

import           Hpack.Util

makeVersion :: [Int] -> Version
makeVersion :: [Int] -> Version
makeVersion [Int]
v = [Int] -> [String] -> Version
Version [Int]
v []

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

readCabalFile :: FilePath -> IO (Maybe CabalFile)
readCabalFile :: String -> IO (Maybe CabalFile)
readCabalFile String
cabalFile = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> CabalFile
parse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe String)
tryReadFile String
cabalFile
  where
    parse :: String -> CabalFile
    parse :: String -> CabalFile
parse (String -> ([String], [String], [String])
splitHeader -> ([String]
cabalVersion, [String]
h, [String]
c)) = [String] -> Maybe Version -> Maybe String -> [String] -> CabalFile
CabalFile [String]
cabalVersion ([String] -> Maybe Version
extractVersion [String]
h) ([String] -> Maybe String
extractHash [String]
h) [String]
c

    splitHeader :: String -> ([String], [String], [String])
    splitHeader :: String -> ([String], [String], [String])
splitHeader ([String] -> [String]
removeGitConflictMarkers forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines -> [String]
c) =
      case 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]
c of
        ([String]
cabalVersion, [String]
xs) -> case forall a. (a -> Bool) -> [a] -> ([a], [a])
span String -> Bool
isComment [String]
xs of
          ([String]
header, [String]
body) -> ([String]
cabalVersion, [String]
header, forall a. (a -> Bool) -> [a] -> [a]
dropWhile forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
body)

    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
">>>>>>> "