{-# LANGUAGE TypeFamilies, FlexibleInstances, TypeSynonymInstances, DeriveDataTypeable #-}

module Test.Hspec.Server.Core where

import System.Exit
import Control.Monad.Trans.Reader
import qualified Test.Hspec.Core.Spec as Hspec
import Test.Hspec (beforeAll)

import Control.Monad
import Data.List
import Data.Maybe
import qualified Data.Set as S

import qualified Test.Hspec as Hspec
import qualified Test.HUnit as HUnit
import Control.Monad.IO.Class
import Control.Monad.Trans.Reader
import qualified Data.Set as S

data ServerOS =
   Ubuntu String
 | Debian String
 | CentOS String
 | Fedora String
 | Redhat String
 | LinuxOther String
 | FreeBSD String
 | MacOS String
 | Windows String
 | OtherOS String
 | AutoDetect
   deriving (Show,Eq)

type ServerName = String

class ServerType a where
  stSetup :: a -> IO a
  stOS :: a -> Maybe ServerOS
  stName :: a -> ServerName
  stCmd :: a -> FilePath -> [String] -> String -> IO (ExitCode,String,String)

type ServerExample dat = ReaderT dat IO

with :: ServerType dat => dat -> Hspec.SpecWith dat -> Hspec.Spec
with d = beforeAll (stSetup d)

instance (ServerType dat) => Hspec.Example (ServerExample dat ()) where
  type Arg (ServerExample dat ()) = dat
  evaluateExample example params action =
    Hspec.evaluateExample
      (action $ runReaderT example)
      params
      ($ ())

include :: Ord a => S.Set a -> S.Set a -> Bool
include a b = S.isSubsetOf b a
none :: S.Set a
none = S.empty

detectOS :: ServerType dat => dat -> IO (Maybe ServerOS)
detectOS dat = do
  v@(code,out,_) <- stCmd dat "bash" ["-c","echo $OSTYPE"] []
  when (code /= ExitSuccess) $ do
    error $ "detectOS's error;" ++ show v
  case listToMaybe (lines out) of
    Just str -> checkEnv str
    Nothing -> return Nothing
  where
    checkEnv str =   
      case str of
        "linux-gnu" -> detectLinux dat
        'd':'a':'r':'w':'i':'n':o -> return $ Just $ MacOS o
        "msys" -> return $ Just $ Windows "msys"
        "cygwin" -> return $ Just $ Windows "cygwin"
        "win32" -> return $ Just $ Windows "win32"
        "win64" -> return $ Just $ Windows "win64"
        'f':'r':'e':'e':'b':'s':'d':o -> return $ Just $ FreeBSD o
        o -> return $ Just $ OtherOS o

detectLinux :: ServerType dat => dat -> IO (Maybe ServerOS)
detectLinux dat = do
  let cmd = stCmd
  (_code,_out,_) <- cmd dat "cat" ["/etc/lsb-release"] []
  if _code == ExitSuccess
    then do
      let tag = "DISTRIB_RELEASE="
      let v = listToMaybe $ map (drop (length tag)) $ filter (isPrefixOf "DISTRIB_RELEASE=") (lines _out)
      case v of
        Just v' -> return $ Just $ Ubuntu v'
        Nothing -> return $ Just $ Ubuntu ""
    else do
      (_code,_out,_) <- cmd dat "cat" ["/etc/debian_version"] []
      if _code == ExitSuccess
        then return $ Just $ Debian _out
        else do
          (_code,_out,_) <- cmd dat "cat" ["/etc/centos-release"] []
          if _code == ExitSuccess
            then return $ Just $ CentOS _out
            else do
              (_code,_out,_) <- cmd dat "cat" ["/etc/fedora-release"] []
              if _code == ExitSuccess
                then return $ Just $ Fedora _out
                else do
                  (_code,_out,_) <- cmd dat "cat" ["/etc/redhat-release"] []
                  if _code == ExitSuccess
                    then return $ Just $ Fedora _out
                    else return $ Just $ LinuxOther ""

getServerData :: ServerType dat => ServerExample dat dat
getServerData = ask

getServerOS :: ServerType dat => ServerExample dat (Maybe ServerOS)
getServerOS = do 
  d <- ask
  return $ stOS d

includes' :: (ServerType dat,Show s,Ord s) => S.Set s -> S.Set s -> ServerExample dat ()
includes' org ex =
  liftIO $ flip HUnit.assertBool (include org ex) $ concat
    [ "Expected status was ", show ex
    , " but received status was ", show org
    ]

includes :: (ServerType dat,Show s,Ord s) => ServerExample dat (S.Set s) -> (S.Set s) -> ServerExample dat ()
includes org' ex = do
  org <- org'
  org `includes'` ex

(@>=) :: (ServerType dat,Show s,Ord s) => ServerExample dat (S.Set s) -> S.Set s -> ServerExample dat ()
(@>=) = includes
infix 1 @>= 

(@==) :: (ServerType dat,Show s,Ord s) => ServerExample dat (S.Set s) -> S.Set s -> ServerExample dat ()
(@==) org' ex = do
  org <- org'
  liftIO $ Hspec.shouldBe org ex
infix 1 @==