{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE TypeSynonymInstances #-}
module Stackage.BuildPlan
    ( readBuildPlan
    , writeBuildPlan
    , writeBuildPlanCsv
    ) where

import qualified Data.Map          as Map
import qualified Data.Set          as Set
import           Distribution.Text (display, simpleParse)
import           Stackage.Types
import qualified System.IO.UTF8
import           Data.Char         (isSpace)
import           Stackage.Util

readBuildPlan :: FilePath -> IO BuildPlan
readBuildPlan fp = do
    str <- System.IO.UTF8.readFile fp
    case fromString str of
        Left s -> error $ "Could not read build plan: " ++ s
        Right (x, "") -> return x
        Right (_, _:_) -> error "Trailing content when reading build plan"

writeBuildPlan :: FilePath -> BuildPlan -> IO ()
writeBuildPlan fp bp = System.IO.UTF8.writeFile fp $ toString bp

class AsString a where
    toString :: a -> String
    fromString :: String -> Either String (a, String)

instance AsString BuildPlan where
    toString BuildPlan {..} = concat
        [ makeSection "tools" bpTools
        , makeSection "packages" $ Map.toList bpPackages
        , makeSection "core" $ Map.toList bpCore
        , makeSection "optional-core" $ Map.toList bpOptionalCore
        , makeSection "skipped-tests" $ Set.toList bpSkippedTests
        , makeSection "expected-failures" $ Set.toList bpExpectedFailures
        ]
    fromString s1 = do
        (tools, s2) <- getSection "tools" s1
        (packages, s3) <- getSection "packages" s2
        (core, s4) <- getSection "core" s3
        (optionalCore, s5) <- getSection "optional-core" s4
        (skipped, s6) <- getSection "skipped-tests" s5
        (failures, s7) <- getSection "expected-failures" s6
        let bp = BuildPlan
                { bpTools = tools
                , bpPackages = Map.fromList packages
                , bpCore = Map.fromList core
                , bpOptionalCore = Map.fromList optionalCore
                , bpSkippedTests = Set.fromList skipped
                , bpExpectedFailures = Set.fromList failures
                }
        return (bp, s7)

makeSection :: AsString a => String -> [a] -> String
makeSection title contents = unlines
    $ ("-- BEGIN " ++ title)
    : map toString contents
   ++ ["-- END " ++ title, ""]

instance AsString String where
    toString = id
    fromString s = Right (s, "")

instance AsString PackageName where
    toString (PackageName pn) = pn
    fromString s = Right (PackageName s, "")

instance AsString (Maybe Version) where
    toString Nothing = ""
    toString (Just x) = toString x
    fromString s
        | all isSpace s = return (Nothing, s)
        | otherwise = do
            (v, s') <- fromString s
            return (Just v, s')

instance AsString a => AsString (PackageName, a) where
    toString (PackageName pn, s) = concat [pn, " ", toString s]
    fromString s = do
        (pn, rest) <- takeWord s
        (rest', s') <- fromString rest
        return ((PackageName pn, rest'), s')

takeWord :: AsString a => String -> Either String (a, String)
takeWord s =
    case break (== ' ') s of
        (x, _:y) -> do
            (x', s') <- fromString x
            if null s'
                then Right (x', y)
                else Left $ "Unconsumed input in takeWord call"
        (_, []) -> Left "takeWord failed"

instance AsString SelectedPackageInfo where
    toString SelectedPackageInfo {..} = unwords
        [ display spiVersion
        , toString spiHasTests
        , (\v -> if null v then "@" else v) $ githubMentions spiGithubUser
        , unMaintainer spiMaintainer
        ]
    fromString s1 = do
        (version, s2) <- takeWord s1
        (hasTests, s3) <- takeWord s2
        (gu, m) <- takeWord s3
        Right (SelectedPackageInfo
            { spiVersion = version
            , spiHasTests = hasTests
            , spiGithubUser = [gu]
            , spiMaintainer = Maintainer m
            }, "")

instance AsString (Maybe String) where
    toString Nothing = "@"
    toString (Just x) = "@" ++ x
    fromString "@" = Right (Nothing, "")
    fromString ('@':rest) = Right (Just rest, "")
    fromString x = Left $ "Invalid Github user: " ++ x

instance AsString Bool where
    toString True = "test"
    toString False = "notest"
    fromString "test" = Right (True, "")
    fromString "notest" = Right (False, "")
    fromString x = Left $ "Invalid test value: " ++ x

instance AsString Version where
    toString = display
    fromString s =
        case simpleParse s of
            Nothing -> Left $ "Invalid version: " ++ s
            Just v -> Right (v, "")

getSection :: AsString a => String -> String -> Either String ([a], String)
getSection title orig =
    case lines orig of
        [] -> Left "Unexpected EOF when looking for a section"
        l1:ls1
            | l1 == begin ->
                case break (== end) ls1 of
                    (here, _:"":rest) -> do
                        here' <- mapM fromString' here
                        Right (here', unlines rest)
                    (_, _) -> Left $ "Could not find section end: " ++ title
            | otherwise -> Left $ "Could not find section start: " ++ title
  where
    begin = "-- BEGIN " ++ title
    end = "-- END " ++ title

    fromString' x = do
        (y, z) <- fromString x
        if null z
            then return y
            else Left $ "Unconsumed input on line: " ++ x

-- | Used for Hackage distribution purposes.
writeBuildPlanCsv :: FilePath -> BuildPlan -> IO ()
writeBuildPlanCsv fp bp =
    -- Obviously a proper CSV library should be used... but we're minimizing
    -- deps
    System.IO.UTF8.writeFile fp $ unlines $ map toRow $ Map.toList fullMap
  where
    fullMap = Map.unions
        [ fmap spiVersion $ bpPackages bp
        , Map.mapMaybe id $ bpCore bp
        , bpOptionalCore bp
        ]

    toRow (PackageName name, version) = concat
        [ "\""
        , name
        , "\",\""
        , display version
        , "\",\"http://www.stackage.org/package/"
        , name
        , "\""
        ]