{-# LANGUAGE NoImplicitPrelude #-}

-- | Description: interpret flags parsed by "IHaskell.Flags"
module IHaskell.Convert.Args (ConvertSpec(..), fromJustConvertSpec, toConvertSpec) where

import           IHaskellPrelude
import qualified Data.Text.Lazy as LT

import           Data.Functor.Identity (Identity(Identity))
import           Data.Char (toLower)
import           IHaskell.Flags (Argument(..), LhsStyle, lhsStyleBird, NotebookFormat(..))
import           System.FilePath ((<.>), dropExtension, takeExtension)

-- | ConvertSpec is the accumulator for command line arguments
data ConvertSpec f =
       ConvertSpec
         { forall (f :: * -> *). ConvertSpec f -> f Bool
convertToIpynb :: f Bool
         , forall (f :: * -> *). ConvertSpec f -> f String
convertInput :: f FilePath
         , forall (f :: * -> *). ConvertSpec f -> f String
convertOutput :: f FilePath
         , forall (f :: * -> *). ConvertSpec f -> f (LhsStyle Text)
convertLhsStyle :: f (LhsStyle LT.Text)
         , forall (f :: * -> *). ConvertSpec f -> Bool
convertOverwriteFiles :: Bool
         }

-- | Convert a possibly-incomplete specification for what to convert into one which can be executed.
-- Calls error when data is missing.
fromJustConvertSpec :: ConvertSpec Maybe -> ConvertSpec Identity
fromJustConvertSpec :: ConvertSpec Maybe -> ConvertSpec Identity
fromJustConvertSpec ConvertSpec Maybe
convertSpec = ConvertSpec Maybe
convertSpec
  { convertToIpynb = Identity toIpynb
  , convertInput = Identity inputFile
  , convertOutput = Identity outputFile
  , convertLhsStyle = Identity $ fromMaybe (LT.pack <$> lhsStyleBird) (convertLhsStyle convertSpec)
  }
  where
    toIpynb :: Bool
toIpynb = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe (String -> Bool
forall a. HasCallStack => String -> a
error String
"fromJustConvertSpec: direction for conversion unknown")
                (ConvertSpec Maybe -> Maybe Bool
forall (f :: * -> *). ConvertSpec f -> f Bool
convertToIpynb ConvertSpec Maybe
convertSpec)
    (String
inputFile, String
outputFile) =
      case (ConvertSpec Maybe -> Maybe String
forall (f :: * -> *). ConvertSpec f -> f String
convertInput ConvertSpec Maybe
convertSpec, ConvertSpec Maybe -> Maybe String
forall (f :: * -> *). ConvertSpec f -> f String
convertOutput ConvertSpec Maybe
convertSpec) of
        (Maybe String
Nothing, Maybe String
Nothing) -> String -> (String, String)
forall a. HasCallStack => String -> a
error String
"fromJustConvertSpec: no files specified for conversion"
        (Just String
i, Maybe String
Nothing)
          | Bool
toIpynb -> (String
i, String -> String
dropExtension String
i String -> String -> String
<.> String
"ipynb")
          | Bool
otherwise -> (String
i, String -> String
dropExtension String
i String -> String -> String
<.> String
"lhs")
        (Maybe String
Nothing, Just String
o)
          | Bool
toIpynb -> (String -> String
dropExtension String
o String -> String -> String
<.> String
"lhs", String
o)
          | Bool
otherwise -> (String -> String
dropExtension String
o String -> String -> String
<.> String
"ipynb", String
o)
        (Just String
i, Just String
o) -> (String
i, String
o)

-- | Does this @Argument@ explicitly request a file format?
isFormatSpec :: Argument -> Bool
isFormatSpec :: Argument -> Bool
isFormatSpec (ConvertToFormat NotebookFormat
_) = Bool
True
isFormatSpec (ConvertFromFormat NotebookFormat
_) = Bool
True
isFormatSpec Argument
_ = Bool
False

toConvertSpec :: [Argument] -> ConvertSpec Maybe
toConvertSpec :: [Argument] -> ConvertSpec Maybe
toConvertSpec [Argument]
args = [Argument] -> ConvertSpec Maybe -> ConvertSpec Maybe
mergeArgs [Argument]
otherArgs ([Argument] -> ConvertSpec Maybe -> ConvertSpec Maybe
mergeArgs [Argument]
formatSpecArgs ConvertSpec Maybe
initialConvertSpec)
  where
    ([Argument]
formatSpecArgs, [Argument]
otherArgs) = (Argument -> Bool) -> [Argument] -> ([Argument], [Argument])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition Argument -> Bool
isFormatSpec [Argument]
args
    initialConvertSpec :: ConvertSpec Maybe
initialConvertSpec = Maybe Bool
-> Maybe String
-> Maybe String
-> Maybe (LhsStyle Text)
-> Bool
-> ConvertSpec Maybe
forall (f :: * -> *).
f Bool
-> f String
-> f String
-> f (LhsStyle Text)
-> Bool
-> ConvertSpec f
ConvertSpec Maybe Bool
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing Maybe (LhsStyle Text)
forall a. Maybe a
Nothing Bool
False

mergeArgs :: [Argument] -> ConvertSpec Maybe -> ConvertSpec Maybe
mergeArgs :: [Argument] -> ConvertSpec Maybe -> ConvertSpec Maybe
mergeArgs [Argument]
args ConvertSpec Maybe
initialConvertSpec = (Argument -> ConvertSpec Maybe -> ConvertSpec Maybe)
-> ConvertSpec Maybe -> [Argument] -> ConvertSpec Maybe
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Argument -> ConvertSpec Maybe -> ConvertSpec Maybe
mergeArg ConvertSpec Maybe
initialConvertSpec [Argument]
args

mergeArg :: Argument -> ConvertSpec Maybe -> ConvertSpec Maybe
mergeArg :: Argument -> ConvertSpec Maybe -> ConvertSpec Maybe
mergeArg Argument
OverwriteFiles ConvertSpec Maybe
convertSpec = ConvertSpec Maybe
convertSpec { convertOverwriteFiles = True }
mergeArg (ConvertLhsStyle LhsStyle String
lhsStyle) ConvertSpec Maybe
convertSpec
  | Just LhsStyle Text
previousLhsStyle <- ConvertSpec Maybe -> Maybe (LhsStyle Text)
forall (f :: * -> *). ConvertSpec f -> f (LhsStyle Text)
convertLhsStyle ConvertSpec Maybe
convertSpec,
    LhsStyle Text
previousLhsStyle LhsStyle Text -> LhsStyle Text -> Bool
forall a. Eq a => a -> a -> Bool
/= (String -> Text) -> LhsStyle String -> LhsStyle Text
forall a b. (a -> b) -> LhsStyle a -> LhsStyle b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
LT.pack LhsStyle String
lhsStyle
  = String -> ConvertSpec Maybe
forall a. HasCallStack => String -> a
error (String -> ConvertSpec Maybe) -> String -> ConvertSpec Maybe
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"Conflicting lhs styles requested: <%s> and <%s>" (LhsStyle String -> String
forall a. Show a => a -> String
show LhsStyle String
lhsStyle)
              (LhsStyle Text -> String
forall a. Show a => a -> String
show LhsStyle Text
previousLhsStyle)
  | Bool
otherwise = ConvertSpec Maybe
convertSpec { convertLhsStyle = Just (LT.pack <$> lhsStyle) }
mergeArg (ConvertFrom String
inputFile) ConvertSpec Maybe
convertSpec
  | Just String
previousInputFile <- ConvertSpec Maybe -> Maybe String
forall (f :: * -> *). ConvertSpec f -> f String
convertInput ConvertSpec Maybe
convertSpec,
    String
previousInputFile String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
inputFile
  = String -> ConvertSpec Maybe
forall a. HasCallStack => String -> a
error (String -> ConvertSpec Maybe) -> String -> ConvertSpec Maybe
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"Multiple input files specified: <%s> and <%s>" String
inputFile String
previousInputFile
  | Bool
otherwise = ConvertSpec Maybe
convertSpec
      { convertInput = Just inputFile
      , convertToIpynb = case (convertToIpynb convertSpec, fromExt inputFile) of
        (Maybe Bool
prev, Maybe NotebookFormat
Nothing)    -> Maybe Bool
prev
        (prev :: Maybe Bool
prev@(Just Bool
_), Maybe NotebookFormat
_) -> Maybe Bool
prev
        (Maybe Bool
Nothing, Maybe NotebookFormat
format)  -> (NotebookFormat -> Bool) -> Maybe NotebookFormat -> Maybe Bool
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NotebookFormat -> NotebookFormat -> Bool
forall a. Eq a => a -> a -> Bool
== NotebookFormat
LhsMarkdown) Maybe NotebookFormat
format
      }
