-- |
-- Module      : Data.Git.Revision
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : unix
--
{-# LANGUAGE DeriveDataTypeable #-}
module Data.Git.Revision
    ( Revision(..)
    , RevModifier(..)
    , RevisionNotFound(..)
    , fromString
    ) where

import Control.Applicative
import Control.Arrow (first)
import Data.String
import Data.List
import Data.Data
import Data.Char

-- | A modifier to a revision, which is
-- a function apply of a revision
data RevModifier =
      RevModParent Int       -- ^ parent accessor ^<n> and ^
    | RevModParentFirstN Int -- ^ parent accessor ~<n>
    | RevModAtType String    -- ^ @{type} accessor
    | RevModAtDate String    -- ^ @{date} accessor
    | RevModAtN Int          -- ^ @{n} accessor
    deriving (Eq,Data,Typeable)

instance Show RevModifier where
    show (RevModParent 1)       = "^"
    show (RevModParent n)       = "^" ++ show n
    show (RevModParentFirstN n) = "~" ++ show n
    show (RevModAtType s)       = "@{" ++ s ++ "}"
    show (RevModAtDate s)       = "@{" ++ s ++ "}"
    show (RevModAtN s)          = "@{" ++ show s ++ "}"

-- | A git revision. this can be many things:
--    * a shorten ref
--    * a ref
--    * a named branch or tag
--  followed by optional modifiers 'RevModifier' that can represent:
--    * parenting
--    * type
--    * date
data Revision = Revision String [RevModifier]
    deriving (Eq,Data,Typeable)

-- | Exception when a revision cannot be resolved to a reference
data RevisionNotFound = RevisionNotFound Revision
    deriving (Show,Eq,Data,Typeable)

instance Show Revision where
    show (Revision s ms) = s ++ concatMap show ms

instance IsString Revision where
    fromString = revFromString

revFromString :: String -> Revision
revFromString s = either (error.show) fst $ runStream parser s
  where parser :: Stream Char Revision
        parser = do
            p    <- many (noneOf "^~@")
            mods <- many (parseParent <|> parseFirstParent <|> parseAt)
            return $ Revision p mods
        parseParent = do
            _ <- char '^'
            n <- optional (some digit)
            case n of
                Nothing -> return $ RevModParent 1
                Just d  -> return $ RevModParent (read d)
        parseFirstParent =
            RevModParentFirstN . read <$> (char '~' *> some digit)
        parseAt = do
            _  <- char '@' >> char '{'
            at <- parseAtType <|> parseAtDate <|> parseAtN
            _  <- char '}'
            return at
        parseAtType = do
            RevModAtType <$> (string "tree" <|> string "commit" <|> string "blob" <|> string "tag")
        parseAtN = do
            RevModAtN . read <$> some digit
        parseAtDate = do
            RevModAtDate <$> many (noneOf "}")

-- combinator

        char c = eatRet (\x -> if x == c then Just c else Nothing)
        string str = prefix (\x -> if isPrefixOf str x then Just (str, length str) else Nothing)
        digit = eatRet (\x -> if isDigit x then Just x else Nothing)
        noneOf l = eatRet (\x -> if not (x `elem` l) then Just x else Nothing)

prefix :: ([elem] -> Maybe (a, Int)) -> Stream elem a
prefix predicate = Stream $ \el ->
    case el of
        [] -> Left ("empty stream: prefix")
        _  ->
            case predicate el of
                Just (a,i) -> Right (a, drop i el)
                Nothing    -> Left ("unexpected stream")

eatRet :: Show elem => (elem -> Maybe a) -> Stream elem a
eatRet predicate = Stream $ \el ->
    case el of
        []   -> Left ("empty stream: eating")
        x:xs ->
            case predicate x of
                Just a  -> Right (a, xs)
                Nothing -> Left ("unexpected atom got: " ++ show x)

newtype Stream elem a = Stream { runStream :: [elem] -> Either String (a, [elem]) }
instance Functor (Stream elem) where
    fmap f s = Stream $ \e1 -> case runStream s e1 of
        Left err     -> Left err
        Right (a,e2) -> Right (f a, e2)
instance Applicative (Stream elem) where
    pure  = return
    fab <*> fa = Stream $ \e1 -> case runStream fab e1 of
        Left err      -> Left err
        Right (f, e2) -> either Left (Right . first f) $ runStream fa e2
instance Alternative (Stream elem) where
    empty     = Stream $ \_  -> Left "empty"
    f1 <|> f2 = Stream $ \e1 -> either (\_ -> runStream f2 e1) Right $ runStream f1 e1
instance Monad (Stream elem) where
    return a  = Stream $ \e1 -> Right (a, e1)
    ma >>= mb = Stream $ \e1 -> either Left (\(a, e2) -> runStream (mb a) e2) $ runStream ma e1