module Data.CSS.Properties.Types
(
Length,
AutoLen,
FactorLen,
CssString(..),
CssUrl(..),
Edge(..),
BackgroundAttachment(..),
BackgroundRepeat(..),
BorderStyle(..),
BorderWidth(..),
FontFamily(..),
FontSize(..),
FontStyle(..),
FontVariant(..),
FontWeight(..),
ContentPart(..),
ClipMode(..),
DisplayMode(..),
FloatEdge(..),
OverflowMode(..),
PositionMode(..),
VisibilityMode(..),
ListPosition(..),
ListStyle(..),
PageBreak(..), AnyBreak, InsideBreak,
PageSelector(..),
CaptionSide(..),
TableLayout(..),
TextAlign(..),
TextDecoration(..),
TextDirection(..),
TextTransform(..),
TextWrapMode(..),
UnicodeBidiMode(..),
VerticalAlign(..),
Cursor(..)
)
where
import Blaze.ByteString.Builder
import Blaze.ByteString.Builder.Char8 hiding (fromString)
import Control.Lens
import Data.ByteString (ByteString)
import Data.CSS.Properties.Classes
import Data.CSS.Properties.Utils
import Data.CSS.Types
import Data.CSS.Utils
import Data.Data
import Data.Foldable (Foldable(fold))
import Data.List
import Data.Monoid
import Data.String
import Data.Text (Text)
data AutoLen len a = AutoLen | NoAutoLen (len a)
deriving (Eq, Ord, Show)
instance HasAutoLength (AutoLen len) where
autoLen = AutoLen
instance (HasLength len) => HasLength (AutoLen len) where
_Cm = _NoAutoLen . _Cm
_Em = _NoAutoLen . _Em
_Ex = _NoAutoLen . _Ex
_Mm = _NoAutoLen . _Mm
_Px = _NoAutoLen . _Px
zeroLen = NoAutoLen zeroLen
instance (HasPercent len) => HasPercent (AutoLen len) where
_Factor = _NoAutoLen . _Factor
instance (ToPropValue (len a)) => ToPropValue (AutoLen len a) where
toPropBuilder AutoLen = fromByteString "auto"
toPropBuilder (NoAutoLen l) = toPropBuilder l
data BackgroundAttachment
= FixedBgr
| ScrollBgr
deriving (Data, Eq, Ord, Read, Show, Typeable)
instance ToPropValue BackgroundAttachment where
toPropBuilder FixedBgr = fromByteString "fixed"
toPropBuilder ScrollBgr = fromByteString "scroll"
data BackgroundRepeat
= NoRepeat
| Repeat
| RepeatX
| RepeatY
deriving (Data, Eq, Ord, Read, Show, Typeable)
instance ToPropValue BackgroundRepeat where
toPropBuilder NoRepeat = fromByteString "no-repeat"
toPropBuilder Repeat = fromByteString "repeat"
toPropBuilder RepeatX = fromByteString "repeat-x"
toPropBuilder RepeatY = fromByteString "repeat-y"
data BorderStyle
= NoBorder
| HiddenBorder
| DottedBorder
| DashedBorder
| SolidBorder
| DoubleBorder
| GrooveBorder
| RidgeBorder
| InsetBorder
| OutsetBorder
deriving (Data, Eq, Ord, Read, Show, Typeable)
instance ToPropValue BorderStyle where
toPropBuilder NoBorder = fromByteString "none"
toPropBuilder HiddenBorder = fromByteString "hidden"
toPropBuilder DottedBorder = fromByteString "dotted"
toPropBuilder DashedBorder = fromByteString "dashed"
toPropBuilder SolidBorder = fromByteString "solid"
toPropBuilder DoubleBorder = fromByteString "double"
toPropBuilder GrooveBorder = fromByteString "groove"
toPropBuilder RidgeBorder = fromByteString "ridge"
toPropBuilder InsetBorder = fromByteString "inset"
toPropBuilder OutsetBorder = fromByteString "outset"
data BorderWidth a
= BorderWidth (Length a)
| MediumWidth
| ThickWidth
| ThinWidth
deriving (Eq, Ord, Show, Typeable)
instance HasLength BorderWidth where
_Em = _BorderWidth . _Em
_Ex = _BorderWidth . _Ex
_Mm = _BorderWidth . _Mm
_Px = _BorderWidth . _Px
zeroLen = BorderWidth zeroLen
instance (Real a) => ToPropValue (BorderWidth a) where
toPropBuilder (BorderWidth l) = toPropBuilder l
toPropBuilder MediumWidth = fromByteString "medium"
toPropBuilder ThickWidth = fromByteString "thick"
toPropBuilder ThinWidth = fromByteString "thin"
data CaptionSide
= BottomSide
| TopSide
deriving (Data, Eq, Ord, Read, Show, Typeable)
instance ToPropValue CaptionSide where
toPropBuilder BottomSide = fromByteString "bottom"
toPropBuilder TopSide = fromByteString "top"
data ClipMode a
= ClipRect (AutoLen Length a)
(AutoLen Length a)
(AutoLen Length a)
(AutoLen Length a)
deriving (Eq, Ord, Show, Typeable)
instance (Real a) => ToPropValue (ClipMode a) where
toPropBuilder (ClipRect t r b l) =
fromByteString "rect(" <>
toPropBuilder t <> fromChar ',' <>
toPropBuilder r <> fromChar ',' <>
toPropBuilder b <> fromChar ',' <>
toPropBuilder l <> fromChar ')'
data ContentPart url
= AttrPart ByteString
| CloseQuotePart
| CounterPart ByteString (Maybe ListStyle)
| CountersPart ByteString Text (Maybe ListStyle)
| NoCloseQuotePart
| NoOpenQuotePart
| OpenQuotePart
| TextPart (CssString Text)
| UriPart url
deriving (Data, Eq, Functor, Ord, Read, Show, Typeable)
instance IsString (ContentPart url) where
fromString = TextPart . fromString
instance (ToPropValue url) => ToPropValue (ContentPart url) where
toPropBuilder part =
case part of
AttrPart attr -> bs "attr(" <> bs attr <> ch ')'
CloseQuotePart -> bs "close-quote"
NoCloseQuotePart -> bs "no-close-quote"
NoOpenQuotePart -> bs "no-open-quote"
OpenQuotePart -> bs "open-quote"
UriPart url -> toPropBuilder url
CounterPart name (Just DecimalList) ->
bs "counter(" <> bs name <> ch ')'
CounterPart name style ->
bs "counter(" <>
bs name <> ch ',' <>
maybeBuilder "none" style <>
ch ')'
CountersPart name sep (Just DecimalList) ->
bs "counters(" <>
bs name <> ch ',' <>
cssString sep <>
ch ')'
CountersPart name sep style ->
bs "counters(" <>
bs name <> ch ',' <>
cssString sep <> ch ',' <>
maybeBuilder "none" style <>
ch ')'
TextPart text -> toPropBuilder text
where
bs = fromByteString
ch = fromChar
newtype CssString a = CssString { getCssString :: a }
deriving (Data, Eq, Foldable, Functor, Ord, Read, Show, Traversable, Typeable)
instance (IsString a) => IsString (CssString a) where
fromString = CssString . fromString
instance ToPropValue (CssString Text) where
toPropBuilder = cssString . getCssString
newtype CssUrl a = CssUrl { getCssUrl :: a }
deriving (Data, Eq, Foldable, Functor, Ord, Read, Show, Traversable, Typeable)
instance (IsString a) => IsString (CssUrl a) where
fromString = CssUrl . fromString
instance ToPropValue (CssUrl Text) where
toPropBuilder (CssUrl url) =
fromByteString "url(" <>
cssString url <>
fromChar ')'
data Cursor url
= CrosshairCursor
| CursorFrom [url]
| DefaultCursor
| EResizeCursor
| HelpCursor
| MoveCursor
| NResizeCursor
| NeResizeCursor
| NwResizeCursor
| PointerCursor
| ProgressCursor
| SResizeCursor
| SeResizeCursor
| SwResizeCursor
| TextCursor
| WResizeCursor
| WaitCursor
deriving (Data, Eq, Foldable, Functor, Ord, Read, Show, Typeable, Traversable)
instance (ToPropValue url) => ToPropValue (Cursor url) where
toPropBuilder CrosshairCursor = fromByteString "crosshair"
toPropBuilder DefaultCursor = fromByteString "default"
toPropBuilder EResizeCursor = fromByteString "e-resize"
toPropBuilder HelpCursor = fromByteString "help"
toPropBuilder MoveCursor = fromByteString "move"
toPropBuilder NResizeCursor = fromByteString "n-resize"
toPropBuilder NeResizeCursor = fromByteString "ne-resize"
toPropBuilder NwResizeCursor = fromByteString "nw-resize"
toPropBuilder PointerCursor = fromByteString "pointer"
toPropBuilder ProgressCursor = fromByteString "progress"
toPropBuilder SResizeCursor = fromByteString "s-resize"
toPropBuilder SeResizeCursor = fromByteString "se-resize"
toPropBuilder SwResizeCursor = fromByteString "sw-resize"
toPropBuilder TextCursor = fromByteString "text"
toPropBuilder WResizeCursor = fromByteString "w-resize"
toPropBuilder WaitCursor = fromByteString "wait"
toPropBuilder (CursorFrom us) =
fold .
intersperse (fromChar ',') .
map toPropBuilder $ us
data DisplayMode
= BlockDisplay
| InlineBlockDisplay
| InlineDisplay
| ListItemDisplay
| NoneDisplay
| TableDisplay
| InlineTableDisplay
| TableRowGroupDisplay
| TableColumnDisplay
| TableColumnGroupDisplay
| TableHeaderGroupDisplay
| TableFooterGroupDisplay
| TableRowDisplay
| TableCellDisplay
| TableCaptionDisplay
deriving (Data, Eq, Ord, Read, Show, Typeable)
instance ToPropValue DisplayMode where
toPropBuilder BlockDisplay = fromByteString "block"
toPropBuilder InlineBlockDisplay = fromByteString "inline-block"
toPropBuilder InlineDisplay = fromByteString "inline"
toPropBuilder InlineTableDisplay = fromByteString "inline-table"
toPropBuilder ListItemDisplay = fromByteString "list-item"
toPropBuilder NoneDisplay = fromByteString "none"
toPropBuilder TableCaptionDisplay = fromByteString "table-caption"
toPropBuilder TableCellDisplay = fromByteString "table-cell"
toPropBuilder TableColumnDisplay = fromByteString "table-column"
toPropBuilder TableColumnGroupDisplay = fromByteString "table-column-group"
toPropBuilder TableDisplay = fromByteString "table"
toPropBuilder TableFooterGroupDisplay = fromByteString "table-footer-group"
toPropBuilder TableHeaderGroupDisplay = fromByteString "table-header-group"
toPropBuilder TableRowDisplay = fromByteString "table-row"
toPropBuilder TableRowGroupDisplay = fromByteString "table-row-group"
data Edge a
= Edges [a]
| BottomEdge a
| LeftEdge a
| RightEdge a
| TopEdge a
deriving (Data, Eq, Foldable, Functor, Ord, Read, Show, Traversable, Typeable)
data FactorLen len a = FactorLen a | NoFactorLen (len a)
deriving (Eq, Ord, Show)
instance (HasAutoLength len) => HasAutoLength (FactorLen len) where
autoLen = NoFactorLen autoLen
instance (HasLength len) => HasLength (FactorLen len) where
_Cm = _NoFactorLen . _Cm
_Em = _NoFactorLen . _Em
_Ex = _NoFactorLen . _Ex
_Mm = _NoFactorLen . _Mm
_Px = _NoFactorLen . _Px
zeroLen = NoFactorLen zeroLen
instance HasPercent (FactorLen len) where
_Factor = prism FactorLen ex
where
ex (FactorLen x) = Right x
ex len = Left len
instance (Real a, ToPropValue (len a)) => ToPropValue (FactorLen len a) where
toPropBuilder (FactorLen x) = showReal (100*x) <> fromChar '%'
toPropBuilder (NoFactorLen l) = toPropBuilder l
data FloatEdge = LeftFloat | RightFloat
deriving (Data, Eq, Ord, Read, Show, Typeable)
instance ToPropValue FloatEdge where
toPropBuilder LeftFloat = fromByteString "left"
toPropBuilder RightFloat = fromByteString "right"
data FontFamily
= CursiveFont
| FantasyFont
| MonospaceFont
| SansSerifFont
| SerifFont
| NamedFont (CssString Text)
deriving (Data, Eq, Ord, Read, Show, Typeable)
instance IsString FontFamily where
fromString = NamedFont . fromString
instance ToPropValue FontFamily where
toPropBuilder CursiveFont = fromByteString "cursive"
toPropBuilder FantasyFont = fromByteString "fantasy"
toPropBuilder MonospaceFont = fromByteString "monospace"
toPropBuilder SansSerifFont = fromByteString "sans-serif"
toPropBuilder SerifFont = fromByteString "serif"
toPropBuilder (NamedFont ff) = toPropBuilder ff
data FontSize a
= XXSmallSize
| XSmallSize
| SmallSize
| MediumSize
| LargeSize
| XLargeSize
| XXLargeSize
| LargerSize
| SmallerSize
| LengthSize (FactorLen Length a)
deriving (Eq, Ord, Show, Typeable)
instance HasLength FontSize where
_Em = _LengthSize . _Em
_Ex = _LengthSize . _Ex
_Mm = _LengthSize . _Mm
_Px = _LengthSize . _Px
zeroLen = LengthSize zeroLen
instance HasPercent FontSize where
_Factor = _LengthSize . _Factor
instance (Real a) => ToPropValue (FontSize a) where
toPropBuilder LargeSize = fromByteString "large"
toPropBuilder LargerSize = fromByteString "larger"
toPropBuilder MediumSize = fromByteString "medium"
toPropBuilder SmallSize = fromByteString "small"
toPropBuilder SmallerSize = fromByteString "smaller"
toPropBuilder XLargeSize = fromByteString "x-large"
toPropBuilder XSmallSize = fromByteString "x-small"
toPropBuilder XXLargeSize = fromByteString "xx-large"
toPropBuilder XXSmallSize = fromByteString "xx-small"
toPropBuilder (LengthSize l) = toPropBuilder l
data FontStyle
= ItalicStyle
| ObliqueStyle
| NormalStyle
deriving (Data, Eq, Ord, Read, Show, Typeable)
instance ToPropValue FontStyle where
toPropBuilder ItalicStyle = fromByteString "italic"
toPropBuilder ObliqueStyle = fromByteString "oblique"
toPropBuilder NormalStyle = fromByteString "normal"
data FontVariant
= NormalVariant
| SmallCapsVariant
deriving (Data, Eq, Ord, Read, Show, Typeable)
instance ToPropValue FontVariant where
toPropBuilder NormalVariant = fromByteString "normal"
toPropBuilder SmallCapsVariant = fromByteString "small-caps"
data FontWeight
= BolderWeight
| LighterWeight
| FontWeight Int
deriving (Data, Eq, Ord, Read, Show, Typeable)
instance ToPropValue FontWeight where
toPropBuilder BolderWeight = fromByteString "bolder"
toPropBuilder LighterWeight = fromByteString "lighter"
toPropBuilder (FontWeight 4) = fromByteString "normal"
toPropBuilder (FontWeight 7) = fromByteString "bold"
toPropBuilder (FontWeight w) = showReal (100*w)
data Length a
= EmLen a
| ExLen a
| MmLen a
| PxLen a
| ZeroLen
deriving (Eq, Ord, Show, Typeable)
instance HasLength Length where
_Em = prism (orZeroLen EmLen) ex
where
ex (EmLen x) = Right x
ex ZeroLen = Right 0
ex len = Left len
_Ex = prism (orZeroLen ExLen) ex
where
ex (ExLen x) = Right x
ex ZeroLen = Right 0
ex len = Left len
_Mm = prism (orZeroLen MmLen) ex
where
ex (MmLen x) = Right x
ex ZeroLen = Right 0
ex len = Left len
_Px = prism (orZeroLen PxLen) ex
where
ex (PxLen x) = Right x
ex ZeroLen = Right 0
ex len = Left len
zeroLen = ZeroLen
instance (Real a) => ToPropValue (Length a) where
toPropBuilder (EmLen x) = showReal x <> fromByteString "em"
toPropBuilder (ExLen x) = showReal x <> fromByteString "ex"
toPropBuilder (MmLen x) = showReal x <> fromByteString "mm"
toPropBuilder (PxLen x) = showReal x <> fromByteString "px"
toPropBuilder ZeroLen = fromChar '0'
data ListPosition
= InsideList
| OutsideList
deriving (Data, Eq, Ord, Read, Show, Typeable)
instance ToPropValue ListPosition where
toPropBuilder InsideList = fromByteString "inside"
toPropBuilder OutsideList = fromByteString "outside"
data ListStyle
= ArmenianList
| CircleList
| DecimalLeadingZeroList
| DecimalList
| DiscList
| GeorgianList
| LowerAlphaList
| LowerGreekList
| LowerLatinList
| LowerRomanList
| SquareList
| UpperAlphaList
| UpperLatinList
| UpperRomanList
deriving (Data, Eq, Ord, Read, Show, Typeable)
instance ToPropValue ListStyle where
toPropBuilder ArmenianList = fromByteString "armenian"
toPropBuilder CircleList = fromByteString "circle"
toPropBuilder DecimalLeadingZeroList = fromByteString "decimal-leading-zero"
toPropBuilder DecimalList = fromByteString "decimal"
toPropBuilder DiscList = fromByteString "disc"
toPropBuilder GeorgianList = fromByteString "georgian"
toPropBuilder LowerAlphaList = fromByteString "lower-alpha"
toPropBuilder LowerGreekList = fromByteString "lower-greek"
toPropBuilder LowerLatinList = fromByteString "lower-latin"
toPropBuilder LowerRomanList = fromByteString "lower-roman"
toPropBuilder SquareList = fromByteString "square"
toPropBuilder UpperAlphaList = fromByteString "upper-alpha"
toPropBuilder UpperLatinList = fromByteString "upper-latin"
toPropBuilder UpperRomanList = fromByteString "upper-roman"
data OverflowMode
= AutoOverflow
| HiddenOverflow
| ScrollOverflow
| VisibleOverflow
deriving (Data, Eq, Ord, Read, Show, Typeable)
instance ToPropValue OverflowMode where
toPropBuilder AutoOverflow = fromByteString "auto"
toPropBuilder HiddenOverflow = fromByteString "hidden"
toPropBuilder ScrollOverflow = fromByteString "scroll"
toPropBuilder VisibleOverflow = fromByteString "visible"
data PageBreak :: * -> * where
AlwaysBreak :: PageBreak AnyBreak
AvoidBreak :: PageBreak InsideBreak
LeftBreak :: PageBreak AnyBreak
RightBreak :: PageBreak AnyBreak
instance ToPropValue (PageBreak a) where
toPropBuilder AlwaysBreak = fromByteString "always"
toPropBuilder AvoidBreak = fromByteString "avoid"
toPropBuilder LeftBreak = fromByteString "left"
toPropBuilder RightBreak = fromByteString "right"
data AnyBreak
data InsideBreak
data PageSelector
= AllPages
| FirstPage
| LeftPages
| RightPages
deriving (Data, Eq, Ord, Read, Show, Typeable)
data PositionMode
= AbsolutePos
| FixedPos
| RelativePos
| StaticPos
deriving (Data, Eq, Ord, Read, Show, Typeable)
instance ToPropValue PositionMode where
toPropBuilder AbsolutePos = fromByteString "absolute"
toPropBuilder FixedPos = fromByteString "fixed"
toPropBuilder RelativePos = fromByteString "relative"
toPropBuilder StaticPos = fromByteString "static"
data TableLayout
= AutoLayout
| FixedLayout
deriving (Data, Eq, Ord, Read, Show, Typeable)
instance ToPropValue TableLayout where
toPropBuilder AutoLayout = fromByteString "auto"
toPropBuilder FixedLayout = fromByteString "fixed"
data TextAlign
= CenterAlign
| JustifyAlign
| LeftAlign
| RightAlign
deriving (Data, Eq, Ord, Read, Show, Typeable)
instance ToPropValue TextAlign where
toPropBuilder CenterAlign = fromByteString "center"
toPropBuilder JustifyAlign = fromByteString "justify"
toPropBuilder LeftAlign = fromByteString "left"
toPropBuilder RightAlign = fromByteString "right"
data TextDecoration
= BlinkText
| LineThroughText
| OverlineText
| UnderlineText
deriving (Data, Eq, Ord, Read, Show, Typeable)
instance ToPropValue TextDecoration where
toPropBuilder BlinkText = fromByteString "blink"
toPropBuilder LineThroughText = fromByteString "line-through"
toPropBuilder OverlineText = fromByteString "overline"
toPropBuilder UnderlineText = fromByteString "underline"
data TextDirection
= LeftToRight
| RightToLeft
deriving (Data, Eq, Ord, Read, Show, Typeable)
instance ToPropValue TextDirection where
toPropBuilder LeftToRight = fromByteString "ltr"
toPropBuilder RightToLeft = fromByteString "rtl"
data TextTransform
= CapitalizeText
| LowercaseText
| UppercaseText
deriving (Data, Eq, Ord, Read, Show, Typeable)
instance ToPropValue TextTransform where
toPropBuilder CapitalizeText = fromByteString "capitalize"
toPropBuilder LowercaseText = fromByteString "lowercase"
toPropBuilder UppercaseText = fromByteString "uppercase"
data TextWrapMode
= NormalWrapping
| NowrapWrapping
| PreLineWrapping
| PreWrapWrapping
| PreWrapping
deriving (Data, Eq, Ord, Read, Show, Typeable)
instance ToPropValue TextWrapMode where
toPropBuilder NormalWrapping = fromByteString "normal"
toPropBuilder NowrapWrapping = fromByteString "nowrap"
toPropBuilder PreLineWrapping = fromByteString "pre-line"
toPropBuilder PreWrapWrapping = fromByteString "pre-wrap"
toPropBuilder PreWrapping = fromByteString "pre"
data UnicodeBidiMode
= EmbedBidi
| NormalBidi
| OverrideBidi
deriving (Data, Eq, Ord, Read, Show, Typeable)
instance ToPropValue UnicodeBidiMode where
toPropBuilder EmbedBidi = fromByteString "embed"
toPropBuilder NormalBidi = fromByteString "normal"
toPropBuilder OverrideBidi = fromByteString "bidi-override"
data VerticalAlign a
= BaselineAlign
| BottomAlign
| LengthAlign (FactorLen Length a)
| MiddleAlign
| SubAlign
| SuperAlign
| TextBottomAlign
| TextTopAlign
| TopAlign
deriving (Eq, Ord, Show, Typeable)
instance HasLength VerticalAlign where
_Em = _LengthAlign . _Em
_Ex = _LengthAlign . _Ex
_Mm = _LengthAlign . _Mm
_Px = _LengthAlign . _Px
zeroLen = LengthAlign zeroLen
instance HasPercent VerticalAlign where
_Factor = _LengthAlign . _Factor
instance (Real a) => ToPropValue (VerticalAlign a) where
toPropBuilder BaselineAlign = fromByteString "baseline"
toPropBuilder BottomAlign = fromByteString "bottom"
toPropBuilder MiddleAlign = fromByteString "middle"
toPropBuilder SubAlign = fromByteString "sub"
toPropBuilder SuperAlign = fromByteString "super"
toPropBuilder TextBottomAlign = fromByteString "text-bottom"
toPropBuilder TextTopAlign = fromByteString "text-top"
toPropBuilder TopAlign = fromByteString "top"
toPropBuilder (LengthAlign x) = toPropBuilder x
data VisibilityMode
= CollapseVisibility
| HiddenVisibility
| VisibleVisibility
deriving (Data, Eq, Ord, Read, Show, Typeable)
instance ToPropValue VisibilityMode where
toPropBuilder CollapseVisibility = fromByteString "collapse"
toPropBuilder HiddenVisibility = fromByteString "hidden"
toPropBuilder VisibleVisibility = fromByteString "visible"
_BorderWidth :: Prism' (BorderWidth a) (Length a)
_BorderWidth = prism BorderWidth ex
where
ex (BorderWidth l) = Right l
ex w = Left w
_LengthAlign :: Prism' (VerticalAlign a) (FactorLen Length a)
_LengthAlign = prism LengthAlign ex
where
ex (LengthAlign x) = Right x
ex va = Left va
_LengthSize :: Prism' (FontSize a) (FactorLen Length a)
_LengthSize = prism LengthSize ex
where
ex (LengthSize x) = Right x
ex fs = Left fs
_NoAutoLen :: Prism' (AutoLen len a) (len a)
_NoAutoLen = prism NoAutoLen ex
where
ex (NoAutoLen l) = Right l
ex len = Left len
_NoFactorLen :: Prism' (FactorLen len a) (len a)
_NoFactorLen = prism NoFactorLen ex
where
ex (NoFactorLen l) = Right l
ex len = Left len
orZeroLen :: (Eq a, HasLength len, Num a) => (a -> len a) -> (a -> len a)
orZeroLen _ 0 = zeroLen
orZeroLen f x = f x