{-# LANGUAGE CPP                        #-}
{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}

module Turtle.Line
  ( Line
  , lineToText
  , textToLines
  , linesToText
  , textToLine
  , unsafeTextToLine
  , NewlineForbidden(..)
  ) where

import Data.Text (Text)
import qualified Data.Text as Text
#if __GLASGOW_HASKELL__ >= 708
import Data.Coerce
#endif
import Data.List.NonEmpty (NonEmpty(..))
import Data.String
#if __GLASGOW_HASKELL__ >= 710
#else
import Data.Monoid
#endif
import Data.Maybe
import Data.Typeable
import Control.Exception

import qualified Data.List.NonEmpty

-- | The `NewlineForbidden` exception is thrown when you construct a `Line`
-- using an overloaded string literal or by calling `fromString` explicitly
-- and the supplied string contains newlines. This is a programming error to
-- do so: if you aren't sure that the input string is newline-free, do not
-- rely on the @`IsString` `Line`@ instance.
--
-- When debugging, it might be useful to look for implicit invocations of
-- `fromString` for `Line`:
--
-- > >>> sh (do { line <- "Hello\nWorld"; echo line })
-- > *** Exception: NewlineForbidden
--
-- In the above example, `echo` expects its argument to be a `Line`, thus
-- @line :: `Line`@. Since we bind @line@ in `Shell`, the string literal
-- @\"Hello\\nWorld\"@ has type @`Shell` `Line`@. The
-- @`IsString` (`Shell` `Line`)@ instance delegates the construction of a
-- `Line` to the @`IsString` `Line`@ instance, where the exception is thrown.
--
-- To fix the problem, use `textToLines`:
--
-- > >>> sh (do { line <- select (textToLines "Hello\nWorld"); echo line })
-- > Hello
-- > World
data NewlineForbidden = NewlineForbidden
  deriving (Int -> NewlineForbidden -> ShowS
[NewlineForbidden] -> ShowS
NewlineForbidden -> String
(Int -> NewlineForbidden -> ShowS)
-> (NewlineForbidden -> String)
-> ([NewlineForbidden] -> ShowS)
-> Show NewlineForbidden
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NewlineForbidden] -> ShowS
$cshowList :: [NewlineForbidden] -> ShowS
show :: NewlineForbidden -> String
$cshow :: NewlineForbidden -> String
showsPrec :: Int -> NewlineForbidden -> ShowS
$cshowsPrec :: Int -> NewlineForbidden -> ShowS
Show, Typeable)

instance Exception NewlineForbidden

-- | A line of text (does not contain newlines).
newtype Line = Line Text
  deriving (Line -> Line -> Bool
(Line -> Line -> Bool) -> (Line -> Line -> Bool) -> Eq Line
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Line -> Line -> Bool
$c/= :: Line -> Line -> Bool
== :: Line -> Line -> Bool
$c== :: Line -> Line -> Bool
Eq, Eq Line
Eq Line
-> (Line -> Line -> Ordering)
-> (Line -> Line -> Bool)
-> (Line -> Line -> Bool)
-> (Line -> Line -> Bool)
-> (Line -> Line -> Bool)
-> (Line -> Line -> Line)
-> (Line -> Line -> Line)
-> Ord Line
Line -> Line -> Bool
Line -> Line -> Ordering
Line -> Line -> Line
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Line -> Line -> Line
$cmin :: Line -> Line -> Line
max :: Line -> Line -> Line
$cmax :: Line -> Line -> Line
>= :: Line -> Line -> Bool
$c>= :: Line -> Line -> Bool
> :: Line -> Line -> Bool
$c> :: Line -> Line -> Bool
<= :: Line -> Line -> Bool
$c<= :: Line -> Line -> Bool
< :: Line -> Line -> Bool
$c< :: Line -> Line -> Bool
compare :: Line -> Line -> Ordering
$ccompare :: Line -> Line -> Ordering
$cp1Ord :: Eq Line
Ord, Int -> Line -> ShowS
[Line] -> ShowS
Line -> String
(Int -> Line -> ShowS)
-> (Line -> String) -> ([Line] -> ShowS) -> Show Line
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Line] -> ShowS
$cshowList :: [Line] -> ShowS
show :: Line -> String
$cshow :: Line -> String
showsPrec :: Int -> Line -> ShowS
$cshowsPrec :: Int -> Line -> ShowS
Show, Semigroup Line
Line
Semigroup Line
-> Line
-> (Line -> Line -> Line)
-> ([Line] -> Line)
-> Monoid Line
[Line] -> Line
Line -> Line -> Line
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Line] -> Line
$cmconcat :: [Line] -> Line
mappend :: Line -> Line -> Line
$cmappend :: Line -> Line -> Line
mempty :: Line
$cmempty :: Line
$cp1Monoid :: Semigroup Line
Monoid)

#if __GLASGOW_HASKELL__ >= 804
instance Semigroup Line where
  <> :: Line -> Line -> Line
(<>) = Line -> Line -> Line
forall a. Monoid a => a -> a -> a
mappend
#endif

instance IsString Line where
  fromString :: String -> Line
fromString = Line -> Maybe Line -> Line
forall a. a -> Maybe a -> a
fromMaybe (NewlineForbidden -> Line
forall a e. Exception e => e -> a
throw NewlineForbidden
NewlineForbidden) (Maybe Line -> Line) -> (String -> Maybe Line) -> String -> Line
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Line
textToLine (Text -> Maybe Line) -> (String -> Text) -> String -> Maybe Line
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. IsString a => String -> a
fromString

-- | Convert a line to a text value.
lineToText :: Line -> Text
lineToText :: Line -> Text
lineToText (Line Text
t) = Text
t

-- | Split text into lines. The inverse of `linesToText`.
textToLines :: Text -> NonEmpty Line
textToLines :: Text -> NonEmpty Line
textToLines =
#if __GLASGOW_HASKELL__ >= 708
  [Line] -> NonEmpty Line
forall a. [a] -> NonEmpty a
Data.List.NonEmpty.fromList ([Line] -> NonEmpty Line)
-> (Text -> [Line]) -> Text -> NonEmpty Line
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> [Text]) -> Text -> [Line]
coerce (Text -> Text -> [Text]
Text.splitOn Text
"\n")
#else
  Data.List.NonEmpty.fromList . map unsafeTextToLine . Text.splitOn "\n"
#endif

-- | Merge lines into a single text value.
linesToText :: [Line] -> Text
linesToText :: [Line] -> Text
linesToText =
#if __GLASGOW_HASKELL__ >= 708
  ([Text] -> Text) -> [Line] -> Text
coerce [Text] -> Text
Text.unlines
#else
  Text.unlines . map lineToText
#endif

-- | Try to convert a text value into a line.
-- Precondition (checked): the argument does not contain newlines.
textToLine :: Text -> Maybe Line
textToLine :: Text -> Maybe Line
textToLine = NonEmpty Line -> Maybe Line
forall a. NonEmpty a -> Maybe a
fromSingleton (NonEmpty Line -> Maybe Line)
-> (Text -> NonEmpty Line) -> Text -> Maybe Line
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> NonEmpty Line
textToLines
  where
    fromSingleton :: NonEmpty a -> Maybe a
fromSingleton (a
a :| []) = a -> Maybe a
forall a. a -> Maybe a
Just a
a
    fromSingleton  NonEmpty a
_        = Maybe a
forall a. Maybe a
Nothing

-- | Convert a text value into a line.
-- Precondition (unchecked): the argument does not contain newlines.
unsafeTextToLine :: Text -> Line
unsafeTextToLine :: Text -> Line
unsafeTextToLine = Text -> Line
Line