mergeArg (ConvertTo String
outputFile) ConvertSpec Maybe
convertSpec
  | Just String
previousOutputFile <- ConvertSpec Maybe -> Maybe String
forall (f :: * -> *). ConvertSpec f -> f String
convertOutput ConvertSpec Maybe
convertSpec,
    String
previousOutputFile String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
outputFile
  = String -> ConvertSpec Maybe
forall a. HasCallStack => String -> a
error (String -> ConvertSpec Maybe) -> String -> ConvertSpec Maybe
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"Multiple output files specified: <%s> and <%s>" String
outputFile String
previousOutputFile
  | Bool
otherwise = ConvertSpec Maybe
convertSpec
      { convertOutput = Just outputFile
      , convertToIpynb = case (convertToIpynb convertSpec, fromExt outputFile) of
        (Maybe Bool
prev, Maybe NotebookFormat
Nothing)    -> Maybe Bool
prev
        (prev :: Maybe Bool
prev@(Just Bool
_), Maybe NotebookFormat
_) -> Maybe Bool
prev
        (Maybe Bool
Nothing, Maybe NotebookFormat
format)  -> (NotebookFormat -> Bool) -> Maybe NotebookFormat -> Maybe Bool
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NotebookFormat -> NotebookFormat -> Bool
forall a. Eq a => a -> a -> Bool
== NotebookFormat
IpynbFile) Maybe NotebookFormat
format
      }
