{-# 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 Bool
convertToIpynb = forall a. a -> Identity a
Identity Bool
toIpynb
  , convertInput :: Identity String
convertInput = forall a. a -> Identity a
Identity String
inputFile
  , convertOutput :: Identity String
convertOutput = forall a. a -> Identity a
Identity String
outputFile
  , convertLhsStyle :: Identity (LhsStyle Text)
convertLhsStyle = forall a. a -> Identity a
Identity forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe (String -> Text
LT.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LhsStyle String
lhsStyleBird) (forall (f :: * -> *). ConvertSpec f -> f (LhsStyle Text)
convertLhsStyle ConvertSpec Maybe
convertSpec)
  }
  where
    toIpynb :: Bool
toIpynb = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"fromJustConvertSpec: direction for conversion unknown")
                (forall (f :: * -> *). ConvertSpec f -> f Bool
convertToIpynb ConvertSpec Maybe
convertSpec)
    (String
inputFile, String
outputFile) =
      case (forall (f :: * -> *). ConvertSpec f -> f String
convertInput ConvertSpec Maybe
convertSpec, forall (f :: * -> *). ConvertSpec f -> f String
convertOutput ConvertSpec Maybe
convertSpec) of
        (Maybe String
Nothing, Maybe String
Nothing) -> 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) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition Argument -> Bool
isFormatSpec [Argument]
args
    initialConvertSpec :: ConvertSpec Maybe
initialConvertSpec = forall (f :: * -> *).
f Bool
-> f String
-> f String
-> f (LhsStyle Text)
-> Bool
-> ConvertSpec f
ConvertSpec forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing 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 = 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 :: Bool
convertOverwriteFiles = Bool
True }
mergeArg (ConvertLhsStyle LhsStyle String
lhsStyle) ConvertSpec Maybe
convertSpec
  | Just LhsStyle Text
previousLhsStyle <- forall (f :: * -> *). ConvertSpec f -> f (LhsStyle Text)
convertLhsStyle ConvertSpec Maybe
convertSpec,
    LhsStyle Text
previousLhsStyle forall a. Eq a => a -> a -> Bool
/= forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
LT.pack LhsStyle String
lhsStyle
  = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => String -> r
printf String
"Conflicting lhs styles requested: <%s> and <%s>" (forall a. Show a => a -> String
show LhsStyle String
lhsStyle)
              (forall a. Show a => a -> String
show LhsStyle Text
previousLhsStyle)
  | Bool
otherwise = ConvertSpec Maybe
convertSpec { convertLhsStyle :: Maybe (LhsStyle Text)
convertLhsStyle = forall a. a -> Maybe a
Just (String -> Text
LT.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LhsStyle String
lhsStyle) }
mergeArg (ConvertFrom String
inputFile) ConvertSpec Maybe
convertSpec
  | Just String
previousInputFile <- forall (f :: * -> *). ConvertSpec f -> f String
convertInput ConvertSpec Maybe
convertSpec,
    String
previousInputFile forall a. Eq a => a -> a -> Bool
/= String
inputFile
  = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ 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 :: Maybe String
convertInput = forall a. a -> Maybe a
Just String
inputFile
      , convertToIpynb :: Maybe Bool
convertToIpynb = case (forall (f :: * -> *). ConvertSpec f -> f Bool
convertToIpynb ConvertSpec Maybe
convertSpec, String -> Maybe NotebookFormat
fromExt String
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)  -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Eq a => a -> a -> Bool
== NotebookFormat
LhsMarkdown) Maybe NotebookFormat
format
      }
mergeArg (ConvertTo String
outputFile) ConvertSpec Maybe
convertSpec
  | Just String
previousOutputFile <- forall (f :: * -> *). ConvertSpec f -> f String
convertOutput ConvertSpec Maybe
convertSpec,
    String
previousOutputFile forall a. Eq a => a -> a -> Bool
/= String
outputFile
  = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ 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 :: Maybe String
convertOutput = forall a. a -> Maybe a
Just String
outputFile
      , convertToIpynb :: Maybe Bool
convertToIpynb = case (forall (f :: * -> *). ConvertSpec f -> f Bool
convertToIpynb ConvertSpec Maybe
convertSpec, String -> Maybe NotebookFormat
fromExt String
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)  -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (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 :: Maybe Bool
convertToIpynb = forall a. a -> Maybe a
Just Bool
False }
  NotebookFormat
IpynbFile -> ConvertSpec Maybe
convertSpec { convertToIpynb :: Maybe Bool
convertToIpynb = forall a. a -> Maybe a
Just Bool
True }
mergeArg (ConvertFromFormat NotebookFormat
format) ConvertSpec Maybe
convertSpec = case NotebookFormat
format of
  NotebookFormat
LhsMarkdown -> ConvertSpec Maybe
convertSpec { convertToIpynb :: Maybe Bool
convertToIpynb = forall a. a -> Maybe a
Just Bool
True }
  NotebookFormat
IpynbFile -> ConvertSpec Maybe
convertSpec { convertToIpynb :: Maybe Bool
convertToIpynb = forall a. a -> Maybe a
Just Bool
False }
mergeArg Argument
unexpectedArg ConvertSpec Maybe
_ = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"IHaskell.Convert.mergeArg: impossible argument: "
                                   forall a. [a] -> [a] -> [a]
++ 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 forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (String -> String
takeExtension String
s) of
    String
".lhs"   -> forall a. a -> Maybe a
Just NotebookFormat
LhsMarkdown
    String
".ipynb" -> forall a. a -> Maybe a
Just NotebookFormat
IpynbFile
    String
_        -> forall a. Maybe a
Nothing