{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell   #-}

module Main (main) where


import           Control.Applicative      (pure, (<*>))
import qualified Control.Arrow            as Arrow (first)
import           Control.Exception        (IOException, catch)
import           Control.Monad            ((>=>))
import           Data.Aeson               as Aeson (ToJSON, Value, object,
                                                    toJSON, (.=))
import           Data.Aeson.Encode.Pretty (encodePretty)
import           Data.Bool                (bool)
import qualified Data.ByteString          as ByteString (ByteString, hPut)
import qualified Data.ByteString.Lazy     as LBS (hPut)
import           Data.FileEmbed           (embedFile)
import           Data.Functor             ((<$>))
import           Data.Maybe               (fromMaybe)
import           Data.Text                as Text (Text, append, intercalate,
                                                   pack, splitOn, unpack)
import           Data.Text.IO             as TextIO (getLine, putStrLn)
import           Data.Traversable         (sequenceA)
import           Prelude                  hiding (getLine, putStrLn)
import           System.Directory         (createDirectoryIfMissing,
                                           doesDirectoryExist, doesFileExist,
                                           getCurrentDirectory, makeAbsolute)
import           System.Environment       (getArgs)
import           System.FilePath          (isValid, takeBaseName, (</>))
import           System.IO                (IOMode (WriteMode), withFile)


standardDirectories :: [FilePath]
standardDirectories = [ "elm-stuff" ]

standardSourceFolders :: [FilePath]
standardSourceFolders = [ "src" ]

standardFiles :: [(FilePath, Maybe ByteString.ByteString)]
standardFiles = [ ("README.md", Nothing) ]

standardSourceFiles :: [(FilePath, Maybe ByteString.ByteString)]
standardSourceFiles = [ ("Main.elm", Just $(embedFile "resources/Main.elm")) ]

standardLicenses :: [(Text, Maybe ByteString.ByteString)]
standardLicenses =
  [ ("None"   , Nothing                                       )
  , ("BSD3"   , Just $(embedFile "resources/licenses/BSD3"   ))
  , ("LGPL3"  , Just $(embedFile "resources/licenses/LGPL3"  ))
  , ("LGPL2"  , Just $(embedFile "resources/licenses/LGPL2"  ))
  , ("MIT"    , Just $(embedFile "resources/licenses/MIT"    ))
  , ("Apache" , Just $(embedFile "resources/licenses/Apache" ))
  , ("GPLv2"  , Just $(embedFile "resources/licenses/GPLv2"  ))
  , ("GPLv3"  , Just $(embedFile "resources/licenses/GPLv3"  ))
  ]

defaultProjectVersion :: Version
defaultProjectVersion = Version 1 0 0

defaultElmVersion :: Text
defaultElmVersion = "0.15.0 <= v < 0.16.0"

availableLicenses :: [Text]
availableLicenses = fst $ unzip standardLicenses

elmConfigName :: FilePath
elmConfigName = "elm-package.json"


type Result = Either Text ()


data CmdArgs = CmdArgs { workingDirectory :: FilePath }


data Version = Version { majorVersion :: Int
                       , minorVersion :: Int
                       , fineVersion  :: Int
                       }


data UserDecisions = Default { projectName  :: Text
                             , sourceFolder :: FilePath
                             , version      :: Version
                             , summary      :: Text
                             , repository   :: Text
                             , license      :: Text
                             , elmVersion   :: Text
                             }


data ElmPackage = ElmPackage { pkgVersion        :: Version
                             , pkgSummary        :: Text
                             , pkgRepository     :: Text
                             , pkgLicense        :: Text
                             , pkgDependencies   :: Aeson.Value
                             , pkgExposedModules :: [Text]
                             , pkgElmVersion     :: Text
                             , pkgSourceDirs     :: [Text]
                             }


instance Aeson.ToJSON ElmPackage where
  toJSON = object . sequenceA
    [ ("version" .=)          . show . pkgVersion
    , ("summary" .=)          . pkgSummary
    , ("repository" .=)       . pkgRepository
    , ("license" .=)          . pkgLicense
    , ("dependencies" .=)     . pkgDependencies
    , ("exposed-modules" .=)  . pkgExposedModules
    , ("elm-version" .=)      . pkgElmVersion
    , ("source-directories".=). pkgSourceDirs
    ]


instance Show Version where
  showsPrec _ (Version ma mi fi) =
    shows ma . showChar '.' . shows mi . showChar '.' . shows fi


versionFromString :: Text -> Version
versionFromString s
  | length sp /= 3  = error "Parse failed"  -- I'm so sorry
  | otherwise       = Version ma mi fi
  where
    sp@[ma,mi,fi] = map (read.unpack) (splitOn "." s) :: [Int]


emptyDecisions :: UserDecisions
emptyDecisions =
  Default { summary       = ""
          , repository    = ""
          , version       = Version 0 0 0
          , license       = ""
          , sourceFolder  = ""
          , projectName   = ""
          , elmVersion    = ""
          }


makePackage :: UserDecisions -> ElmPackage
makePackage = ElmPackage
  <$> version
  <*> summary
  <*> repository
  <*> license
  <*> const (object [])
  <*> const []
  <*> elmVersion
  <*> (:[]) . pack . sourceFolder


enumerate :: Int -> [a] -> [(Int,a)]
enumerate from l = zip [from..(length l)] l


getEither :: Read a => a -> IO a
getEither =
  catch readLn . handler
  where
    handler :: a -> IOException -> IO a
    handler = const . return


askChoices :: Text -> Int -> [Text] -> IO Text
askChoices =
  ((fmap <$> (!!) <*>) .) . askChoices'


askChoices' :: Text -> Int -> [Text] -> IO Int
askChoices' message selected choices =
  putStrLn message >>
  ask out

  where
    (l1, selectedElem : l2tail) = splitAt selected choices
    out =
      intercalate
        "\n"
        (normFormat 1 l1
          ++ (selectedFormat selected selectedElem : normFormat (selected + 1) l2tail))

    enumF = flip append " )  " . pack . show
    enumFn = append "    " . enumF
    enumFs = append "  * " . enumF
    normFormat = (map (uncurry append . Arrow.first enumFn) .) . enumerate
    selectedFormat x y = (flip append y . enumFs) x

    ask =
          (>>)
          <$> putStrLn
          <*> (\a ->
                getEither selected >>=
                  (bool
                    (putStrLn "invalid choice, please choose again" >>
                    ask a)
                    <$> return
                    <*> (<= length choices)))


askChoicesWithOther :: Text -> Int -> (Text -> Bool) -> [Text] -> IO Text
askChoicesWithOther m s verifier =
  (>>=)
    <$> askChoices' m s . (++ ["other (specify)"])
    <*> ((\a -> (<*>) (flip bool getAlternative
          <$> return . a)
          . (==) )
            <$> (!!)
            <*> length)

  where
    getAlternative =
      putStrLn "please enter an alternative" >>
      getLine >>=
        (bool
          (putStrLn "Invalid input, plese enter again" >>
          getAlternative)
        <$> return
        <*> verifier)


exists :: FilePath -> IO Bool
exists =
  (>>=)
  <$> doesFileExist
  <*> (flip bool
        (return True)
        . doesDirectoryExist)


getCmdArgs :: IO CmdArgs
getCmdArgs =
  fmap CmdArgs
    (getArgs >>=
      (\args ->
        case args of
          []  -> getCurrentDirectory
          [x] -> makeAbsolute x
          _   -> error "Too many arguments"))  -- I'm so sorry


verifyWD :: FilePath -> IO FilePath
verifyWD wd =
  doesFileExist wd >>=
    bool
      (doesDirectoryExist wd >>=
        bool
          (putStrLn "the chosen directory does not exist yet, shall I create it? [y/n]"
          >> getResp >>=
            bool
              (error "the chosen directory does not exist")  -- I'm so sorry
              makeDirs
          >> return wd)
          (return wd))
      (error "The chosen directory is a file") -- I'm so sorry

  where
    getResp :: IO Bool
    getResp = flip elem ["y", "yes"] <$> getLine

    makeDirs = createDirectoryIfMissing True wd


getUserDecisions :: FilePath -> IO UserDecisions
getUserDecisions wd =
  Default
  <$> askChoicesWithOther
        "project name?"
        0
        (const True)
        [pack $ takeBaseName wd]
  <*> fmap
        (unpack)
        (askChoicesWithOther
          "choose a source folder name"
          0
          (isValid . unpack)  -- filepath path verifier
          (map pack standardSourceFolders))
  <*> fmap
        versionFromString
        (askChoicesWithOther
          "initial project version?"
          0
          (const True)  -- TODO add verifier
          [pack $ show defaultProjectVersion])
  <*> (putStrLn "a quick summary" >> getLine)
  <*> (putStrLn "project repository url" >> getLine)
  <*> askChoicesWithOther
        "choose a license"
        0
        (const True)
        availableLicenses
  <*> askChoicesWithOther
        "select the elm-version"
        0
        (const True)  -- add verifier?
        [defaultElmVersion]


mkFiles :: [(FilePath, Maybe ByteString.ByteString)] -> IO [Result]
mkFiles = mapM (uncurry mkFile)


mkFile :: FilePath -> Maybe ByteString.ByteString -> IO Result
mkFile name defaultFile = exists name >>=
  bool
    (withFile
      name
      WriteMode
      (flip (maybe (return ())) defaultFile . ByteString.hPut)
    >> return (Right ()))
    (return $ Left $ "file " `append` pack name `append` " already exists")


mkSourceFiles :: FilePath -> IO [Result]
mkSourceFiles =
  mkFiles . flip map standardSourceFiles . Arrow.first . (</>)


mkDirs :: FilePath -> [FilePath] -> IO ()
mkDirs = mapM_ . (createDirectoryIfMissing True .) . (</>)


writeConf :: FilePath -> UserDecisions -> IO ()
writeConf wd =
  withFile
    (wd </> elmConfigName)
    WriteMode
    . flip LBS.hPut . encodePretty . makePackage


flattenMaybe :: Maybe (Maybe a) -> Maybe a
flattenMaybe = fromMaybe Nothing

putLicense :: FilePath -> Text -> IO Result
putLicense wd =
  maybe
    (return $ Left "License file not found")
    (fmap
      Right
      . withFile
          (wd </> "LICENSE")
          WriteMode
      . flip ByteString.hPut)
  . flattenMaybe . flip lookup standardLicenses


main :: IO ()
main = do

  -- get either the working directory or the directory the user entered
  wd        <- getCmdArgs >>= (verifyWD . workingDirectory)

  -- ask all important input first
  decisions <- getUserDecisions wd

  -- create necessary directories
  mkDirs wd (sourceFolder decisions : standardDirectories)

  -- create non-dynamic files, collect errors
  resStatic <- mkFiles $ map (Arrow.first (wd </>)) standardFiles

  -- create Elm source files, collect errors
  resSource <- mkSourceFiles $ wd </> sourceFolder decisions

  -- write the package config based on the user decisions
  writeConf wd decisions

  -- write the choosen license
  _         <- putLicense wd (license decisions)

  -- report all errors
  mapM_ (either putStrLn return) (resStatic ++ resSource)