mergeArg (ConvertToFormat NotebookFormat
format) ConvertSpec Maybe
convertSpec = case NotebookFormat
format of
  NotebookFormat
LhsMarkdown -> ConvertSpec Maybe
convertSpec { convertToIpynb = Just False }
  NotebookFormat
IpynbFile -> ConvertSpec Maybe
convertSpec { convertToIpynb = Just True }
mergeArg (ConvertFromFormat NotebookFormat
format) ConvertSpec Maybe
convertSpec = case NotebookFormat
format of
  NotebookFormat
LhsMarkdown -> ConvertSpec Maybe
convertSpec { convertToIpynb = Just True }
  NotebookFormat
IpynbFile -> ConvertSpec Maybe
convertSpec { convertToIpynb = Just False }
mergeArg Argument
unexpectedArg ConvertSpec Maybe
_ = String -> ConvertSpec Maybe
forall a. HasCallStack => String -> a
error (String -> ConvertSpec Maybe) -> String -> ConvertSpec Maybe
forall a b. (a -> b) -> a -> b
$ String
"IHaskell.Convert.mergeArg: impossible argument: "
                                   String -> String -> String
forall a. [a] -> [a] -> [a]
++ Argument -> String
forall a. Show a => a -> String
show Argument
unexpectedArg

-- | Guess the format based on the file extension.
fromExt :: FilePath -> Maybe NotebookFormat
fromExt :: String -> Maybe NotebookFormat
fromExt String
s =
  case (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (String -> String
takeExtension String
s) of
    String
".lhs"   -> NotebookFormat -> Maybe NotebookFormat
forall a. a -> Maybe a
Just NotebookFormat
LhsMarkdown
    String
".ipynb" -> NotebookFormat -> Maybe NotebookFormat
forall a. a -> Maybe a
Just NotebookFormat
IpynbFile
    String
_        -> Maybe NotebookFormat
forall a. Maybe a
Nothing