    {-# 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
    (CabalFile a -> CabalFile a -> Bool)
    -> (CabalFile a -> CabalFile a -> Bool) -> Eq (CabalFile a)
    forall a. Eq a => CabalFile a -> CabalFile a -> Bool
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $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
    /= :: CabalFile a -> CabalFile a -> Bool
    Eq, Int -> CabalFile a -> ShowS
    [CabalFile a] -> ShowS
    CabalFile a -> String
    (Int -> CabalFile a -> ShowS)
    -> (CabalFile a -> String)
    -> ([CabalFile a] -> ShowS)
    -> Show (CabalFile a)
    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
    $cshowsPrec :: forall a. Show a => Int -> CabalFile a -> ShowS
    showsPrec :: Int -> CabalFile a -> ShowS
    $cshow :: forall a. Show a => CabalFile a -> String
    show :: CabalFile a -> String
    $cshowList :: forall a. Show a => [CabalFile a] -> ShowS
    showList :: [CabalFile a] -> ShowS
    Show)

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

    type ExistingCabalFile = CabalFile GitConflictMarkers
    type NewCabalFile = CabalFile ()

    readCabalFile :: FilePath -> IO (Maybe ExistingCabalFile)
    readCabalFile :: String -> IO (Maybe ExistingCabalFile)
    readCabalFile String
    cabalFile = (String -> ExistingCabalFile)
    -> Maybe String -> Maybe ExistingCabalFile
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap String -> ExistingCabalFile
    parseCabalFile (Maybe String -> Maybe ExistingCabalFile)
    -> IO (Maybe String) -> IO (Maybe ExistingCabalFile)
    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 (String -> Bool) -> [String] -> ([String], [String])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    span String -> Bool
    isComment ([String] -> ([String], [String]))
    -> ([String], [String]) -> ([String], ([String], [String]))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (String -> Bool) -> [String] -> ([String], [String])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    span (Bool -> Bool
    not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
    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 = (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile String -> Bool
    forall a. [a] -> Bool
    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 [String] -> [String] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [String]
    clean = GitConflictMarkers
    DoesNotHaveGitConflictMarkers
          | Bool
    otherwise = GitConflictMarkers
    HasGitConflictMarkers

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

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

    extractVersion :: [String] -> Maybe Version
    extractVersion :: [String] -> Maybe Version
    extractVersion = String -> (String -> Maybe Version) -> [String] -> Maybe Version
    forall a. String -> (String -> Maybe a) -> [String] -> Maybe a
    extract String
    prefix (String -> Maybe String
    stripFileName (String -> Maybe String)
    -> (String -> Maybe Version) -> String -> Maybe Version
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m b) -> (b -> m c) -> a -> m c
    >=> String -> Maybe Version
    parseVersion (String -> Maybe Version) -> ShowS -> String -> Maybe Version
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    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 = [String] -> Maybe String
    forall a. [a] -> Maybe a
    listToMaybe ([String] -> Maybe String)
    -> (String -> [String]) -> String -> Maybe String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> Maybe String) -> [String] -> [String]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe (String -> String -> Maybe String
    forall a. Eq a => [a] -> [a] -> Maybe [a]
    stripPrefix String
    " by hpack version ") ([String] -> [String])
    -> (String -> [String]) -> String -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String]
    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 = [a] -> Maybe a
    forall a. [a] -> Maybe a
    listToMaybe ([a] -> Maybe a) -> ([String] -> [a]) -> [String] -> Maybe a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> Maybe a) -> [String] -> [a]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe (String -> String -> Maybe String
    forall a. Eq a => [a] -> [a] -> Maybe [a]
    stripPrefix String
    prefix (String -> Maybe String)
    -> (String -> Maybe a) -> String -> Maybe a
    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 = [a] -> [a]
    forall a. HasCallStack => [a] -> [a]
    init [a]
    xs

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

    removeGitConflictMarkers :: [String] -> [String]
    removeGitConflictMarkers :: [String] -> [String]
    removeGitConflictMarkers = [String] -> [String]
    takeBoth
      where
        takeBoth :: [String] -> [String]
    takeBoth [String]
    input = case (String -> Bool) -> [String] -> ([String], [String])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    isPrefixOf String
    marker) [String]
    input of
          ([String]
    both, String
    _marker : [String]
    rest) -> [String]
    both [String] -> [String] -> [String]
    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 (String -> Bool) -> [String] -> ([String], [String])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    marker) [String]
    input of
          ([String]
    ours, String
    _marker : [String]
    rest) -> [String]
    ours [String] -> [String] -> [String]
    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 (String -> Bool) -> [String] -> ([String], [String])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (String -> String -> Bool
    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
    ">>>>>>> "